'
' Author: tlviewer@yahoo.com
' script: CapiSig.vbs
' Description: sign with Capicom, verify with CryptoAPI (many conversions)
' keywords: cryptoapi capicom sign verify convert blob public
' Date: 07/06/04
' note: all certs used were made with OpenSSL (P12)
''''''''''''''''''
' custom CryptoAPI wrapper object
' http://www.tlviewer.org/crypto/acVBSCrypto.zip
'''''''''''''''''''''''
dim oCrypt
set oCrypt = createobject("AdvCrypto.cCrypto")
dim oSign
set oStore = createobject("CAPICOM.Store")
set oSign = createobject("CAPICOM.SignedData")
set util = createobject("Capicom.Utilities")
dim lResult
' WSH Globals
dim WSHShell, oFso ' global
Set WSHShell = WScript.CreateObject("WScript.Shell")
set oFso = createobject("Scripting.FileSystemObject")
' Custom Objects
dim arr, str, prov
lResult = Include("AdvCrypto.INC")
lResult = Include("CAPICOM.INC")
''''''''''''
' first see what Capicom gives for the hash
''''''''''''''''''
set oHash = createobject("CAPICOM.HashedData")
oHash.Algorithm = 0
'''''''''''''
' Capicom will default your content to Unicode unless you convert to Ascii first
'''''''''''''''''''
oHash.hash(MyStrConv("Grok this Monte Python"))
wscript.echo oHash.value
'''''''''''''''''''''''''''''''''''''''''''
' sign with Capicom
'''''''''''''''''''''''''
oStore.open CAPICOM_CURRENT_USER_STORE, CAPICOM_MY_STORE, CAPICOM_STORE_OPEN_READ_ONLY
' its a must to input as ASCII!!
oSign.Content= MyStrConv("Grok this Monte Python")
'
' with signer=nothing I get the selection Dialog
' I choose the Cert matched to the container name used below
' the cert signs with the exchange Prk and I import the Pbk from
' returned from WriteExtractedPbk() to verify
sSignature = oSign.Sign(nothing, True, CAPICOM_ENCODE_BASE64)
'with oSign.Certificates(1)
' wscript.echo .PublicKey.EncodedKey.Value(CAPICOM_ENCODE_BASE64)
'end with
'''''''''''''''''''''
' Extract the PublicKey from the selected cert
' format it for the CryptoAPI
' write it to a Pbk file, save the Pbk file name
''''''''''''''''''''''
PbkFile = WriteExtractedPbk( oSign.Certificates(1))
wscript.echo "OutPbk=", PbkFile
'wscript.quit(0)
sSignature = util.Base64Decode( sSignature)
''''''''''''''''
' write out the Sig blob to file
' look at the last 128 bytes; the sig is reversed
'''''''''''''''''''''''''''''''''''''
'with oFSO.createtextfile( "MySig.txt", vbTrue, vbTrue)
'.write( sSignature)
'.close
'end with
wscript.echo lenb(sSignature)
BinSig = midb(sSignature, lenb(sSignature)-128+1) '& chrb(83)
wscript.echo lenb(BinSig)
' get our signature as hex
BinSig = HexReverse(util.BinaryToHex(BinSig))
wscript.echo BinSig
''''''''''''''''''
' verify with the CryptoAPI via AdvCrypto VB wrapper
''''''''''''''''''''''''''
dim iEK
with oCrypt
.HashType = htSHA 'htSHAMD5_CLEAR
'.EncryptionAlgorithmType = et3DES_BLOCK_CIPHER
'.ssSessionKeyLength = &hA00000 ' or edkCRYPT_NO_SALT
.ssCSPTypeIndex = cspEnhanced '
'.ssProvType = ptRSA_FULL
.ssContainerName = ""
lResult = .SessionStart( stSingleKeyCrypto, ctUserProfileKeySet )
if .VerifySig(BinSig , "Grok this Monte Python", _
PbkFile, mtHex) then
wscript.echo "sig is good"
else
wscript.echo "failed"
end if
.SessionEnd
end with
'5522CB8B4254F0A34F435D9832B6C7FBBA34C20A
'1293
'128
'83DC32AFD405CAE08A2E54176F4E539F395C45690461D90619A2CBCE989ECDAA2F605E1F7EF58516AEE807329440D0B12E2840A7BD7069E80C6DF0483F65FAA43591594E513E730854AD3C772190A0D2FD7EBC9941D3F1A3947E7E48466DF01A96F3F1C392574D23814C7A5B5FB2D79171C046BCDD1B50D3C9CCC0845F6B7244
'sig is good
function WriteExtractedPbk( zzCert)
dim sPbkLen, lPbkLen, lOffSet, nJ, sRevKey, lStart, sBlkLen
wscript.echo zzCert.SubjectName
' colCerts.Find(CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME, " ")
lPbkLen = zzCert.PublicKey.Length
' byte where key modulus starts
'lStart = 7
' bytes forward to jump ahead inorder to reverse the Pbk Encoded value bytes
lOffSet = Clng( lPbkLen \ 8 )
' This is the header offset as a function of key size
lStart = 5 + (lOffSet \128 ) * 2
'sPbkLen = "000" & Cstr( hex( lPbkLen\256) ) & "0000"
wscript.echo lOffSet, lStart
with util
bKey = .BinaryStringToByteArray( zzCert.PublicKey.EncodedKey.Value( CAPICOM_ENCODE_BINARY ) )
'StmWrite bKey, "junk.bin"
' StrRevers doesn't work with binary strings
' reverse (byte by byte) the key material in the Capicom blob so it works in a CryptoAPI blob
sRevKey = ""
for nJ = 0 to lOffSet-1
sRevKey = sRevKey & midb(bKey, lStart + lOffSet - nJ, 1 )
next
sBlkLen = Cstr( hex( lPbkLen\256) )
If Len(sBlkLen) = 1 Then sBlkLen = "0" & sBlkLen
' this monstrosity is a CryptoAPI Pbk Blob - see format further below
bArr = .BinaryStringToByteArray( .HexToBinary( _
"06020000" & "00A40000" & "52534131" & _
"00" & sBlkLen & "0000" & _
"01000100" ) & sRevKey )
' smime certs have an email address, others start with a CN=
' some certs SubjectName strings are too long to be used as filenames, truncate at first token
sEMAil = split(zzCert.SubjectName , ",", 2)(0)
sEMail = replace(sEMail, ".", "_")
sEMail = replace(sEMail, "@", "_AT_")
sEMail = mid(sEMail,3)
tmpFile = sEMail & "_" & zzCert.thumbprint & ".pbk"
tmpFile= oFso.getabsolutepathname(".\" & tmpFile)
StmWrite bArr, tmpFile
'wscript.echo ubound(bArr), midb(bArr,1,1)
end with
WriteExtractedPbk = tmpFile
end function
'Public Type T_PUBLICKEYBLOB
' bType As Byte ' 06
' bVersion As Byte ' 02
' reserved As Integer ' 00 00
' aiKeyAlg As Long ' 00 A4 00 00
' magic As Long ' RSA1
' bitlen As Long ' 00 04 00 00
' pubexp As Long ' 16^4 +1 = 65536 + 1 [10 00 10 00]
' modulus(1 To 64) As Byte ' or (1 to 128)
'End Type
function StmWrite( bIn, sFile)
dim oStream
set oStream = createobject("adodb.stream")
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
oStream.type = adTypeBinary
oStream.open
oStream.write bIn
oStream.savetofile sFile, adSaveCreateOverWrite
end function
function HexReverse( InStr) ' as string
dim nJ, snew
for nJ = (len(InStr)-1) to 1 step -2
snew = snew & mid(InStr,nJ,2)
next
HexReverse = snew
end function
Function MyStrConv(Ustr)
Dim i
Dim ch
MyStrConv = ""
For i = 1 to Len(Ustr)
ch = Mid(Ustr, i, 1)
MyStrConv = MyStrConv & ChrB(AscB(ch))
Next
End Function
Function Include(cScriptPath)
' msp 11-01-02 consolidated all constant Includes using this function
dim oScript
dim tmpPath
tmpPath = cScriptPath
' normalize path to the Include folder
if instr(tmpPath,1) = 0 then
tmpPath = oFso.getabsolutepathname(".\Include\" & tmpPath)
end if
set oScript = oFSO.OpenTextFile(tmpPath)
Include = ExecuteGlobal( oScript.ReadAll())
oScript.Close
Set oScript = Nothing
End Function