请教大家关于VB使用二进制流计算文件HASH码的思路和代码，要求速度第一

Question

现在可能有大量文件，大小不一，但总的来说不会非常大，由于检索需要，拟用二进制流得出每个文件的HASH码用于区分不同文件。需要速度足够快，这个要求在C#下比较容易得到满意的结果，请教在VB下的思路和代码。多谢。

Answer 1

你先告诉我什么叫HASH码？二进制Bit操作函数我有一组特别快的。

Answer 2

下载地址：
http://www.cryptosys.net/src/hshp1100.zip

Answer 3

忘了说一句：尽可能不要另外安装软件或DLL来完成这件事。rainstormmaster(暴风雨 v2.0)你所提供的东西我看了，但要另外装软件，比较遗憾…… KiteGirl(小仙妹) 能否把你的二进制Bit操纵函数分享一下？HASH码说得简单一点就是对一组待分析数据按照某种方式求出一个较为简单的结果（例如：字符串、数字），用于快速查找、比对等，要求是每次按照这个方式所得出的结果都相同，并且对于不同的分析对象，所得出的HASH码要求重复率低（某些情况下要求不能重复，有时一定范围的重复是允许的）。

Answer 4

C#可以做的VB.Net也可以，他们都是基于MSIL的
有工具转C#代码到VB.Net的
MD5这样的Hash算法代码到处泛滥……

Answer 5

这个是核心的部分：对字节8个Bit进行操作，采用我自己特色的DRC缓冲法，在相同算法情况下，速度上有点优势。
Attribute VB_Name = "modByteBits"
Option Explicit'BitGetByByte函数
'BitPutToByte函数Private pubByteBits_BytePutTable() As Byte
Private pubByteBits_BytePutTable_Create As Boolean
Private pubByteBits_BytePutTable_CellReadys() As BooleanPrivate pubByteBits_ByteGetTable() As Byte
Private pubByteBits_ByteGetTable_Create As Boolean
Private pubByteBits_ByteGetTable_CellReadys() As BooleanPrivate pubByteBits_UnConCodeTable() As Byte
Private pubByteBits_UnConCodeTable_Create As Boolean
Private pubByteBits_UnConCodeTable_CellReadys() As BooleanPrivate pubByteBits_ConCodeTable() As Byte
Private pubByteBits_ConCodeTable_Create As Boolean
Private pubByteBits_ConCodeTable_CellReadys() As BooleanPublic Function BitGetByByte(ByVal pByte As Byte, ByVal pBitIndex As Byte) As Byte
  'BitGetByByte函数
  '语法：[tOutByte] = BitGetByByte(pByte ,pBitIndex, pBitValue)
  '功能：读取字节指定位的一个Bit值，并返回该值。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。读取Bit位
  '返回：byte       tOutByte            '读取的Bit位数值
  
  Dim tOutByte As Byte
  
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  If Not pubByteBits_ByteGetTable_Create Then
  
    Dim tBytesLength As Byte
    Dim tBitsIndexLength As Byte
    
    tBytesLength = 255
    tBitsIndexLength = 7
    
    ReDim pubByteBits_ByteGetTable(tBytesLength, tBitsIndexLength)
    ReDim pubByteBits_ByteGetTable_CellReadys(tBytesLength, tBitsIndexLength)
    
    pubByteBits_ByteGetTable_Create = True
  
  End If
  
  If Not pubByteBits_ByteGetTable_CellReadys(pByte, tBitIndex) Then
      
    pubByteBits_ByteGetTable(pByte, tBitIndex) = BitGetByByte_Operation(pByte, tBitIndex) And 1
    pubByteBits_ByteGetTable_CellReadys(pByte, tBitIndex) = True
    
  End If
  
  tOutByte = pubByteBits_ByteGetTable(pByte, tBitIndex)
  
  BitGetByByte = tOutByte
