CAPI&CAPICOM的一些知识[转]

1          引言
CryptoAPI（一个应用程序编程接口）目的就是提供开发者在Windows 下使用PKI 的编程接口。CryptoAPI 提供了很多函数，包括编码、解码、加密、解密、哈希、数字证书、证书管理和证书存储等功能。对于加密和解密，CryptoAPI 同时提供基于会话密钥和公钥/私钥对的方法。

        在本项目中在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在项目中的使用
CAPICOM2.0的SDK可以在以下网址中下载http://www.microsoft.com/msdownload/platformsdk/sdkupdate/psdkredist.htm

首先需要将CAPICOM.dll拷贝至system32目录下，在“运行”中敲入

regsvr32 CAPICOM.dll命令，然后打开VB，点击Project－refercenes，找到CAPICOM2.0的库，在该库前打上勾，便可使用CAPICOM。

2.1          3DES、DES、RC4、RC2加解密实现
这里主要使用了三个方法，详细参数说明就请查阅MSDN：

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加密
下面用一个加密实例来说明CAPICOM基本加密的使用方法。

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
Description
CAPICOM_ENCRYPTION_ALGORITHM_RC2

0
Use RSA RC2 encryption.
CAPICOM_ENCRYPTION_ALGORITHM_RC4

1
Use RSA RC4 encryption.
CAPICOM_ENCRYPTION_ALGORITHM_DES

2
Use DES encryption.
CAPICOM_ENCRYPTION_ALGORITHM_3DES

3
Use triple DES encryption.

Table - 1        加密算法枚举类型

其中Algorithm.KeyLength指定使用对称密钥的长度，具体有四种参数，见下表

Enumeration/value
Description
CAPICOM_KEY_LENGTH_MAXIMUM

0
Use the maximum key length available with the indicated encryption algorithm.
CAPICOM_KEY_LENGTH_40_BITS

1
Use 40-bit keys.
CAPICOM_KEY_LENGTH_56_BITS

2
Use 56-bit keys if available.
CAPICOM_KEY_LENGTH_128_BITS

3
Use 128-bit keys if available.

Table - 2        对称密钥长度枚举类型

一般选择CAPICOM_KEY_LENGTH_MAXIMUM参数，当加密算法选择DES或者3DES时则忽略该参数，我觉得该参数意义不大，就给他CAPICOM_KEY_LENGTH_MAXIMUM或者CAPICOM_KEY_LENGTH_128_BITS得了。

Dim encryptedmessage As String

encryptedmessage = message.Encrypt

加密是在这个时候进行，执行Encrypt方法则开始进行加密，这里比较消耗系统资源和时间，待执行完毕加密后将密文放置在encryptedmessage参数中。

If Len(encryptedmessage) < 1 Then

     MsgBox "no message encrypted. "

Else

     MsgBox " Message is " & Len(encryptedmessage) & " characters"

     Open filename For Output As #1

     Write #1, encryptedmessage

     Close #1

     MsgBox "Encrypted message written to file "

End If

将密文进行输出至指定文件中。

Set message = Nothing

释放EncryptedData对象。

Exit Sub

ErrorHandler:

If Err.Number > 0 Then

     MsgBox "VB Error found:" & Err.Description

Else

     MsgBox "CAPICOM error found : " & Err.Number

End If

错误处理。

2.1.2         3DES、DES、RC4、RC2解密
解密相对加密更esay，这里也用一个例子说明。

Sub DecryptMessage(ByVal hidden As String, ByVal filename As String)

输入：

Hidden——加密使用的密码，这里的密码实际上是用来产生对称密钥的种子，这样使得使用CAPICOM来加密内容，也只能使用CAPICOM来解密。

输出：filename——输出的文件名，将密文作为文件放置至硬盘上。

On Error GoTo ErrorHandler

如果遇到错误，则跳至ErrorHandler执行。

Dim message As New EncryptedData

Dim encrypted As String

声明一个EncryptedData对象和一个字符串变量用来读取密文。

