1 引言 在本项目中在VB编程环境中使用了CryptoAPI2.0和CAPICOM2.0技术,使用CAPICOM2.0实现了证书操作,数字信封,数字签名,3DES、DES、RC4、RC2加解密,使用CryptAPI2.0实现了MD5、SHA-1数字摘要计算。 该文档的功能在MSDN的Platform SDK Documentation-Security-Cryptography中有详细介绍,可以参阅该文档。 2 CAPICOM2.0在项目中的使用 首先需要将CAPICOM.dll拷贝至system32目录下,在“运行”中敲入 regsvr32 CAPICOM.dll命令,然后打开VB,点击Project-refercenes,找到CAPICOM2.0的库,在该库前打上勾,便可使用CAPICOM。 2.1 3DES、DES、RC4、RC2加解密实现 ObjectName.Encrypt(EncodingType as CAPICOM_ENCODING_TYPE) as String ObjectName.Decrypt(EncryptedMessage as String) ObjectName.SetSecret(newVal as String,SecretType as CAPICOM_SECRET_TYPE) 2.1.1 3DES、DES、RC4、RC2加密 Sub EncryptMessage(ByVal TobeEncrypted As String, ByVal hidden As String, ByVal filename As String) 输入: TobeEncrypted——需要加密的字符串,也可以是文件,如果是文件则需要现读入数据 Hidden——加密使用的密码,这里的密码实际上是用来产生对称密钥的种子,这样使得使用CAPICOM来加密内容,也只能使用CAPICOM来解密。 输出:filename——输出的文件名,将密文作为文件放置至硬盘上。 Dim message As New EncryptedData message.Content = TobeEncrypted message.SetSecret hidden 初始化一个EncryptedData对象,将需要加密的字符串赋值给EncryptedData对象中的Content属性,该属性必须赋值不能空缺,具体上限不详,曾进尝试过50M的容量,再往上就不清楚了,不过在VB里面的字符串变量倒是有个上限,具体记不清楚了,估计在500M左右,这里肯定是不能超过这个上限的拉,所以加密超大文件的时候一定要分块加密,建议5M-10M为一个单位加密。SetSecret方法有两个参数,前一个参数即上端代码中的hidden,为加密设置密码,密码上限长度不详,第二个参数是控制产生对称密钥的办法,默认是使用密码产生对称密钥,但是MSDN只给出了一个参数,没有其他形式的参数,即没有其他办法来产生对称密钥,我觉得这个参数似乎没用。 message.Algorithm.Name = CAPICOM_ENCRYPTION_ALGORITHM_RC4 message.Algorithm.KeyLength = CAPICOM_ENCRYPTION_KEY_LENGTH_128_BITS 指定相应的加密算法和对称密钥长度Algorithm属性下有Name和 KeyLength两个属性,其中Algorithm.Name指定使用何种加密算法加密明文。具体有四种参数,见下表 Enumeration/value 0 1 2 3 Table - 1 加密算法枚举类型 其中Algorithm.KeyLength指定使用对称密钥的长度,具体有四种参数,见下表 Enumeration/value 0 1 2 3 Table - 2 对称密钥长度枚举类型 一般选择CAPICOM_KEY_LENGTH_MAXIMUM参数,当加密算法选择DES或者3DES时则忽略该参数,我觉得该参数意义不大,就给他CAPICOM_KEY_LENGTH_MAXIMUM或者CAPICOM_KEY_LENGTH_128_BITS得了。
加密是在这个时候进行,执行Encrypt方法则开始进行加密,这里比较消耗系统资源和时间,待执行完毕加密后将密文放置在encryptedmessage参数中。
MsgBox "no message encrypted. " Else MsgBox " Message is " & Len(encryptedmessage) & " characters"
Write #1, encryptedmessage Close #1 MsgBox "Encrypted message written to file " End If 将密文进行输出至指定文件中。
释放EncryptedData对象。
If Err.Number > 0 Then MsgBox "VB Error found:" & Err.Description Else MsgBox "CAPICOM error found : " & Err.Number End If 错误处理。
Sub DecryptMessage(ByVal hidden As String, ByVal filename As String) 输入: Hidden——加密使用的密码,这里的密码实际上是用来产生对称密钥的种子,这样使得使用CAPICOM来加密内容,也只能使用CAPICOM来解密。 输出:filename——输出的文件名,将密文作为文件放置至硬盘上。
如果遇到错误,则跳至ErrorHandler执行。
Dim encrypted As String 声明一个EncryptedData对象和一个字符串变量用来读取密文。
Input #1, encrypted Close #1 读取密文。
message.Algorithm.KeyLength = CAPICOM_ENCRYPTION_KEY_LENGTH_128_BITS 选择解密算法和对称密钥长度,这两个属性在加密时候已经详细介绍,这里不再介绍。
message.SetSecret hidden message.Decrypt encrypted MsgBox message.Content Else MsgBox "No encrypted message was read in." End If
Exit Sub
If Err.Number > 0 Then MsgBox "VB Error found:" & Err.Description Else If Err.Number = -2146893819 Then MsgBox "Error. The password may not be correct." Else MsgBox "CAPICOM error found : " & Err.Number End If End If 输出错误代码,错误代码表示一定的错误,可以在MSDN里面查阅,不过有好多经常出现的错误代码连MSDN也没有描述,网上也查阅不到,这个我也有一些研究,但是当时没有记录下来,现在也忘了,以后一定要做好记录啊!! End Sub 2.2 证书操作 ObjectName.BasicConstraints() as BasicConstraints ObjectName.Display() ObjectName.Export(EncodingType as CAPICOM_ENCODING_TYPE) as String ObjectName.ExtendedKeyUsage() as ExtendedKeyUsage ObjectName.GetInfo(InfoType as CAPICOM_CERT_INFO_TYPE) as String ObjectName.HasPrivateKey() as Boolean ObjectName.Import(EncodedCertificate as String) ObjectName.IsValid() as CertificateStatus ObjectName.KeyUsage() as KeyUsage 在本项目中主要不是对证书的操作进行编程,如需要对证书操作,我们则调用certmgr.msc(windows下的证书管理器)进行证书的导入,导出,删除,查看等操作。如果将来需要编写自己的证书管理器则需要在这个方面下功夫,在这里我也不能详细说写什么了。
在CAPICOM中针对数字签名设计了一系列操作方法,详见MSDN。 数字签名: ObjectName.Certificates() as Certificates ObjectName.CoSign(Signer as Signer,EncodingType as CAPICOM_ENCODING_TYPE) as String ObjectName.Sign(Signer as Signer,bDetached as Boolean,EncodingType as CAPICOM_ENCODING_TYPE) as String ObjectName.Verify(SignedMessage as String,bDetached as VARIENT_BOOL,VerifyFlag as CAPICOM_SIGNED_DATA_VERIFY_FLAG) 在二炮项目中并没有使用数字签名,应此在这里我不详细介绍,MSDN中有相关代码,后期工作中如果用到请查阅相关资料。 2.4 数字信封 数字信封中采用了单钥密码体制和公钥密码体制。信息发送者首先利用随机产生的对称密码加密信息,再利用接收方的公钥加密对称密码,被公钥加密后的对称密码被称之为数字信封。在传递信息时,信息接收方要解密信息时,必须先用自己的私钥解密数字信封,得到对称密码,才能利用对称密码解密所得到的信息。这样就保证了数据传输的真实性和完整性。 在CAPICOM中针对数字信封设计了一系列操作方法,详见MSDN。 数字信封: ObjectName.Decrypt(EnvelopedMessage as String) ObjectName.Encrypt(EncodingType as CAPICOM_ENVELOP_ENCODING_TYPE) as String 2.4.1 加密数据 Sub Envelope(ByVal InFile As String, ByVal OutFile As String, ByVal storename As String) 输入: InFile——需要加密的文件 OutFile——加密完毕后的密文 Storename——证书库名称,如果是个人证书库则为“My”
Open InFile For Input As #1 Input #1, Text Close #1 If Len(Text) < 1 Then MsgBox "No message to be enveloped." Exit Sub End If 读入需要加密的文件,并判断文件是否是空,如果空则提示错误。
Dim CertStore As New Store CertStore.Open CAPICOM_CURRENT_USER_STORE, StoreName, CAPICOM_STORE_OPEN_READ_ONLY 打开对方证书安装的目录,即证书库。记住这里要用发送方的证书(公钥)来进行数字信封的操作。Store.open的方法有三个参数,这三个参数在MSDN中有详细介绍,在一般的开发过程中,通常使用当前用户的证书库(即选择CAPICOM_CURRENT_USER_STORE),一般将个人证书安装在证书库中的“个人”目录下,这里该目录对应的StoreName应为“My”,如果不对证书库进行删除操作则一般将读取模式设为只读(CAPICOM_STORE_OPEN_READ_ONLY)。
MsgBox "There are no recipient certificates available." Set CertStore = Nothing Exit Sub End If 这里进一步确认打开的证书库中有证书存在,如果没有证书存在Store.Certificates.Count属性则为0。
EnvMessage.Content = Text 声明一个EnvelopedData对象,并将该对象的属性设置为前面读入的文件明文。
For I = 1 To CertStore.Certificates.Count EnvMessage.Recipients.Add CertStore.Certificates.Item(I) ' CertStore.Certificates.Item(I).Display Next I EnvelopedData.Recipients.Add方法将打开的证书库中的所有证书都加入到一个加密队列中,在下面将对每个证书生成一个相应的数字信封。
Envmessage.Algorithm.KeyLength = KEY_LENGTH_128_BITS 设置该数字信封使用的对称加密算法的类型和密钥的长度,这里跟基本加密算法中的Algorithm.Name和Algorithm.KeyLength属性有相同的设置方法,因此在MSDN里面没有在数字信封这章里详细这两个属性,在这里我不详细讨论这两个属性,读者可以参照EncryptedData对象中的该属性设置。
EnvelopedData.Encrypt方法对EnvelopedData.Content中的内容按照数字信封的方法进行加密,并将其放在一个字符串变量中,这里的数字信封加密方法和基本加密方法一样都有个编码参数,可以选择用BASE64编码或者不编码,默认为使用BASE64编码,至于BASE64我在这里就不介绍了,读者上网查一下相关资料就可以了。这里的参数有两个,详细见下表: Enumeration/value 0 1 Table - 3 编码类型枚举参数 还有一点要说得就是,EnvelopedData.Encrypt自动形成了数字信封,因为刚才将到了数字信封是由公钥加密后的对称密钥,这里生成的密文是由随机产生的对称密码加密明文文件后的密文文件和公钥加密后的对称密钥两部分组成。我没有研究过生成的密文含有哪些内容,也不知道具体格式如何,总之微软都帮你做好了剩下的你也别管了,当然解密也必须用CAPICOM所提供的对应方法来解密(微软真是太可恶了,这种地方也搞垄断)。
MsgBox "no message encrypted. " Else MsgBox " Message is " & Len(EnvelopedMessage) & " characters" Open OutFile For Output As #2 Write #2, EnvelopedMessage Close #2 MsgBox "The message written to file " End If 将数字信封以文件形式输出。
Set CertStore = Nothing 释放EncryptedData对象和Store对象。 Exit Sub
If Err.Number > 0 Then MsgBox "VB Error found:" & Err.Description Else MsgBox "CAPICOM error found : " & Err.Number End If End Sub 2.4.2 解密数据 Sub ReceiveMessage(ByVal InFile As String) 输入: InFile——密文形成的文件
Dim Envmessage As New EnvelopedData 声明一个EnvelopedData对象
Input #1, Encrypted Close #1
Envmessage.Decrypt encrypted
' Display the decrypted message. MsgBox Envmessage.Content Else MsgBox "No enveloped message was read in." End If EnvelopedData.Decrypt只有一个参数,即你把密文给它,就什么都帮你做好了,密文存放在EnvelopedData.Content属性中。这里你可能要问了,我连私钥、对称加密算法啥的都没告诉微软啊,怎么就能解密数字信封呢!唉,说VB是傻瓜软件,当然针对它开发的SDK也要傻瓜一点了。在这里微软会自动到当前用户的证书库中去寻找私钥,如果由对应的私钥则自动打开数字信封,如果没有它为提示你没有相应证书,因此你在使用之前要将私钥导入至当前用户的证书库中,当然办法有好多,我使用了PKCS#12格式的数字证书,该证书格式是带私钥的证书,应此在安装的时候就把私钥也装到你电脑里了。至于微软怎么知道你用的是啥对称加密算法,那可能是密文中含有此类信息,系统就自动识别了。
释放EnvelopedData对象。
If Err.Number > 0 Then MsgBox "VB Error found:" & Err.Description Else MsgBox "CAPICOM error found : " & Err.Number End If End Sub.
3.1.1 在VB中使用CryptoAPI的一些预备知识 这里我们要了解CryptAPI在VC中是如何使用的(废话,连VC的都不知道还怎么在VB中用啊!),这些在MSDN中有非常详细的介绍,在使用之前大家一定要认真查阅。这里我们要注意一个头文件——WINCRYPT.H和一个动态链接库——Crypt32.dll,这两个是在VC中使用CryptAPI必不可少的东东,当然在VB中也是必不可少的。大家都知道在VB中使用动态链接库中的函数,需要先声明使用的是库里面的哪一个函数,输入输出都是啥呀,还有各种参数类型。这下犯难了,我也不知道这些是啥,也没现成资料可以查,哥们我一开始也很郁闷啊,其实在WINCRYPT.H中就可以找到了答案。其实在VC中我们也需要对SDK中的函数进行声明,但是一句include<WINCRYPT.H>都帮你搞定了,VB中不行,那就一句一句来,把所需要用的函数都找出来,然后一句一句“翻译”成VB中的声明,在这里要特别注意参数的类型匹配,在这里我就不说了,再说内容就多了。 下面是一些函数声明和常量定义: (1)函数声明: Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (phProv As Long, pszContainer As String, pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, phKey As Long) As Long Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long Private Declare Function CryptExportKey Lib "advapi32.dll" (ByVal hKey As Long, ByVal hExpKey As Long, ByVal dwBlobType As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long Private Declare Function CryptGenKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal dwFlags As Long, phKey As Long) As Long Private Declare Function CryptGetProvParam Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptGetUserKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwKeySpec As Long, phUserKey As Long) As Long Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long Private Declare Function CryptSignHash Lib "advapi32.dll" Alias "CryptSignHashA" (ByVal hHash As Long, ByVal dwKeySpec As Long, ByVal sDescription As String, ByVal dwFlags As Long, ByVal pbSignature As String, pdwSigLen As Long) As Long Private Declare Function CryptVerifySignature Lib "advapi32.dll" Alias "CryptVerifySignatureA" (ByVal hHash As Long, ByVal pbSignature As String, ByVal dwSigLen As Long, ByVal hPubKey As Long, ByVal sDescription As String, ByVal dwFlags As Long) As Long Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByRef pByte As String, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long 'API error function Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Sub CpyMemValAdrFromRefAdr Lib "kernel32" Alias "RtlMoveMemory" (ByVal hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Private Declare Sub CpyMemRefAdrFromValAdr Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)
Private Const GMEM_MOVEABLE = &H2 Private Const GMEM_ZEROINIT = &H40 Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const PROV_RSA_FULL = 1 Private Const CRYPT_NEWKEYSET = &H8 Private Const PP_CONTAINER = 6 Private Const AT_KEYEXCHANGE = 1 Private Const AT_SIGNATURE = 2
Private Const ALG_CLASS_HASH = 32768 Private Const ALG_TYPE_ANY = 0 Private Const ALG_TYPE_BLOCK = 1536 Private Const ALG_TYPE_STREAM = 2048 Private Const ALG_SID_RC2 = 2 Private Const ALG_SID_RC4 = 1 Private Const ALG_SID_MD5 = 3
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2) Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4) Private Const HP_HASHVAL = 2 'constants from WinErr.h Private Const NTE_NO_KEY As Long = -2146893811 '0x8009000DL Private Const NTE_BAD_SIGNATURE As Long = -2146893818
Private Const CFB_READY = 1 Private Const CFB_VALID = 2
Private Const ENCRYPT_BLOCK_SIZE = 1
3.1.2 MD5和SHA的实现 Public Function DigestStrToHexStr(SourceString As String, HashAlg As String) As String 输入: SourceString——需要计算摘要的字符串 HashAlg——所用的散列算法,该值应为“MD5”或者“SHA” 返回: 128位(MD5)或者160位(SHA)摘要 Dim sContainer As String, sDescription As String, sProvider As String, lHCryptprov As Long Dim lHHash As Long, lResult As Long, lSignatureLen As Long, HashByte() As Byte
On Error GoTo ErrSign
设定互斥对象的状态为BUSY
sProvider = MS_DEF_PROV & vbNullChar If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!") GoTo ReleaseHandles: End If CryptAcquireContext函数是为了获得一个密钥容器的句柄,每一个CSP拥有自己的密钥容器(在这里密钥容器是指存放密钥对的数据库,CSP是cryptographic service provider的缩写,即加密服务提供者)。在这里使用windows自带的CSP(PROV_RSA_FULL),这里的CSP可以多种多样的,可以使用ikey,epass3000等各种符合CryptoAPI标准的CSP。
Case "MD5" If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!") GoTo ReleaseHandles: End If CryptCreateHash函数对HASH句柄进行初始化操作,这里需要提供CryptAcquireContext所申请的密钥容器句柄lHCryptprov和使用何种HASH函数CALG_MD5,初始化后的句柄存放在lHHash中
MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!") GoTo ReleaseHandles: End If CryptHashData函数将需要HASH的数据放置到lHHash的HASH对象中
ReDim HashByte(0 To 15) As Byte Dim HashLen As Long Dim HashSign As Boolean
HashSign = CryptGetHashParam(lHHash, HP_HASHVAL, HashByte(0), HashLen, 0) HashSign = CryptGetHashParam(lHHash, HP_HASHVAL, HashByte(0), HashLen, 0) CryptGetHashParam函数才是真正起作用的函数,这个函数从HASH对象中得到HASH数据,将获得的HASH值放置到HashByte数组中,在第二个参数你可以指名需要获得什么内容,可以获得HASH算法名称(HP_ALGID),HASH值长度(HP_HASHSIZE)和HASH值内容(HP_HASHVAL)。在这里我一直搞不明白,为什么在VB中CryptGetHashParam函数一定要执行两边才能得到HSHA值,执行一遍的时候什么也没有发生,这个我也没有自己研究原因,读者可以研究一下,不过对于HASH值没有什么影响,符合标准。 DigestStrToHexStr = UCase(DigestToString(HashByte)) 将HASH值用16位的字符表示 Case "SHA" 'Create a hash object. If Not CBool(CryptCreateHash(lHCryptprov, CALG_SHA1, 0, 0, lHHash)) Then MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!") GoTo ReleaseHandles: End If
If Not CBool(CryptHashData(lHHash, SourceString, Len(SourceString), 0)) Then MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!") GoTo ReleaseHandles: End If
ReDim HashByte(0 To 19) As Byte 'Dim HashLen As Long 'Dim HashSign As Boolean
HashSign = CryptGetHashParam(lHHash, HP_HASHVAL, HashByte(0), HashLen, 0) HashSign = CryptGetHashParam(lHHash, HP_HASHVAL, HashByte(0), HashLen, 0) DigestStrToHexStr = UCase(DigestToString(HashByte)) End Select
If lHHash Then lResult = CryptDestroyHash(lHHash) If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0) 注销lHHash和lHCryptprov两个句柄,释放内存,在这里也可以不释放,不过会影响程序执行的效率。
设置互斥对象状态为READY
MsgBox ("ErrSign " & Error$) GoTo ReleaseHandles
4 参考文献 |