End FunctionPublic Function BitPutToByte(ByVal pByte As Byte, ByVal pBitIndex As Byte, ByVal pBitValue As Byte) As Byte
  'BitPutToByte函数
  '语法：[tOutByte] = BitPutToByte(pByte ,pBitIndex, pBitValue)
  '功能：将一个Bit值写入一个字节的指定位，并返回该字节。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。写入Bit位
  '      boolean    pBitValue           '必要参数。写入Bit值
  '返回：byte       tOutByte            '写入Bit位后的新字节。  Dim tOutByte As Byte
    
  Dim tBitIndex As Byte
  Dim tBitValue As Byte
  
  tBitIndex = pBitIndex Mod 8
  tBitValue = CBool(pBitValue) And 1
    
  If Not pubByteBits_BytePutTable_Create Then
    
    Dim tBytesLength As Byte
    Dim tBitsIndexLength As Byte
    Dim tBitsValueLength As Byte
    
    tBytesLength = 255
    tBitsIndexLength = 7
    tBitsValueLength = 1
    
    ReDim pubByteBits_BytePutTable(tBytesLength, tBitsIndexLength, tBitsValueLength)
    ReDim pubByteBits_BytePutTable_CellReadys(tBytesLength, tBitsIndexLength, tBitsValueLength)
    
    pubByteBits_BytePutTable_Create = True
    
  End If  If Not pubByteBits_BytePutTable_CellReadys(pByte, tBitIndex, tBitValue) Then
            
    pubByteBits_BytePutTable(pByte, tBitIndex, tBitValue) = BitPutToByte_Operation(pByte, tBitIndex, tBitValue)
    pubByteBits_BytePutTable_CellReadys(pByte, tBitIndex, tBitValue) = True
    
  End If
    
  tOutByte = pubByteBits_BytePutTable(pByte, tBitIndex, tBitValue)
  
  BitPutToByte = tOutByte
End FunctionPrivate Function BitGetByByte_Operation(ByVal pByte As Byte, ByVal pBitIndex As Byte) As Boolean
  'BitGetByByte_Operation函数
  '语法：[tOutByte] = BitGetByByte_Operation(pByte ,pBitIndex, pBitValue)
  '功能：以算术方法读取字节指定位的一个Bit值，并返回该值。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。读取Bit位
  '返回：byte       tOutByte            '读取的Bit位数值  Dim tOutByte As Byte
  
  tOutByte = CBool(pByte And BitPutToByte_ConCodeGet(pBitIndex))
  
  BitGetByByte_Operation = tOutByte
End FunctionPrivate Function BitPutToByte_Operation(ByVal pByte As Byte, ByVal pBitIndex As Byte, ByVal pBitValue As Boolean) As Byte
  'BitPutToByte_Operation函数
  '语法：[tOutByte] = BitPutToByte_Operation(pByte ,pBitIndex, pBitValue)
  '功能：以算术方法将一个Bit值写入一个字节的指定位，并返回该字节。
  '参数：byte       pByte               '必要参数。保存Bit的字节
  '      byte       pBitIndex           '必要参数。写入Bit位
  '      boolean    pBitValue           '必要参数。写入Bit值
  '返回：byte       tOutByte            '写入Bit位后的新字节。
  
  Dim tOutByte As Byte
  
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  Dim tUnConCode As Byte
  
  tUnConCode = BitPutToByte_UnConCodeGet(pBitIndex)
  
  Dim tConCode As Byte
  
  tConCode = pBitValue And BitPutToByte_ConCodeGet(pBitIndex)
  
  tOutByte = (tUnConCode And pByte) + tConCode
  
  BitPutToByte_Operation = tOutByte
End Function'（未完，待续）

Answer 6

Private Function BitPutToByte_UnConCodeGet(ByVal pBitIndex As Byte) As Byte
  'BitPutToByte_UnConCodeGet函数
  '语法：[tOutByte] = BitPutToByte_UnConCodeGet(pBitIndex)
  '功能：获得一个Bit位对应的反掩码。
  '参数：byte   pBitIndex               '必要参数，Bit位索引。取值范围 0 - 7 ，如大于7，则取余数。
  '返回：byte   tOutByte                'Byte位对应的反掩码。对应关系如下：
  '                                     '0 - &HFE 11111110
  '                                     '1 - &HFD 11111101
  '                                     '2 - &HFB 11111011
  '                                     '3 - &HF7 11110111
  '                                     '4 - &HEF 11101111
  '                                     '5 - &HBF 11011111
  '                                     '6 - &HDF 10111111
  '                                     '7 - &H7F 01111111
  
  Dim tOutCode As Byte
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  If Not pubByteBits_UnConCodeTable_Create Then
    
    Dim tBitsLength As Byte
    
    tBitsLength = 7
    
    ReDim pubByteBits_UnConCodeTable(tBitsLength)
    ReDim pubByteBits_UnConCodeTable_CellReadys(tBitsLength)
    
    pubByteBits_UnConCodeTable_Create = True
    
  End If
    
  If Not pubByteBits_UnConCodeTable_CellReadys(tBitIndex) Then
  
    pubByteBits_UnConCodeTable(tBitIndex) = Not BitPutToByte_ConCodeGet(tBitIndex)
    pubByteBits_UnConCodeTable_CellReadys(tBitIndex) = True
      
  End If
  
  tOutCode = pubByteBits_UnConCodeTable(pBitIndex)
  
  BitPutToByte_UnConCodeGet = tOutCode