Open filename For Input As #1

Input #1, encrypted

Close #1

读取密文。

message.Algorithm.Name = CAPICOM_ENCRYPTION_ALGORITHM_RC4

message.Algorithm.KeyLength = CAPICOM_ENCRYPTION_KEY_LENGTH_128_BITS

选择解密算法和对称密钥长度，这两个属性在加密时候已经详细介绍，这里不再介绍。

If Len(encrypted) > 0 Then

     message.SetSecret hidden

     message.Decrypt encrypted

     MsgBox message.Content

Else

     MsgBox "No encrypted message was read in."

End If

Set message = Nothing

Exit Sub

ErrorHandler:

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          证书操作
其实CAPICOM的精髓还是在对证书的操作这一块，这一块方法最多，添加、删除、管理数字证书，为以后的数字信封，数字签名，联合签名等重要功能做准备工作。这里能够使用的函数详细可以在MSDN中查阅：

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下的证书管理器）进行证书的导入，导出，删除，查看等操作。如果将来需要编写自己的证书管理器则需要在这个方面下功夫，在这里我也不能详细说写什么了。

2.3          数字签名
公钥密码体制在实际应用中包含数字签名和数字信封两种方式。 
　　数字签名是指用户用自己的私钥对原始数据的哈希摘要进行加密所得的数据。信息接收者使用信息发送者的公钥对附在原始信息后的数字签名进行解密后获得哈希摘要，并通过与自己用收到的原始数据产生的哈希哈希摘要对照，便可确信原始信息是否被篡改。这样就保证了数据传输的不可否认性。

        在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”

On Error GoTo ErrorHandler

Dim Text As String

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）。

If CertStore.Certificates.Count < 1 Then

     MsgBox "There are no recipient certificates available."

     Set CertStore = Nothing

     Exit Sub

End If

这里进一步确认打开的证书库中有证书存在，如果没有证书存在Store.Certificates.Count属性则为0。

Dim EnvMessage As New EnvelopedData

EnvMessage.Content = Text

声明一个EnvelopedData对象，并将该对象的属性设置为前面读入的文件明文。

Dim I As Integer

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.Name = ENCRYPTION_ALGORITHM_RC4

Envmessage.Algorithm.KeyLength = KEY_LENGTH_128_BITS

设置该数字信封使用的对称加密算法的类型和密钥的长度，这里跟基本加密算法中的Algorithm.Name和Algorithm.KeyLength属性有相同的设置方法，因此在MSDN里面没有在数字信封这章里详细这两个属性，在这里我不详细讨论这两个属性，读者可以参照EncryptedData对象中的该属性设置。

Dim EnvelopedMessage As String

EnvelopedMessage = EnvMessage.Encrypt

EnvelopedData.Encrypt方法对EnvelopedData.Content中的内容按照数字信封的方法进行加密，并将其放在一个字符串变量中，这里的数字信封加密方法和基本加密方法一样都有个编码参数，可以选择用BASE64编码或者不编码，默认为使用BASE64编码，至于BASE64我在这里就不介绍了，读者上网查一下相关资料就可以了。这里的参数有两个，详细见下表:

Enumeration/value
Description
CAPICOM_ENCODE_BASE64

0
Data is saved as a base64-encoded string.
CAPICOM_ENCODE_BINARY

1
Data is saved as a pure binary sequence.

Table - 3        编码类型枚举参数

还有一点要说得就是，EnvelopedData.Encrypt自动形成了数字信封，因为刚才将到了数字信封是由公钥加密后的对称密钥，这里生成的密文是由随机产生的对称密码加密明文文件后的密文文件和公钥加密后的对称密钥两部分组成。我没有研究过生成的密文含有哪些内容，也不知道具体格式如何，总之微软都帮你做好了剩下的你也别管了，当然解密也必须用CAPICOM所提供的对应方法来解密（微软真是太可恶了，这种地方也搞垄断）。

If Len(EnvelopedMessage) < 1 Then

     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 Envmessage = Nothing

