Visual Basic, C & C++
분류 Visual Basic

SHA1_VBSource

페이지 정보

본문

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

관련자료

등록된 댓글이 없습니다.
프로그래밍
Today's proverb
꿈을 밀고 나가는 힘은 이성이 아니라 희망이며 두뇌가 아니라 심장이다. (도스토예프스키)