End FunctionPrivate Function BitPutToByte_ConCodeGet(ByVal pBitIndex As Byte) As Byte
  'BitPutToByte_ConCodeGet函数
  '语法：[tOutByte] = BitPutToByte_ConCodeGet(pBitIndex)
  '功能：获得一个Bit位对应的正掩码。
  '参数：byte   pBitIndex               '必要参数，Bit位索引。取值范围 0 - 7 ，如大于7，则取余数。
  '返回：byte   tOutByte                'Byte位对应的正掩码。对应关系如下：
  '                                     '0 - &H01 00000001
  '                                     '1 - &H02 00000010
  '                                     '2 - &H04 00000100
  '                                     '3 - &H08 00001000
  '                                     '4 - &H10 00010000
  '                                     '5 - &H20 00100000
  '                                     '6 - &H40 01000000
  '                                     '7 - &H80 10000000
  
  Dim tOutCode As Byte
  Dim tBitIndex As Byte
  
  tBitIndex = pBitIndex Mod 8
  
  If Not pubByteBits_ConCodeTable_Create Then
    
    Dim tBitsLength As Byte
    
    tBitsLength = 7    ReDim pubByteBits_ConCodeTable(tBitsLength)
    ReDim pubByteBits_ConCodeTable_CellReadys(tBitsLength)
    
    pubByteBits_ConCodeTable_Create = True
    
  End If
    
  If Not pubByteBits_ConCodeTable_CellReadys(tBitIndex) Then
  
    pubByteBits_ConCodeTable(tBitIndex) = 2 ^ tBitIndex
    pubByteBits_ConCodeTable_CellReadys(tBitIndex) = True
      
  End If
  
  tOutCode = pubByteBits_ConCodeTable(pBitIndex)
  
  BitPutToByte_ConCodeGet = tOutCode
End Function第二级函数组：对任意Byte内的任意Bit进行操作。Attribute VB_Name = "modBits"'依赖：modBytes模块                     BytesCountPublic Function BitGetByBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Byte
  Dim tOutByte As Byte
  
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = BitOnBytesIndex(pBitIndex, pBitCount)
  tByteBitIndex = BitAbsIndex(pBitIndex, pBitCount)
  tOutByte = BitGetByByte(pBytes(tByteIndex), tByteBitIndex)  BitGetByBytes = tOutByte
End FunctionPublic Sub BitPutToBytes(ByRef pBytes() As Byte, ByVal pBitIndex As Long, ByVal pBitValue As Byte, Optional ByVal pBitCount As Byte = 8)
    
  Dim tByteIndex As Long
  Dim tByteBitIndex As Long
  
  tByteIndex = BitOnBytesIndex(pBitIndex, pBitCount)
  tByteBitIndex = BitAbsIndex(pBitIndex, pBitCount)
  pBytes(tByteIndex) = BitPutToByte(pBytes(tByteIndex), tByteBitIndex, pBitValue)
  
End SubPublic Function BitAbsIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long
  
  tOutIndex = pBitIndex Mod pBitCount
  
  BitAbsIndex = tOutIndex
End Function
Public Function BitOnBytesIndex(ByVal pBitIndex As Long, Optional ByVal pBitCount As Byte = 8) As Long
  Dim tOutIndex As Long  tOutIndex = (pBitIndex \ pBitCount)  BitOnBytesIndex = tOutIndex
End Function

Answer 7

字节支持模块部分内容：（没有完全提供并不是因为我吝啬，而是压根就没写完，而且很长）Attribute VB_Name = "modBytes"
Option ExplicitPublic Declare Sub CopyMemory_Bytes Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDesByte As Byte, ByRef pSurByte As Byte, ByVal Length As Long)Public Function BytesBitsCount(ByRef pBytes() As Byte, Optional ByVal pBitCount As Byte) As Long
  Dim tOutCount As Long
  
  Dim tBytes_Count As Long
  
  tBytes_Count = BytesCount(pBytes())
  tOutCount = tBytes_Count * pBitCount
  
  BytesBitsCount = tOutCount
