Code:
Option Explicit
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
Private State(4) As Long
Private ByteCounter As Long
Private ByteBuffer(63) As Byte
Private m_lOnBits(30) As Long
Private m_l2Power(30) As Long
Private Const BITS_TO_A_BYTE As Long = 8
Private Const BYTES_TO_A_WORD As Long = 4
Private Const BITS_TO_A_WORD As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE
Private Property Get RegisterA() As String
RegisterA = State(1)
End Property
Private Property Get RegisterB() As String
RegisterB = State(2)
End Property
Private Property Get RegisterC() As String
RegisterC = State(3)
End Property
Private Property Get RegisterD() As String
RegisterD = State(4)
End Property
Private Sub Class_Initialize()
m_lOnBits(0) = 1
m_lOnBits(1) = 3
m_lOnBits(2) = 7
m_lOnBits(3) = 15
m_lOnBits(4) = 31
m_lOnBits(5) = 63
m_lOnBits(6) = 127
m_lOnBits(7) = 255
m_lOnBits(8) = 511
m_lOnBits(9) = 1023
m_lOnBits(10) = 2047
m_lOnBits(11) = 4095
m_lOnBits(12) = 8191
m_lOnBits(13) = 16383
m_lOnBits(14) = 32767
m_lOnBits(15) = 65535
m_lOnBits(16) = 131071
m_lOnBits(17) = 262143
m_lOnBits(18) = 524287
m_lOnBits(19) = 1048575
m_lOnBits(20) = 2097151
m_lOnBits(21) = 4194303
m_lOnBits(22) = 8388607
m_lOnBits(23) = 16777215
m_lOnBits(24) = 33554431
m_lOnBits(25) = 67108863
m_lOnBits(26) = 134217727
m_lOnBits(27) = 268435455
m_lOnBits(28) = 536870911
m_lOnBits(29) = 1073741823
m_lOnBits(30) = 2147483647
m_l2Power(0) = 1
m_l2Power(1) = 2
m_l2Power(2) = 4
m_l2Power(3) = 8
m_l2Power(4) = 16
m_l2Power(5) = 32
m_l2Power(6) = 64
m_l2Power(7) = 128
m_l2Power(8) = 256
m_l2Power(9) = 512
m_l2Power(10) = 1024
m_l2Power(11) = 2048
m_l2Power(12) = 4096
m_l2Power(13) = 8192
m_l2Power(14) = 16384
m_l2Power(15) = 32768
m_l2Power(16) = 65536
m_l2Power(17) = 131072
m_l2Power(18) = 262144
m_l2Power(19) = 524288
m_l2Power(20) = 1048576
m_l2Power(21) = 2097152
m_l2Power(22) = 4194304
m_l2Power(23) = 8388608
m_l2Power(24) = 16777216
m_l2Power(25) = 33554432
m_l2Power(26) = 67108864
m_l2Power(27) = 134217728
m_l2Power(28) = 268435456
m_l2Power(29) = 536870912
m_l2Power(30) = 1073741824
End Sub
Public Function Write_Gore_Auth_String(CDKEY As String, SEED_AuthString As String) As String
On Error Resume Next
Write_Gore_Auth_String = "I" & MD5_raw(CDKEY) & SHA1(SEED_AuthString)
End Function
Private Function LShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits <0> 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
m_l2Power(iShiftBits))
End If
End Function
Private Function RShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits <0> 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function AddUnsigned(ByVal lX As Long, ByVal lY As Long) As Long
Dim lX4 As Long
Dim lY4 As Long
Dim lX8 As Long
Dim lY8 As Long
Dim lResult As Long
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function LRot(ByVal x As Long, ByVal n As Long) As Long
LRot = LShift(x, n) Or RShift(x, (32 - n))
End Function
Private Function ConvertToWordArray(sMessage As String) As Long()
Dim lMessageLength As Long
Dim lNumberOfWords As Long
Dim lWordArray() As Long
Dim lBytePosition As Long
Dim lByteCount As Long
Dim lWordCount As Long
Dim lByte As Long
Const MODULUS_BITS As Long = 512
Const CONGRUENT_BITS As Long = 448
lMessageLength = Len(sMessage)
lNumberOfWords = (((lMessageLength + _
((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ _
(MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * _
(MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or _
LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Private Function SHA1(sMessage As String) As String
Dim HASH(4) As Long
Dim M() As Long
Dim W(79) As Long
Dim a, B, c, d, e As Long
Dim G, h, i, j As Long
Dim T1, T2 As Long
HASH(0) = &H67452301
HASH(1) = &HEFCDAB89
HASH(2) = &H98BADCFE
HASH(3) = &H10325476
HASH(4) = &HC3D2E1F0
M = ConvertToWordArray(sMessage)
For i = 0 To UBound(M) Step 16
a = HASH(0)
B = HASH(1)
c = HASH(2)
d = HASH(3)
e = HASH(4)
For G = 0 To 15
W(G) = M(i + G)
Next G
For G = 16 To 79
W(G) = LRot(W(G - 3) Xor W(G - 8) Xor W(G - 14) Xor W(G - 16), 1)
Next G
For j = 0 To 79
If j <= 19 Then
T1 = (B And c) Or ((Not B) And d)
T2 = &H5A827999
ElseIf j <= 39 Then
T1 = B Xor c Xor d
T2 = &H6ED9EBA1
ElseIf j <= 59 Then
T1 = (B And c) Or (B And d) Or (c And d)
T2 = &H8F1BBCDC
ElseIf j <= 79 Then
T1 = B Xor c Xor d
T2 = &HCA62C1D6
End If
h = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(LRot(a, 5), T1), e), T2), W(j))
e = d
d = c
c = LRot(B, 30)
B = a
a = h
Next j
HASH(0) = AddUnsigned(a, HASH(0))
HASH(1) = AddUnsigned(B, HASH(1))
HASH(2) = AddUnsigned(c, HASH(2))
HASH(3) = AddUnsigned(d, HASH(3))
HASH(4) = AddUnsigned(e, HASH(4))
Next i
SHA1 = LCase(Right("00000000" & Hex(HASH(0)), 8) & _
Right("00000000" & Hex(HASH(1)), 8) & _
Right("00000000" & Hex(HASH(2)), 8) & _
Right("00000000" & Hex(HASH(3)), 8) & _
Right("00000000" & Hex(HASH(4)), 8))
End Function
Private Function MD5_raw(SourceString As String) As String
On Error Resume Next
MD5Init
MD5Update Len(SourceString), StringToArray(SourceString)
MD5Final
MD5_raw = LCase(GetValues)
End Function
Private Function StringToArray(InString As String) As Byte()
On Error Resume Next
Dim i As Integer, bytBuffer() As Byte
ReDim bytBuffer(Len(InString))
For i = 0 To Len(InString) - 1
bytBuffer(i) = Asc(Mid(InString, i + 1, 1))
Next i
StringToArray = bytBuffer
End Function
Private Function GetValues() As String
On Error Resume Next
GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
End Function
Private Function LongToString(Num As Long) As String
On Error Resume Next
Dim a As Byte, B As Byte, c As Byte, 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
Private Sub MD5Init()
On Error Resume Next
ByteCounter = 0
State(1) = UnsignedToLong(1732584193#)
State(2) = UnsignedToLong(4023233417#)
State(3) = UnsignedToLong(2562383102#)
State(4) = UnsignedToLong(271733878#)
End Sub
Private Sub MD5Final()
On Error Resume Next
Dim dblBits As Double, Padding(72) As Byte, lngBytesBuffered As Long
Padding(0) = &H80
dblBits = ByteCounter * 8
lngBytesBuffered = ByteCounter Mod 64
If lngBytesBuffered <56>= lngBufferRemaining Then
For II = 0 To lngBufferRemaining - 1
ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
Next II
MD5Transform ByteBuffer
lngRem = (InputLen) Mod 64
For i = lngBufferRemaining To InputLen - II - lngRem Step 64
For j = 0 To 63
ByteBuffer(j) = InputBuffer(i + j)
Next j
MD5Transform ByteBuffer
Next i
lngBufferedBytes = 0
Else
i = 0
End If
For K = 0 To InputLen - i - 1
ByteBuffer(lngBufferedBytes + K) = InputBuffer(i + K)
Next K
End Sub
Private Sub MD5Transform(Buffer() As Byte)
On Error Resume Next
Dim x(16) As Long, a As Long, B As Long, c As Long, d As Long
a = State(1)
B = State(2)
c = State(3)
d = State(4)
Decode 64, x, Buffer
FF a, B, c, d, x(0), S11, -680876936
FF d, a, B, c, x(1), S12, -389564586
FF c, d, a, B, x(2), S13, 606105819
FF B, c, d, a, x(3), S14, -1044525330
FF a, B, c, d, x(4), S11, -176418897
FF d, a, B, c, x(5), S12, 1200080426
FF c, d, a, B, x(6), S13, -1473231341
FF B, c, d, a, x(7), S14, -45705983
FF a, B, c, d, x(8), S11, 1770035416
FF d, a, B, c, x(9), S12, -1958414417
FF c, d, a, B, x(10), S13, -42063
FF B, c, d, a, x(11), S14, -1990404162
FF a, B, c, d, x(12), S11, 1804603682
FF d, a, B, c, x(13), S12, -40341101
FF c, d, a, B, x(14), S13, -1502002290
FF B, c, d, a, x(15), S14, 1236535329
GG a, B, c, d, x(1), S21, -165796510
GG d, a, B, c, x(6), S22, -1069501632
GG c, d, a, B, x(11), S23, 643717713
GG B, c, d, a, x(0), S24, -373897302
GG a, B, c, d, x(5), S21, -701558691
GG d, a, B, c, x(10), S22, 38016083
GG c, d, a, B, x(15), S23, -660478335
GG B, c, d, a, x(4), S24, -405537848
GG a, B, c, d, x(9), S21, 568446438
GG d, a, B, c, x(14), S22, -1019803690
GG c, d, a, B, x(3), S23, -187363961
GG B, c, d, a, x(8), S24, 1163531501
GG a, B, c, d, x(13), S21, -1444681467
GG d, a, B, c, x(2), S22, -51403784
GG c, d, a, B, x(7), S23, 1735328473
GG B, c, d, a, x(12), S24, -1926607734
HH a, B, c, d, x(5), S31, -378558
HH d, a, B, c, x(8), S32, -2022574463
HH c, d, a, B, x(11), S33, 1839030562
HH B, c, d, a, x(14), S34, -35309556
HH a, B, c, d, x(1), S31, -1530992060
HH d, a, B, c, x(4), S32, 1272893353
HH c, d, a, B, x(7), S33, -155497632
HH B, c, d, a, x(10), S34, -1094730640
HH a, B, c, d, x(13), S31, 681279174
HH d, a, B, c, x(0), S32, -358537222
HH c, d, a, B, x(3), S33, -722521979
HH B, c, d, a, x(6), S34, 76029189
HH a, B, c, d, x(9), S31, -640364487
HH d, a, B, c, x(12), S32, -421815835
HH c, d, a, B, x(15), S33, 530742520
HH B, c, d, a, x(2), S34, -995338651
II a, B, c, d, x(0), S41, -198630844
II d, a, B, c, x(7), S42, 1126891415
II c, d, a, B, x(14), S43, -1416354905
II B, c, d, a, x(5), S44, -57434055
II a, B, c, d, x(12), S41, 1700485571
II d, a, B, c, x(3), S42, -1894986606
II c, d, a, B, x(10), S43, -1051523
II B, c, d, a, x(1), S44, -2054922799
II a, B, c, d, x(8), S41, 1873313359
II d, a, B, c, x(15), S42, -30611744
II c, d, a, B, x(6), S43, -1560198380
II B, c, d, a, x(13), S44, 1309151649
II a, B, c, d, x(4), S41, -145523070
II d, a, B, c, x(11), S42, -1120210379
II c, d, a, B, x(2), S43, 718787259
II B, c, d, a, x(9), S44, -343485551
State(1) = LongOverflowAdd(State(1), a)
State(2) = LongOverflowAdd(State(2), B)
State(3) = LongOverflowAdd(State(3), c)
State(4) = LongOverflowAdd(State(4), d)
End Sub
Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte)
On Error Resume Next
Dim intDblIndex As Integer, intByteIndex As Integer, dblSum As Double
intDblIndex = 0
For intByteIndex = 0 To Length - 1 Step 4
dblSum = InputBuffer(intByteIndex) + InputBuffer(intByteIndex + 1) * 256# + InputBuffer(intByteIndex + 2) * 65536# + InputBuffer(intByteIndex + 3) * 16777216#
OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
intDblIndex = intDblIndex + 1
Next intByteIndex
End Sub
Private Function FF(a As Long, B As Long, c As Long, d As Long, x As Long, s As Long, ac As Long) As Long
a = LongOverflowAdd4(a, (B And c) Or (Not (B) And d), x, ac)
a = LongLeftRotate(a, s)
a = LongOverflowAdd(a, B)
End Function
Private Function GG(a As Long, B As Long, c As Long, d As Long, x As Long, s As Long, ac As Long) As Long
a = LongOverflowAdd4(a, (B And d) Or (c And Not (d)), x, ac)
a = LongLeftRotate(a, s)
a = LongOverflowAdd(a, B)
End Function
Private Function HH(a As Long, B As Long, c As Long, d As Long, x As Long, s As Long, ac As Long) As Long
a = LongOverflowAdd4(a, B Xor c Xor d, x, ac)
a = LongLeftRotate(a, s)
a = LongOverflowAdd(a, B)
End Function
Private Function II(a As Long, B As Long, c As Long, d As Long, x As Long, s As Long, ac As Long) As Long
a = LongOverflowAdd4(a, c Xor (B Or Not (d)), x, ac)
a = LongLeftRotate(a, s)
a = LongOverflowAdd(a, B)
End Function
Private Function LongLeftRotate(Value As Long, bits As Long) As Long
Dim lngSign As Long, lngI As Long
bits = bits Mod 32
If bits = 0 Then LongLeftRotate = Value: Exit Function
For lngI = 1 To bits
lngSign = Value And &HC0000000
Value = (Value And &H3FFFFFFF) * 2
Value = Value Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
Next
LongLeftRotate = Value
End Function
Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
End Function
Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + ((val3 And &HFFFF0000) \ 65536) + ((val4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
End Function
Private Function UnsignedToLong(Value As Double) As Long
If Value <0>= OFFSET_4 Then Error 6
If Value <= MAXINT_4 Then
UnsignedToLong = Value
Else
UnsignedToLong = Value - OFFSET_4
End If
End Function
Private Function LongToUnsigned(Value As Long) As Double
If Value < 0 Then
LongToUnsigned = Value + OFFSET_4
Else
LongToUnsigned = Value
End If
End Function
![[NWP] - A shitstorm of hax! - Powered by vBulletin](images/misc/vbulletin4_logo.png){kind=logo}
Reply With Quote
Senior Member
" - Destruction
Originally Posted by Deadly
)
Posting Permissions
