Valhalla Legends Forums Archive | Battle.net Bot Development | Broken SHA-1 function for VB?

AuthorMessageTime
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

Search