End FunctionPublic Function BytesCount(ByRef pBytes() As Byte, Optional ByVal pCountMax As Long = &H7FFFFFFE) As Long
  'BytesCount函数
  '语法：tOutCount = BytesCount(pBytes(), [pCountMax])
  '功能：获得一个Byte数组全体元素的绝对数量。
  '参数：byte   pBytes()                '必要参数。Byte数组。
  '      long   pCountMax               '可选参数。绝对数量的最大极限。
  '返回：long   tOutCount               '数组全体元素的绝对数量。
  '                                     '=0  未指定下标的数组。
  '                                     '>0  已指定下标的数组。
  '说明：1、本函数针对没有指定下标的数组具有容错能力。
  '      2、可通过判断返回值是否为0来检测数组是否指定下标。
  '      3、最大可检测数组绝对长度为pCountMax指定，极限是2147483646。
  '      4、区别于UBound函数的是，本函数返回数组的绝对数量，而不是最大下标。
  '      5、本函数采用“极限算法”技术。
  '依赖：LongSegLength函数(modLong模块)
  
  Dim tOutCount As Long                 '输出变量
  
  Err.Clear
  On Error Resume Next
  
  Dim tLower As Long
  Dim tUpper As Long
  Dim tLengthMax As Long
  
  tLengthMax = pCountMax - 1
  tLower = LBound(pBytes())
  tUpper = UBound(pBytes())
  
  If CBool(Err.Number) Then Exit Function
  
  tOutCount = LongSegLength(tLower, tUpper, tLengthMax) + 1
  
  BytesCount = tOutCount
End Function下面是Byte支持模块依赖的Long类型数学模块：Option ExplicitPublic Sub LongSegLowerMove(ByRef pLower As Long, ByRef pUpper As Long, ByVal pNewLower As Long, Optional ByVal pSegMin As Long = &H80000000, Optional ByVal pSegMax As Long = &H7FFFFFFF)
  'LongSegLowerMove方法
  '语法：LongSegLowerMove pLower, pUpper, pNewLower, [pSegMin], [pSegMax]
  '功能：移界方法。重新定义一个值段的下界，并确保不会超出规定范围。
  '参数：long   pLower                  '必要参数。值段下界。
  '      long   pUpper                  '必要参数。值段上界。
  '      long   pNewLower               '必要参数。值段新下界。
  '      long   pSegMin                 '可选参数。值段下界极限。
  '      long   pSegMax                 '可选参数。值段上界极限。
  '依赖：LongLockBound函数
  '      LongSegLength函数
  '      LongLockMax函数
  
  Dim tOutLower As Long
  Dim tOutUpper As Long
    
  tOutLower = LongLockBound(pNewLower, pSegMin, pSegMax)
  
  Dim tSegLength As Long
  Dim tSegLength_Max As Long
  
  tSegLength_Max = LongSegLength(tOutLower, pSegMax)
  tSegLength = LongSegLength(pLower, pUpper)
  tSegLength = LongLockMax(tSegLength, tSegLength_Max)
    
  tOutUpper = tOutLower + tSegLength
  
  pLower = tOutLower
  pUpper = tOutUpper
End SubPublic Function LongSegLength(ByVal pLower As Long, ByVal pUpper As Long, Optional ByVal pLengthMax As Long = &H7FFFFFFE) As Long
  'LongSegLength函数
  '语法：[tOutLong]=LongSegLength(pLower, pUpper, [pLengthMax])
  '功能：获得一个Long表示的值段的绝对长度，并保持在一个允许范围内。
  '参数：long   pLower                  '必要参数。值段下界
  '      long   pUpper                  '必要参数。值段上界
  '      long   pLengthMax              '可选参数。值段绝对长度上限
  '输出：long   tOutLong                '值段绝对长度。如果超出pLengthMax则等于pLengthMax。
  '说明：本函数采用“极限算法”技术。
  Dim tOutLong As Long                  '输出变量
  
  Dim tTestLower As Long                '测试下限
  Dim tTestUpper As Long                '测试上限
  Dim tTestMax As Long                  '测试绝对值上限
  Dim tTestLength As Long               '测试绝对值
  Dim tTestMaxOver As Boolean           '测试值超限
  
  tTestLower = (pLower \ 2) + (pLower Mod 2)
  tTestUpper = (pUpper \ 2) + (pUpper Mod 2)
  tTestLength = Abs(tTestUpper - tTestLower)
  tTestMax = (pLengthMax \ 2) + (pLengthMax Mod 2)
  tTestMaxOver = tTestLength > tTestMax
  
  If tTestMaxOver Then
      tOutLong = pLengthMax
    Else
      tOutLong = Abs(pUpper - pLower)
  End If
  
  LongSegLength = tOutLong
