Visual Basic 분류
SHA1_VBSource
컨텐츠 정보
- 21,931 조회
- 0 추천
-
목록
본문
Public Function sha1(keydata As String, message As String) As String
'////////////////////////////////////////////////////////////////////////////////////////////////////////////
'dependencies
'
'i32shiftleft
'i32shiftright
'i32rotateleft
'i32add
'hextodec
'dectohex
'////////////////////////////////////////////////////////////////////////////////////////////////////////////
'keydata is 4 x int32 ascii hex string, if null the default key will be used (msb at left)
'message is raw binary, unpadded
'return data is 5 x int32 ascii hex string with space between each int32 (msb at left)
'
'
'Hash initialization data
'Index Data
'0 0x67452301
'1 0xEFCDAB89
'2 0x98BADCFE
'3 0x10325476
'4 0xC3D2E1F0
'
'
'Default key
'Index Key Rounds
'0 0x5A827999 0 <= i <= 19 LSB
'1 0x6ED9EBA1 20 <= i <= 39
'2 0x8F1BBCDC 40 <= i <= 59
'3 0xCA62C1D6 60 <= i <= 79 MSB
'
'
'these calls would be the equivalent of using the default key as shown in the spec
'userhash = sha1("CA62C1D68F1BBCDC6ED9EBA15A827999","abc") = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'userhash = sha1("","abc") = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim k(4) As Long 'key constants defined in SHA1 spec
'----------------------------------------------------------------------------
Dim mcounter As Long 'external block(m) loop counter
'----------------------------------------------------------------------------
Dim messagesize As Long 'size in bits of original message (Pre-pad)
Dim padsize As Integer 'used to determine how many zeros to pad
Dim chunk As String '64 byte chunk of message, as a string
Dim messageblock(64) As Byte 'block buffer, translated to w(0) to w(15)
Dim bcounter As Integer 'block parser loop counter
'----------------------------------------------------------------------------
Dim t As Integer 'internal word(t) loop counter
Dim w(80) As Long 'word sequence, w(16) to w(79) are prehashed
Dim a As Long 'Word buffers for working block
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim runninghash(5) As Long 'updated from a...e after each block
Dim temp As Long 'temporary word value
'----------------------------------------------------------------------------
Dim hashtext As String 'output builder for ascii hex result
Dim hcounter As Integer 'build loop counter
'----------------------------------------------------------------------------
Dim hexin As String 'cleaned up key data
Dim i As Integer 'cleanup counter
'///////////////////////////////////////////////////////////////////////////////////////////////////////////
'mode control
If keydata = "" Then
'use default key from SHA1 spec
k(0) = &H5A827999
k(1) = &H6ED9EBA1
k(2) = &H8F1BBCDC
k(3) = &HCA62C1D6
Else
'use key passed to function
'front pad with zeros
'strip out all non hex characters
For i = 1 To Len(keydata)
Select Case Mid(keydata, i, 1)
Case "0" To "9", "a" To "f", "A" To "F"
hexin = hexin + Mid(keydata, i, 1)
End Select
Next i
hexin = Right(String(32, "0") + hexin, 32)
k(0) = hextodec(Mid(hexin, 25, 8))
k(1) = hextodec(Mid(hexin, 17, 8))
k(2) = hextodec(Mid(hexin, 9, 8))
k(3) = hextodec(Mid(hexin, 1, 8))
End If
'initialize hash data for this message
runninghash(0) = &H67452301
runninghash(1) = &HEFCDAB89
runninghash(2) = &H98BADCFE
runninghash(3) = &H10325476
runninghash(4) = &HC3D2E1F0
'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'pad message to 1 to n 512 bit blocks
'save length of original message in bits (Bytes * 8), but use shift function to avoid vb overflow
messagesize = i32shiftleft(Len(message), 3)
'append a '1' bit to the end of the message (this is actually a '1' with 7 '0's!)
message = message + Chr(&H80)
'pad with zeros to make mod(64)-8 bytes
padsize = (64 - ((Len(message) + 8) Mod 64)) And 63
message = message + String(padsize, Chr(0))
'the last 8 bytes is the count of message bits, or bytes x 8
'this is only (32bits/8bitsperbyte)= 536,870,911 bytes cause I suck
message = message + Chr(0)
message = message + Chr(0)
message = message + Chr(0)
message = message + Chr(0)
message = message + Chr(i32shiftright(messagesize, 24) And 255)
message = message + Chr(i32shiftright(messagesize, 16) And 255)
message = message + Chr(i32shiftright(messagesize, 8) And 255)
message = message + Chr(messagesize And 255)
'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'do hash in 64 byte blocks (512 bits)
For mcounter = Int(Len(message) / 64) To 1 Step -1
'////////////////////////////////////////////////////////////////////////////////////////////////////////
chunk = Mid(message, ((Int(Len(message) / 64) - mcounter) * 64) + 1, 64)
'parse out 64 bytes into 16 32 bit words
For bcounter = 0 To 63
messageblock(bcounter) = Asc(Mid(chunk, bcounter + 1, 1))
Next bcounter
'convert byte data in message block to 32int in first 16 w words
For t = 0 To 15
w(t) = i32shiftleft(CLng(messageblock(t * 4)), 24)
w(t) = w(t) Or i32shiftleft(CLng(messageblock(t * 4 + 1)), 16)
w(t) = w(t) Or i32shiftleft(CLng(messageblock(t * 4 + 2)), 8)
w(t) = w(t) Or CLng(messageblock(t * 4 + 3))
Next t
'pre-hash w(0) to w(15) into w(16) to w(79)
For t = 16 To 79
w(t) = i32rotateleft(w(t - 3) Xor w(t - 8) Xor w(t - 14) Xor w(t - 16), 1)
Next t
'initialize counters for this block from running hash for whole message
a = runninghash(0)
b = runninghash(1)
c = runninghash(2)
d = runninghash(3)
e = runninghash(4)
'do the actual hash
For t = 0 To 79
Select Case t
Case 0 To 19
temp = i32add(i32add(i32add(i32add(i32rotateleft(a, 5), e), w(t)), k(0)), ((b And c) Or ((Not b) And d)))
Case 20 To 39
temp = i32add(i32add(i32add(i32add(i32rotateleft(a, 5), e), w(t)), k(1)), (b Xor c Xor d))
Case 40 To 59
temp = i32add(i32add(i32add(i32add(i32rotateleft(a, 5), e), w(t)), k(2)), ((b And c) Or (b And d) Or (c And d)))
Case 60 To 79
temp = i32add(i32add(i32add(i32add(i32rotateleft(a, 5), e), w(t)), k(3)), (b Xor c Xor d))
End Select
e = d
d = c
c = i32rotateleft(b, 30)
b = a
a = temp
Next t
'update running hash with results for this block
runninghash(0) = i32add(runninghash(0), a)
runninghash(1) = i32add(runninghash(1), b)
runninghash(2) = i32add(runninghash(2), c)
runninghash(3) = i32add(runninghash(3), d)
runninghash(4) = i32add(runninghash(4), e)
'/////////////////////////////////////////////////////////////////////////////////////////////////////////
Next mcounter
'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'return result of hash as 5 ascii hex words
hashtext = dectohex(runninghash(0), 8)
For hcounter = 1 To 4
hashtext = hashtext + " " + dectohex(runninghash(hcounter), 8)
Next hcounter
sha1 = hashtext
'////////////////////////////////////////////////////////////////////////////////////////////////////////
End Function
Public Function i32add(operanda As Long, operandb As Long) As Long
'//////////////////////////////////////////////////////////////////////////////////////
'does 32 bit add of two 32 bit numbers as if they were unsigned int32's
'this has to be done this way because of quirk in VB where an add overflow
'into the sign bit is kicked out as an error. This would not be a problem if
'an unsigned int32 were allowed in VB!
'
'result=operanda + operandb
'
'use this function for (a+b)
'
'Not, And, Or, Xor all work the same for signed and unsigned int32 because there are
'no carries or borrows for VB to deal with
'//////////////////////////////////////////////////////////////////////////////////////
Dim operand_ax As Long
Dim operand_bx As Long
Dim upper_a As Integer
Dim upper_b As Integer
Dim result As Long
Dim topbits As Integer
'//////////////////////////////////////////////////////////////////////////////////////
'trim off offending bits
operand_ax = operanda And &H3FFFFFFF
operand_bx = operandb And &H3FFFFFFF
upper_a = ((operanda And &HC0000000) / &H40000000) And 3
upper_b = ((operandb And &HC0000000) / &H40000000) And 3
'do math on lower order bits
result = operand_ax + operand_bx
'do math on upper order bits
topbits = upper_a + upper_b
'if there was an overflow into upper 2 bits, increment the accumulator
If result And &H40000000 Then
topbits = topbits + 1
End If
'get rid of an overflow into upper 2 bits in lieu of separate math below
result = result And &H3FFFFFFF
'now adjust the upper bits for the side calculation results
If topbits And 1 Then
result = result Or &H40000000
End If
If topbits And 2 Then
result = result Or &H80000000
End If
i32add = result
End Function
Public Function i32sub(operanda As Long, operandb As Long) As Long
'//////////////////////////////////////////////////////////////////////////////////////
'does 32 bit subtract of two 32 bit numbers as if they were unsigned int32's
'this has to be done this way because of quirk in VB where an add overflow
'into the sign bit is kicked out as an error. This would not be a problem if
'an unsigned int32 were allowed in VB!
'
'result=operanda - operandb
'
'use this function for (a-b)
'
'Not, And, Or, Xor all work the same for signed and unsigned int32 because there are
'no carries or borrows for VB to deal with
'//////////////////////////////////////////////////////////////////////////////////////
i32sub = i32add(i32add(operanda, Not operandb), 1)
End Function
Public Function i32rotateleft(datain As Long, bitcount As Integer)
'//////////////////////////////////////////////////////////////////////////
'does a left rotate on a signed integer as if it were unsigned
' (MSB) < MSB.....LSB < (MSB)
'
'for i=0 to 32:print dectohex(i32rotateleft(&h0000000f,int(i)),8):next i
'//////////////////////////////////////////////////////////////////////////
Dim msb As Integer
Dim msb_m1 As Integer
Dim i As Integer
Dim xdatain As Long
'//////////////////////////////////////////////////////////////////////////
xdatain = datain
If (bitcount >= 32) Or (bitcount <= 0) Then
i32rotateleft = datain
Exit Function
End If
For i = 1 To bitcount
'get msb
If xdatain And &H80000000 Then
msb = 1
Else
msb = 0
End If
'get msb-1 bit
If xdatain And &H40000000 Then
msb_m1 = 1
Else
msb_m1 = 0
End If
xdatain = (xdatain And &H3FFFFFFF) * 2
If msb Then
xdatain = xdatain Or 1
End If
If msb_m1 Then
xdatain = xdatain Or &H80000000
End If
Next i
i32rotateleft = xdatain
End Function
Public Function i32rotateright(datain As Long, bitcount As Integer) As Long
'//////////////////////////////////////////////////////////////////////////
'does a right rotate on a signed integer as if it were unsigned
' (LSB) > MSB.....LSB > (LSB)
'
'for i=0 to 32:print dectohex(i32rotateright(&hf0000000,int(i)),8):next i
'//////////////////////////////////////////////////////////////////////////
Dim lsb As Integer
Dim i As Integer
Dim xdatain As Long
'//////////////////////////////////////////////////////////////////////////
xdatain = datain
If (bitcount >= 32) Or (bitcount <= 0) Then
i32rotateright = datain
Exit Function
End If
For i = 1 To bitcount
'get lsb
If xdatain And 1 Then
lsb = 1
Else
lsb = 0
End If
xdatain = Int(xdatain / 2) And &H7FFFFFFF 'without the "INT()", its really broken!
If lsb Then
xdatain = xdatain Or &H80000000
End If
Next i
i32rotateright = xdatain
End Function
Public Function i32shiftleft(datain As Long, bitcount As Integer) As Long
'//////////////////////////////////////////////////////////////////////////
'does a left shift on a signed integer as if it were unsigned
' MSB.....LSB < (0)
'
'for i=0 to 32:print dectohex(i32shiftleft(&hffffffff,int(i)),8):next i
'//////////////////////////////////////////////////////////////////////////
Dim msb_m1 As Integer
Dim i As Integer
Dim xdatain As Long
'//////////////////////////////////////////////////////////////////////////
xdatain = datain
If (bitcount <= 0) Then
i32shiftleft = datain
Exit Function
End If
If (bitcount >= 32) Then
i32shiftleft = 0
Exit Function
End If
For i = 1 To bitcount
'get msb-1 bit
If xdatain And &H40000000 Then
msb_m1 = 1
Else
msb_m1 = 0
End If
xdatain = (xdatain And &H3FFFFFFF) * 2
If msb_m1 Then
xdatain = xdatain Or &H80000000
End If
Next i
i32shiftleft = xdatain
End Function
Public Function i32shiftright(datain As Long, bitcount As Integer)
'//////////////////////////////////////////////////////////////////////////
'does a right shift on a signed integer as if it were unsigned
' (0) > MSB.....LSB
'
'for i=0 to 32:print dectohex(i32shiftright(&hffffffff,int(i)),8):next i
'//////////////////////////////////////////////////////////////////////////
Dim i As Integer
Dim xdatain As Long
'//////////////////////////////////////////////////////////////////////////
xdatain = datain
If (bitcount <= 0) Then
i32shiftright = datain
Exit Function
End If
If (bitcount >= 32) Then
i32shiftright = 0
Exit Function
End If
For i = 1 To bitcount
xdatain = Int(xdatain / 2) And &H7FFFFFFF 'without the "INT()", its really broken!
Next i
i32shiftright = xdatain
End Function
Public Function dectohex(datain As Long, hexdigits As Integer) As String
'/////////////////////////////////////////////////////////////////////////////////////////
'converts 32 bit signed integer to hex string of n hex digits
'since datain is specified here as long, -1 gets converted with hex() to "FFFFFFFF"
'if you just type it in at the immediate window hex() would convert -1 to "FFFF" because
'only a 16bit integer would be assumed!
'/////////////////////////////////////////////////////////////////////////////////////////
Dim i As Integer
Dim outdata As String
'/////////////////////////////////////////////////////////////////////////////////////////
If hexdigits > 8 Then
hexdigits = 8
End If
outdata = Right(Right("00000000" + Hex(datain), 8), hexdigits)
dectohex = outdata
End Function
Public Function hextodec(datain As String) As Long
'/////////////////////////////////////////////////////////////////////////////////
'converts up to 8 character hexadecimal to 32 bit signed integer
'non hex characters are stripped out
'/////////////////////////////////////////////////////////////////////////////////
Dim hexin As String
Dim lhex As Integer
Dim result As Long
Dim i As Integer
Dim hexdata As String
Dim decdata As Long
Dim invert As Boolean
'/////////////////////////////////////////////////////////////////////////////////
'strip out all non hex characters
For i = 1 To Len(datain)
Select Case Mid(datain, i, 1)
Case "0" To "9", "a" To "f", "A" To "F"
hexin = hexin + Mid(datain, i, 1)
End Select
Next i
'trim off more than 8 characters
hexin = Right(hexin, 8)
If Len(hexin) = 8 Then
Select Case Left(hexin, 1)
Case "0" To "7"
'do nothing since VB can handle this!
invert = False
Case Else
'post process result to get sign in there!
'trim to 31 bits, do sign bit later
'only slightly recursive!
Mid(hexin, 1, 1) = Hex(hextodec(Left(hexin, 1)) - 8)
invert = True
End Select
End If
hexin = UCase(hexin)
lhex = Len(hexin)
result = 0
For i = 1 To lhex
hexdata = Mid(hexin, lhex - i + 1, 1)
Select Case hexdata
Case "0" To "9"
decdata = 16 ^ (i - 1) * Val(hexdata)
Case "A" To "F"
decdata = 16 ^ (i - 1) * (Asc(hexdata) - 55)
End Select
result = result + decdata
Next i
If invert = False Then
hextodec = result
Else
hextodec = result - &H7FFFFFFF - 1
End If
End Function
Public Function hextobin(datain As String) As String
'/////////////////////////////////////////////////////////////////////////////////
'converts ascii hex block to raw binary (1 byte per 2 characters) string
'/////////////////////////////////////////////////////////////////////////////////
Dim hexin As String
Dim i As Integer
Dim outdata As String
'/////////////////////////////////////////////////////////////////////////////////
'strip out all non hex characters
For i = 1 To Len(datain)
Select Case Mid(datain, i, 1)
Case "0" To "9", "a" To "f", "A" To "F"
hexin = hexin + Mid(datain, i, 1)
End Select
Next i
'ensure even number of ascii hex characters
If Len(hexin) Mod 2 Then
hexin = "0" + hexin
End If
For i = 1 To Len(hexin) - 1 Step 2
outdata = outdata + Chr(hextodec(Mid(hexin, i, 2)))
Next i
hextobin = outdata
End Function
Public Function sha1hex(keydata As String, datain As String) As String
'//////////////////////////////////////////////////////////////////////////
'this is needed by excel because it does not accept null characters
'in raw binary strings so this has to all be done at module level
'without passing interrim result back to spreadsheet (Which truncates the
'string at the first null)
'//////////////////////////////////////////////////////////////////////////
sha1hex = sha1(keydata, hextobin(datain))
End Function
관련자료
-
링크
댓글 0
등록된 댓글이 없습니다.
