明晨网络

电话： 136-6532-7492 QQ: 给我发送消息 8507-0741

VB下的MD5编码函数——emorcillo：Hashing a string wit

emorcillo，2009-07-01 10:14， 文章标签: VB MD5

    明晨网络介绍过一个VB下的MD5编码类模块http://www.mingchennet.com/plus/view.php?aid=23，这个类模块可以计算字符串、二进制数组、文件的32位HASH值。现在再介绍微软专家MVP emorcillo提供的字符串的HASH值计算方法。原文地址http://www.mvps.org/emorcillo/en/code/vb6/hash.shtml

代码如下
  1. Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
  2.    Alias "CryptAcquireContextA" ( _
  3.    ByRef phProv As Long, _
  4.    ByVal pszContainer As String, _
  5.    ByVal pszProvider As String, _
  6.    ByVal dwProvType As Long, _
  7.    ByVal dwFlags As Long) As Long
  8.  
  9. Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
  10.    ByVal hProv As Long, _
  11.    ByVal dwFlags As Long) As Long
  12.  
  13. Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
  14.    ByVal hProv As Long, _
  15.    ByVal Algid As Long, _
  16.    ByVal hKey As Long, _
  17.    ByVal dwFlags As Long, _
  18.    ByRef phHash As Long) As Long
  19.  
  20. Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
  21.    ByVal hHash As Long) As Long
  22.  
  23. Private Declare Function CryptHashData Lib "advapi32.dll" ( _
  24.    ByVal hHash As Long, _
  25.    pbData As Any, _
  26.    ByVal dwDataLen As Long, _
  27.    ByVal dwFlags As Long) As Long
  28.  
  29. Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _
  30.    ByVal hHash As Long, _
  31.    ByVal dwParam As Long, _
  32.    pbData As Any, _
  33.    pdwDataLen As Long, _
  34.    ByVal dwFlags As Long) As Long
  35.  
  36. Private Const PROV_RSA_FULL = 1
  37.  
  38. Private Const ALG_CLASS_HASH = 32768
  39.  
  40. Private Const ALG_TYPE_ANY = 0
  41.  
  42. Private Const ALG_SID_MD2 = 1
  43. Private Const ALG_SID_MD4 = 2
  44. Private Const ALG_SID_MD5 = 3
  45. Private Const ALG_SID_SHA1 = 4
  46.  
  47. Enum HashAlgorithm
  48.    MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
  49.    MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
  50.    MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
  51.    SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
  52. End Enum
  53.  
  54. Private Const HP_HASHVAL = 2
  55. Private Const HP_HASHSIZE = 4
  56.  
  57. Function HashString( _
  58.    ByVal Str As String, _
  59.    Optional ByVal Algorithm As HashAlgorithm = MD5) As String
  60. Dim hCtx As Long
  61. Dim hHash As Long
  62. Dim lRes As Long
  63. Dim lLen As Long
  64. Dim lIdx As Long
  65. Dim abData() As Byte
  66.  
  67.    ' Get default provider context handle
  68.   lRes = CryptAcquireContext(hCtx, vbNullString, _
  69.            vbNullString, PROV_RSA_FULL, 0)
  70.  
  71.    If lRes <> 0 Then
  72.  
  73.       ' Create the hash
  74.      lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
  75.  
  76.       If lRes <> 0 Then
  77.  
  78.          ' Hash the string
  79.         lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
  80.  
  81.          If lRes <> 0 Then
  82.            
  83.             ' Get the hash lenght
  84.            lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
  85.  
  86.             If lRes <> 0 Then
  87.  
  88.                 ' Initialize the buffer
  89.                ReDim abData(0 To lLen - 1)
  90.  
  91.                 ' Get the hash value
  92.                lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
  93.  
  94.                 If lRes <> 0 Then
  95.  
  96.                     ' Convert value to hex string
  97.                    For lIdx = 0 To UBound(abData)
  98.                         HashString = HashString & _
  99.                                      Right$("0" & Hex$(abData(lIdx)), 2)
  100.                     Next
  101.  
  102.                 End If
  103.  
  104.             End If
  105.  
  106.          End If
  107.  
  108.          ' Release the hash handle
  109.         CryptDestroyHash hHash
  110.  
  111.       End If
  112.      
  113.    End If
  114.  
  115.    ' Release the provider context
  116.   CryptReleaseContext hCtx, 0
  117.  
  118.    ' Raise an error if lRes = 0
  119.   If lRes = 0 Then Err.Raise Err.LastDllError
  120.  
  121. End Function
  122.  

文章源自:明晨网络，emorcillo，《VB下的MD5编码函数——emorcillo：Hashing a string wit》，http://www.mingchennet.com/tec/code/vb/36.htm