End FunctionPublic Function LongLockBound(ByVal pLong As Long, ByVal pMin As Long, ByVal pMax As Long) As Long
  'LongLockBound函数
  '语法：[tOutLong] = LongLockBound(pLong, pMin, pMax)
  '功能：双界锁定。如果pMin<=pLong<=pMax则输出pLong，pLong<pMin输出pMin、pLong>pMax输出pMax。
  '参数：long   pLong                   '必要参数。测试值
  '      long   pMin                    '必要参数。下限
  '      long   pMax                    '必要参数。上限
  '输出：long   tOutLong                '经测试后的值。
  '依赖：LongSwapMinMax方法(本模块)
  
  Dim tOutLong As Long                  '输出变量
  
  Dim tOverMax As Boolean               '超过最大值
  Dim tOverMin As Boolean               '低于最小值
  
  LongSwapMinMax pMin, pMax
  
  tOverMax = pLong > pMax
  tOverMin = pLong < pMin
  
  If tOverMax Then
      tOutLong = pMax
    ElseIf tOverMin Then
      tOutLong = pMin
    Else
      tOutLong = pLong
  End If
  
  LongLockBound = tOutLong
End FunctionPublic Function LongLockMin(ByVal pLong As Long, ByVal pMin As Long) As Long
  'LongLockMin函数
  '语法：[tOutLong] = LongLockMin(pLong, pMin)
  '功能：锁定下限。检测变量pLong，如果pLong<pMin则输出pMin，否则输出pLong。
  '参数：long   pLong                   '必要参数。被检测变量。
  '      long   pMin                    '必要参数。变量值下限。
  '输出：long   tOutLong                '输出值。
  
  Dim tOutLong As Long                  '输出变量
  
  Dim tLongMinOver As Boolean           '低于下限
  
  tLongMinOver = pLong < pMin
  
  If tLongMinOver Then
      tOutLong = pMin
    Else
      tOutLong = pLong
  End If
  
  LongLockMin = tOutLong
End FunctionPublic Function LongLockMax(ByVal pLong As Long, ByVal pMax As Long) As Long
  'LongLockMax函数
  '语法：[tOutLong] = LongLockMax(pLong, pMax)
  '功能：锁定上限。检测变量pLong，如果pLong>pMax则输出pMax，否则输出pLong。
  '参数：long   pLong                   '必要参数。被检测变量。
  '      long   pMax                    '必要参数。变量值上限。
  '输出：long   tOutLong                '输出值。
  
  Dim tOutLong As Long                  '输出变量
  
  Dim tLongMaxOver As Boolean           '超出上限
  
  tLongMaxOver = pLong > pMax
  
  If tLongMaxOver Then
      tOutLong = pMax
    Else
      tOutLong = pLong
  End If
  
  LongLockMax = tOutLong
End FunctionPublic Sub LongSwapMinMax(ByRef pMin As Long, ByRef pMax As Long)
  'LongSwapMinMax方法
  '语法：LongSwapMinMax pMin, pMax
  '功能：比较交换。如果pMax>pMin则交换两个变量。
  '参数：long   pMin                    '必要参数。低值
  '      long   pMax                    '必要参数。高值
  
  Dim tSwapMinMax As Boolean            '交换条件：低值大于高值
  
  tSwapMinMax = pMin > pMax
  
  If tSwapMinMax Then
    LongSwap pMin, pMax
  End If
  
End SubPublic Sub LongSwap(ByRef pDesLong As Long, ByRef pSurLong As Long)
  'LongSwap方法
  '语法：LongSwap pDesLong, pSurLong
  '功能：交换pDesLong和pSurLong的值。
  '参数：long   pDesLong                '必要参数。被交换变量。
  '      long   pSurLong                '必要参数。源交换变量。
  
  Dim tTempLong As Long                 '中间变量
  
  tTempLong = pDesLong
  pDesLong = pSurLong
  pSurLong = tTempLong
  
End Sub

Answer 8

to jiangsheng(蒋晟.MSMVP2004Jan) ：我需要的是VB的不是VB.net的代码，C#下我已经有了，其实VB当中写一个也不难，但关键是速度上要求比较高。这点上.Net里面效率还是比较高的，但VB6下就……to  KiteGirl(小仙妹) ：感谢你的代码，我会好好研究的，然后给分。

Answer 9

//rainstormmaster(暴风雨 v2.0)你所提供的东西我看了，但要另外装软件，比较遗憾……你不装也可以，只要能获得dll文件就行（我就没有安装，直接将某个文件改名得到了所需的dll）