Set CertStore = Nothing

释放EncryptedData对象和Store对象。

Exit Sub

ErrorHandler:

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——密文形成的文件

On Error GoTo ErrorHandler

Dim Envmessage As New EnvelopedData

声明一个EnvelopedData对象

Dim Encrypted As String

Open InFile For Input As #1

Input #1, Encrypted

Close #1

If Len(Encrypted) > 0 Then

     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格式的数字证书，该证书格式是带私钥的证书，应此在安装的时候就把私钥也装到你电脑里了。至于微软怎么知道你用的是啥对称加密算法，那可能是密文中含有此类信息，系统就自动识别了。

Set Envmessage = Nothing

释放EnvelopedData对象。

Exit Sub

ErrorHandler:

If Err.Number > 0 Then

     MsgBox "VB Error found:" & Err.Description

Else

     MsgBox "CAPICOM error found : " & Err.Number

End If

End Sub.

3          CryptAPI在项目中的使用
3.1          MD5和SHA散列算法实现
哈希算法是一类符合特殊要求的散列函数(Hash)函数，这些特殊要求是：
接受的输入报文数据没有长度限制；
对任何输入报文数据生成固定长度的摘要(“数字指纹”)输出； 
由报文能方便地算出摘要； 
难以对指定的摘要生成一个报文,由该报文可以得出指定的摘要； 
难以生成两个不同的报文具有相同的摘要。

3.1.1         在VB中使用CryptoAPI的一些预备知识
其实CAPICOM是微软针对VB开发的一个SDK，他是建立在CryptAPI的基础上，可以说CryptAPI更底层一点，应此CAPICOM实现不了或者很难实现的东西就可以直接用CryptAPI来实现。但是在MSDN中关于CryptAPI的各种文档都是正对VC的，并没有针对VB版本的文档，其实在VB中使用CryptAPI完全是我自己摸索出来的，我所知道的不管是google或是各种书籍还是MSDN中均没有关于CryptAPI在VB中使用的文档。其实VC和VB都是微软的产品，基本上VC中可以使用的SDK在VB中也可以使用，只不过更适用于哪种编程环境而已。有人说VB中没有指针啊，VC好多SDK都只传递了一个指针，那我VB里怎么用啊。其实在VB中也是有“指针”的，我们可以把VC中传递的指针传递给VB中数组的第一个元素就可以了，数据类型当然也要对应，不过只要VB中的数据类型长度比VC传递出来的大就不会出问题。好了，知道这些基本的知识我们就可以在VB中使用“只能”在VC中使用的SDK了。

        这里我们要了解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 GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) 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)

（2）常量

Private Const GMEM_MOVEABLE = &H2

Private Const GMEM_ZEROINIT = &H40

Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"

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 SIMPLEBLOB = 1

Private Const ALG_CLASS_DATA_ENCRYPT = 24576

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_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)

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_BUSY = 0

Private Const CFB_READY = 1

Private Const CFB_VALID = 2

Private Const ENCRYPT_ALGORITHM = CALG_RC4

Private Const ENCRYPT_BLOCK_SIZE = 1

Private Const CRYPT_EXPORTABLE = 1

3.1.2         MD5和SHA的实现
下面用一个实例来说明如何用CryptoAPI来实现散列算法

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

lStatus = CFB_BUSY

设定互斥对象的状态为BUSY

sContainer = vbNullChar

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。

Select Case HashAlg

     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中

         If Not CBool(CryptHashData(lHHash, SourceString, Len(SourceString), 0)) Then

             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

ReleaseHandles:

If lHHash Then lResult = CryptDestroyHash(lHHash)

If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

注销lHHash和lHCryptprov两个句柄，释放内存，在这里也可以不释放，不过会影响程序执行的效率。

lStatus = CFB_READY

设置互斥对象状态为READY

Exit Function

ErrSign:

MsgBox ("ErrSign " & Error$)

GoTo ReleaseHandles

End Function

4   参考文献
MSDN和CAPICOM2.0 SDK