引用 | 編輯
students1
2009-05-30 08:51 |
樓主
▼ |
||
x0
此程式取自KU3大大~~網址如下:http://www.blueshop.com.tw/board/show.asp?subcde=BRD20090119205402X1N&fumcde=FUM200501271723350KG '以下寫在類模組名稱為MD5 '-------------------------------------------------------------------------------------------- Option Explicit '= '= Class Constants '= Private Const OFFSET_4 = 4294967296# Private Const MAXINT_4 = 2147483647 Private Const S11 = 7 Private Const S12 = 12 Private Const S13 = 17 Private Const S14 = 22 Private Const S21 = 5 Private Const S22 = 9 Private Const S23 = 14 Private Const S24 = 20 Private Const S31 = 4 Private Const S32 = 11 Private Const S33 = 16 Private Const S34 = 23 Private Const S41 = 6 Private Const S42 = 10 Private Const S43 = 15 Private Const S44 = 21 '= '= Class Variables '= Private State(4) As Long Private ByteCounter As Long Private ByteBuffer(63) As Byte '= '= Class Properties '= Property Get RegisterA() As String RegisterA = State(1) End Property Property Get RegisterB() As String RegisterB = State(2) End Property Property Get RegisterC() As String RegisterC = State(3) End Property Property Get RegisterD() As String RegisterD = State(4) End Property '= '= Class Functions '= ' ' Function to quickly digest a file into a hex string ' ----- ku3 修改 ----- Public Function DigestFileToHexStr(FileName As String) As String Dim fi As Long fi = FreeFile Open FileName For Binary Access Read As #fi MD5Init Do While Not EOF(fi) Get #fi, , ByteBuffer If Loc(fi) <= LOF(fi) Then ByteCounter = ByteCounter + 64 MD5Transform ByteBuffer End If Loop ByteCounter = ByteCounter + (LOF(fi) Mod 64) Close #fi MD5Final DigestFileToHexStr = GetValues End Function ' ' Function to digest a text string and output the result as a string ' of hexadecimal characters. ' ----- ku3 修改 ----- ' Public Function DigestStrToHexStr(SourceString As String) As String 'SourceString = "中英文混合字串測試" MD5Init Dim b() As Byte b = StrConv(SourceString, vbFromUnicode) MD5Update UBound(b) + 1, StringToArray(SourceString) MD5Final DigestStrToHexStr = GetValues End Function ' ' A utility function which converts a string into an array of ' bytes. ' ----- ku3 修改 ----- ' Private Function StringToArray(InString As String) As Byte() Dim I As Integer Dim bytBuffer() As Byte bytBuffer = StrConv(InString, vbFromUnicode) StringToArray = bytBuffer End Function ' ' Concatenate the four state vaules into one string ' Public Function GetValues() As String GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4)) End Function ' ' Convert a Long to a Hex string ' Private Function LongToString(Num As Long) As String Dim a As Byte Dim b As Byte Dim c As Byte Dim d As Byte a = Num And &HFF& If a < 16 Then LongToString = "0" & Hex(a) Else LongToString = Hex(a) End If b = (Num And &HFF00&) \ 256 If b < 16 Then LongToString = LongToString & "0" & Hex(b) Else LongToString = LongToString & Hex(b) End If c = (Num And &HFF0000) \ 65536 If c < 16 Then LongToString = LongToString & "0" & Hex(c) Else LongToString = LongToString & Hex(c) End If If Num < 0 Then d = ((Num And &H7F000000) \ 16777216) Or &H80& Else d = (Num And &HFF000000) \ 16777216 End If If d < 16 Then LongToString = LongToString & "0" & Hex(d) Else LongToString = LongToString & Hex(d) End If End Function ' ' Initialize the class ' This must be called before a digest calculation is started ' Public Sub MD5Init() ByteCounter = 0 State(1) = UnsignedToLong(1732584193#) State(2) = UnsignedToLong(4023233417#) State(3) = UnsignedToLong(2562383102#) State(4) = UnsignedToLong(271733878#) End Sub ' ' MD5 Final ' Public Sub MD5Final() Dim dblBits As Double Dim padding(72) As Byte Dim lngBytesBuffered As Long padding(0) = &H80 dblBits = ByteCounter * 8 ' Pad out lngBytesBuffered = ByteCounter Mod 64 If lngBytesBuffered <= 56 Then MD5Update 56 - lngBytesBuffered, padding Else MD5Update 120 - ByteCounter, padding End If padding(0) = UnsignedToLong(dblBits) And &HFF& padding(1) = Unsign .. 訪客只能看到部份內容,免費 加入會員 x0
|