Author | Message | Time |
---|---|---|
Lycaon | Is there a function in VB to calculate the SHA1 hash of a password? Well, I think that's what I'm looking for. I'm looking for the has h function used to create the 20 byte hash sent to the server with packet 0x29. I've found the c++ function based on the java function by iago, and am poking through it getting ready to translate it to VB... But I figured I'd ask first. | September 2, 2004, 9:47 AM |
LoRd | If there's anything I've left out, you can find it here. [code] Private Declare Sub RtlMoveMemory Lib "Kernel32.dll" (ByRef Destination As Any, ByRef Source As Any, ByVal numBYTEs As Long) Public Function CalcHashBuf(ByVal buf As String) As String Dim pos As Long, sublen As Long Dim hashbuf(&H10 + 5) As Long hashbuf(0) = &H67452301 hashbuf(1) = &HEFCDAB89 hashbuf(2) = &H98BADCFE hashbuf(3) = &H10325476 hashbuf(4) = &HC3D2E1F0 For pos = 0 To Len(buf) Step &H40 sublen = Len(buf) - pos If sublen > &H40 Then sublen = &H40 Dim t As String t = Mid$(buf, pos + 1, sublen) & String(&H40 - sublen, Chr$(0)) Dim i As Long For i = 0 To 15 hashbuf(5 + i) = GetDWORD(Mid$(t, i * 4 + 1, 4)) Next i Call DataHash(hashbuf) Next pos CalcHashBuf = MakeDWORD(hashbuf(0)) & _ MakeDWORD(hashbuf(1)) & _ MakeDWORD(hashbuf(2)) & _ MakeDWORD(hashbuf(3)) & _ MakeDWORD(hashbuf(4)) End Function Private Sub DataHash(ByRef param() As Long) Dim buf(&H50) As Long Dim a As Long, b As Long, C As Long, D As Long, E As Long, G As Long Dim i As Long Dim p As Long p = UBound(param) - 5 If p > &H40 Then p = &H40 For i = 0 To p - 1 buf(i) = param(i + 5) Next For i = &H10 To &H4F G = buf(i - &H10) Xor buf(i - &H8) Xor buf(i - &HE) Xor buf(i - &H3) buf(i) = RoL(1, G) Next a = param(0) b = param(1) C = param(2) D = param(3) E = param(4) For i = 0 To 79 G = buf(i) G = Add(G, E) G = Add(G, RoL(a, 5)) Select Case i Case Is < 20 G = Add(G, ((b And C) Or ((Not b) And D))) G = Add(G, &H5A827999) Case Is < 40 G = Add(G, (D Xor C Xor b)) G = Add(G, &H6ED9EBA1) Case Is < 60 G = Add(G, (C And b) Or (D And C) Or (D And b)) G = Add(G, &H8F1BBCDC) Case Is < 80 G = Add(G, (D Xor C Xor b)) G = Add(G, &HCA62C1D6) Case Else Exit Sub End Select E = D D = C C = RoL(b, 30) b = a a = G Next param(0) = Add(param(0), a) param(1) = Add(param(1), b) param(2) = Add(param(2), C) param(3) = Add(param(3), D) param(4) = Add(param(4), E) End Sub Public Function MakeDWORD(Value As Long) As String Dim strReturn As String * 4 RtlMoveMemory ByVal strReturn, Value, 4 MakeDWORD = strReturn End Function Public Function Add(ByVal number1 As Long, ByVal number2 As Long) As Long Add = DToL(CDbl(number1) + CDbl(number2)) End Function Public Function RoL(ByVal Number As Long, ByVal Shift As Long) As Long Shift = Shift And &H1F RoL = LShift(Number, Shift) Or RShift(Number, 32 - Shift) End Function Public Function LShift(ByVal pnValue As Long, ByVal pnShift As Long) As Long If pnShift > 31 Then LShift = 0 ElseIf pnShift < 0 Then LShift = 0 ElseIf pnShift = 0 Then LShift = pnValue Else pnValue = pnValue And (2 ^ (32 - pnShift) - 1) LShift = DToL(CDbl(pnValue) * CDbl(DToL(2 ^ pnShift))) End If End Function Public Function RShift(ByVal pnValue As Long, ByVal pnShift As Long) As Long If pnShift > 31 Then RShift = 0 ElseIf pnShift < 0 Then RShift = 0 ElseIf pnShift = 0 Then RShift = pnValue Else If (pnValue And &H80000000) = &H80000000 Then RShift = (pnValue And &H7FFFFFFF) RShift = RShift \ (2 ^ pnShift) RShift = RShift Or (2 ^ (31 - pnShift)) Else RShift = Int(CDbl(pnValue) / CDbl(2 ^ pnShift)) End If If RShift = -1 Then Debug.Assert False End If End Function [/code] [code] Private Sub SendAccountAuth(ByVal BNCS_SocketHandle As Long, ByVal PacketID As Byte) Dim PacketBuffer As New clsPacketBuffer Dim clsHashing As New clsHashing Dim OutBuf As String * 20 'DWORD[5] Dim tmpOutBuf As String Dim ClientToken As Long Dim PWHashBuf(2) As String ClientToken = GetTickCount() With PacketBuffer .InsertDWORD ClientToken .InsertDWORD tmpHashBuf.SvrToken PWHashBuf(0) = clsFunctions.MakeDWORD(ClientToken) PWHashBuf(1) = clsFunctions.MakeDWORD(tmpHashBuf.SvrToken) tmpOutBuf = Join(PWHashBuf(), vbNullString) tmpOutBuf = (tmpOutBuf & AccountBuf.PWHash) 'Original password hashed in SetAccount() OutBuf = clsHashing.CalcHashBuf(tmpOutBuf) .InsertDWORD clsFunctions.GetDWORD(Mid$(OutBuf, 1, 4)) .InsertDWORD clsFunctions.GetDWORD(Mid$(OutBuf, 5, 4)) .InsertDWORD clsFunctions.GetDWORD(Mid$(OutBuf, 9, 4)) .InsertDWORD clsFunctions.GetDWORD(Mid$(OutBuf, 13, 4)) .InsertDWORD clsFunctions.GetDWORD(Mid$(OutBuf, 17, 4)) .InsertNTString AccountBuf.Username .BuildPacket BNCS, PacketID .SendBuffer BNCS_SocketHandle End With Erase PWHashBuf() End Sub [/code] btw: Thank Camel for the majority of the C to VB porting. | September 2, 2004, 10:48 AM |
Lycaon | Thanks much to both you and Camel. | September 2, 2004, 11:02 AM |