Yes, while procrastinating on a school project, I finally decided to port this now that I have a greater understanding of C so I could actually understand the code and port it accordingly... Feel free to leave comments or suggestions, or ideas how to push VB in order to make this faster :P
clsCheckRevision.cls (http://www.instimul.com/fjaros/clsCheckRevision.cls)
EDIT: While VB is still an amazing language for small utilities, hopefully this will motivate people to consider moving onto better languages for larger and more demanding projects. Also I'd like to add that this code is extremely fast for VB due to the use of API instead of native VB when hashing files. Using native VB takes somewhere from 5-15 seconds longer.
O.o wow... why not just make a program to call the DLL and make it run off the files instead of memory like BNLib? It seems so much simpler.
Quote from: Sachen on May 24, 2007, 01:08 AM
O.o wow... why not just make a program to call the DLL and make it run off the files instead of memory like BNLib? It seems so much simpler.
because checkrevision in vb can be a challange when going for speed and trying to come over the barriers posed by the limitations. the whole point of this is to motivate people to push away from using vb for big projects.
I don't follow your logic at all, but whatever.
If this doesn't perfectly show you the dramatic limits and slowness of the language, I'm not sure what else will.
you could probably make that move a bit faster if you re think those math functions.
Shh, leave reality alone. VB6 goes perfectly with his uncommented codde (poetry) and PLUM keyboard.
I honestly dont know where to start, but that code runs REALLY slow :(
You can never expect VB6 to run somthing its not designed to handle at the same speed as somthing that is designed to handle it, and even more so when there is this many calculations required (with a variable type VB6 doesnt support by defalt on almost every one)
Just by spending a few mins optimizing the for j and for k loop, I was able to get it to run the whole function in 600ms on BW binarys and 1000ms on Diablo 2 LOD binarys (500% faster than to start with) and I have no doubts that you could get it to half that time again by optimizing it some more along with the whole function. :P
At the end of the day tho, Just because VB will compile and run bad code slowly, doesnt mean by moving to somthing like C# or C++ you will become a better coder for it :)
Problems like speed issues are all problems that can normaly be over come or made up for in some other way in the long run.
Aside, nice 1 for porting this to VB6! This kinda stuff is always usefull for learning.
Hm, I had some free time to kill, and thought I would come back to this and see how fast I could get it going.
I sort of lost interest just after starting so spent little over an hour writeing/testing it.
The main problem is the + and - operators in the checksum production.
If you can think of a better way to speed them up, then its speed should be fairly constant. (maybe asm?)
In testing I got the following times average per-checkrevision:
BW: 30ms - 150ms
D2 LOD: 50ms - 250ms
W3TFT: 220ms - 850ms
I expect they will very a little depending on the cpu, but the more Xor operators, the faster it will run (fastest time being all Xor, slowest being all add or subtract)
As for the test string I have only used A=89826167 B=11610529 C=40786668 4 A=A^S B=B^C C=C^A A=A^B and changed the operators around, so Its possible it could still error. :P
I think 220ms on w3 tft binarys is nothing to write home about and im sure a few ticks could be saved here and there, but im interested to know if and where anyone can shave a few ms's off. :)
Also just for the record, this code is a re-write of shadows ported BNCSutli code.
It doesnt get the exe version/info, its simply a working(?) exmaple of a fast(ish)version check in VB6 useing only the RtlMoveMemory api to move a small block of data.
Also, to use it, you need to input the file paths in the same order as you would with BNCSutli or other common checkrevision functions. This also lets you checksum as many files as you like at once.
Private m_Padding(1027) As Byte
Private m_Seed(7) As Long
Private Const VARINVALID As Long = -1
Private Const VARZERO As Long = 0
Private Const VARLONGMAX As Long = &H7FFFFFFF
Private Const VARLONGMIN As Long = &H80000000
Private Const VARLONGWRAP As Double = 4294967296#
Private Const VAROPXOR As Byte = 94
Private Const VAROPADD As Byte = 43
Private Const VAROPMIN As Byte = 45
Private Const VARMAXOPS As Long = 5
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Class_Initialize()
Dim i As Long
For i = 4 To 1027
m_Padding(i) = (&HFF - ((i - 4) And &HFF))
Next i
m_Seed(0) = &HE7F4CB62
m_Seed(1) = &HF6A14FFC
m_Seed(2) = &HAA5504AF
m_Seed(3) = &H871FCDC2
m_Seed(4) = &H11BF6A18
m_Seed(5) = &HC57292E6
m_Seed(6) = &H7927D27E
m_Seed(7) = &H2FEC8733
End Sub
Public Function CheckRevision(ByVal strFormula As String, _
ByVal lngMPQNumber As Long, _
ByRef lngCheckSum As Long, _
ParamArray strFiles() As Variant) As Boolean
On Error GoTo CheckRevisionPuke
If lngMPQNumber < VARZERO Or lngMPQNumber > 7 Then
Exit Function
ElseIf InStr(1, strFormula, " 4 ") = 0 Then
Exit Function
End If
Dim i As Long
Dim i2 As Long
Dim i3 As Long
Dim lngPos As Long
Dim lngLengh As Long
Dim lngCount As Long
'//Useing an array of 6, so that it has 2 spare key codes and ops to work with (just in case)
' This will enable it to work with up to 6 keys codes, example: A, B, C, D, E and S
' The reassion these are fixed arrays, is because they are faster to work with on a local level
Dim lngValue(VARMAXOPS) As Long
Dim lngKeyCode(VARMAXOPS) As Long
Dim lngCmdCount As Long: lngCmdCount = VARINVALID
Dim lngOwner(VARMAXOPS) As Long 'lngOwner = lngPartner1 lngKeyOp lngPartner2
Dim lngPartner1(VARMAXOPS) As Long
Dim lngKeyOp(VARMAXOPS) As Long
Dim lngPartner2(VARMAXOPS) As Long
Dim lngOpCount As Long: lngOpCount = VARINVALID
Dim lngFile() As Long
Dim lngFileLen As Long
Dim intFileNum As Integer
Dim lngFileCount As Long
'//Check each binary exists
lngFileCount = UBound(strFiles)
For i = VARZERO To lngFileCount
If (Not VarType(strFiles(i)) = vbString) Then Exit Function
If (Dir(strFiles(i)) = vbNullString) Then Exit Function
Next i
'//Parse the formula string (needs a revamp and a speed test)
' yes I did a blizzard here, and went with the 1st idea/method that came to mind
lngPos = 1
lngLengh = Len(strFormula)
Do
'A=89826167 B=11610529 C=40786668 4
If (lngPos > (lngLengh - 2)) Then Exit Function 'no number
'//get the lengh of this string
i2 = InStr(1, Mid(strFormula, lngPos), " ")
If Asc(Mid(strFormula, lngPos, 1)) = &H34 Then '4
lngPos = lngPos + 2
Call FindHash(Asc("S"), lngKeyCode(), lngCmdCount, True)
If (i = VARINVALID) Then Exit Function
'ReDim Preserve lngValue(lngCmdCount)
Exit Do
End If
If (i2 < 4) Then Exit Function
'//find new hash index
i = FindHash(Asc(Mid(strFormula, lngPos, 1)), lngKeyCode(), lngCmdCount, True)
If (i = VARINVALID) Then Exit Function
'ReDim Preserve lngValue(lngCmdCount)
Call WrapAroundDbl(CDbl(Mid(strFormula, (lngPos + 2), (i2 - 3))), lngValue(i))
lngPos = lngPos + i2
lngCount = lngCount + 1
Loop
'//Sort the keycodes into order
For i = VARZERO To lngCmdCount
intFileNum = lngKeyCode(i)
lngFileLen = lngValue(i)
lngCount = i
For i2 = i + 1 To lngCmdCount
If lngKeyCode(i2) < intFileNum Then
intFileNum = lngKeyCode(i2)
lngFileLen = lngValue(i2)
lngCount = i2
End If
Next i2
lngKeyCode(lngCount) = lngKeyCode(i)
lngKeyCode(i) = intFileNum
lngValue(lngCount) = lngValue(i)
lngValue(i) = lngFileLen
Next i
lngCount = VARZERO
Do
'A=A^S B=B^C C=C^A A=A^B
If (lngPos > (lngLengh - 4)) Then Exit Function 'no op/partner
'//get the lengh of this string
i2 = InStr(1, Mid(strFormula, lngPos), " ")
If i2 < 6 Then
If (i2 = VARZERO) And (lngOpCount > VARZERO) Then
'got all the ops, this is the last string to parse
lngCount = VARINVALID 'brakes the loop
Else
Exit Function
End If
End If
'//find the hash index
i = FindHash(Asc(Mid(strFormula, lngPos, 1)), lngKeyCode(), lngCmdCount, False)
If (i = VARINVALID) Then Exit Function
'//Add the new ops
If ((lngOpCount + 1) > VARMAXOPS) Then Exit Function
lngOpCount = lngOpCount + 1
'ReDim Preserve lngOwner(lngOpCount)
'ReDim Preserve lngKeyOp(lngOpCount)
'ReDim Preserve lngPartner1(lngOpCount)
'ReDim Preserve lngPartner2(lngOpCount)
lngOwner(lngOpCount) = i
i = lngOpCount
lngPos = lngPos + 2
lngPartner1(i) = FindHash(Asc(Mid(strFormula, lngPos, 1)), lngKeyCode(), lngCmdCount, False)
If (lngPartner1(i) = VARINVALID) Then Exit Function
lngPos = lngPos + 1
lngKeyOp(i) = Asc(Mid(strFormula, lngPos, 1))
If ((Not lngKeyOp(i) = VAROPXOR) And (Not lngKeyOp(i) = VAROPADD) And (Not lngKeyOp(i) = VAROPMIN)) Then
Exit Function 'unknown operator
End If
lngPos = lngPos + 1
lngPartner2(i) = FindHash(Asc(Mid(strFormula, lngPos, 1)), lngKeyCode(), lngCmdCount, False)
If (lngPartner2(i) = VARINVALID) Then Exit Function
lngPos = lngPos + 2 'skip that space terminator
If (lngCount = VARINVALID) Then
'finished decodeing the hash formula
Exit Do
End If
lngCount = lngCount + 1
Loop
'//check we got some hash values to work with
If (lngCmdCount < 1) Or (lngOpCount < 1) Then
Exit Function
End If
'//Apply the seed based on the mpq file number
lngValue(VARZERO) = lngValue(VARZERO) Xor m_Seed(lngMPQNumber)
'//Hash the 3 binarys
For i = VARZERO To lngFileCount
intFileNum = FreeFile
Open strFiles(i) For Binary Lock Read As #intFileNum
lngFileLen = LOF(intFileNum)
'//Abort on empty files or files over 50mb
If (lngFileLen < 1) Or (lngFileLen > 50000000) Then
Close #intFileNum
Exit Function
End If
lngLengh = lngFileLen
i3 = (lngLengh Mod 1024)
If i3 Then lngLengh = lngLengh + (1024 - i3)
lngLengh = (lngLengh / 4) - 1
ReDim lngFile(lngLengh) As Long
Get #intFileNum, 1, lngFile()
Close #intFileNum
intFileNum = 0
'//pad the padding buffer with the nibble
i2 = (lngFileLen Mod 4)
If i2 Then
i2 = (4 - i2)
Call RtlMoveMemory(m_Padding(i2), lngFile(((lngFileLen + i2) / 4) - 1), (4 - i2))
Else
i2 = 4
End If
'//pad the file buffer with the padding buffer
If ((((lngLengh + 1) * 4) - lngFileLen) > VARZERO) Then
Call RtlMoveMemory(lngFile(((lngFileLen + i2) / 4) - 1), m_Padding(i2), (1024 - i3) + (4 - i2))
End If
'//Calculate the checksum on this file with are command/op buffer
For lngCount = VARZERO To lngLengh
'//Copy the next file long into the end value (S)
lngValue(lngCmdCount) = lngFile(lngCount)
'//Do each calculation (A=A^B etc)
For i2 = VARZERO To lngOpCount
If lngKeyOp(i2) = VAROPXOR Then
'xoring is not an issue here
lngValue(lngOwner(i2)) = lngValue(lngPartner1(i2)) Xor lngValue(lngPartner2(i2))
Else
Call WrapAroundOp(lngKeyOp(i2), lngValue(lngPartner1(i2)), lngValue(lngPartner2(i2)), lngValue(lngOwner(i2)))
End If
Next i2
Next lngCount
Next i
lngCheckSum = lngValue(lngCmdCount - 1)
Erase lngFile()
CheckRevision = True
Exit Function
CheckRevisionPuke:
Debug.Print Err.Number & " " & Err.Description
If intFileNum Then
Close #intFileNum
intFileNum = 0
End If
Erase lngFile()
CheckRevision = False
End Function
Private Function FindHash(ByVal lngKeyCodeToCheck As Integer, _
ByRef lngKeyCodeArray() As Long, _
ByRef lngKeyCodeCount As Long, _
ByVal bCreateIndex As Boolean) As Long
Dim i As Integer
For i = 0 To lngKeyCodeCount
If (lngKeyCodeArray(i) = lngKeyCodeToCheck) Then
FindHash = i
Exit Function
End If
Next i
If bCreateIndex And (lngKeyCodeCount < VARMAXOPS) Then
i = lngKeyCodeCount + 1
lngKeyCodeCount = i
'ReDim Preserve lngKeyCodeArray(i)
lngKeyCodeArray(i) = lngKeyCodeToCheck
FindHash = i
Else
FindHash = VARINVALID
End If
End Function
Private Sub WrapAroundOp(ByRef lngOp As Long, ByRef lngValue1 As Long, ByRef lngValue2 As Long, ByRef lngOutValue As Long, Optional ByVal dblData As Double)
If lngOp = VAROPADD Then
dblData = lngValue1
dblData = dblData + lngValue2
Else
dblData = lngValue1
dblData = dblData - lngValue2
End If
If dblData > VARLONGMAX Then
dblData = dblData - VARLONGWRAP
ElseIf dblData < VARLONGMIN Then
dblData = dblData + VARLONGWRAP
End If
lngOutValue = dblData
End Sub
Private Sub WrapAroundDbl(ByVal dblData As Double, ByRef lngOutValue As Long)
If dblData > VARLONGMAX Then
dblData = dblData - VARLONGWRAP
ElseIf dblData < VARLONGMIN Then
dblData = dblData + VARLONGWRAP
End If
lngOutValue = dblData
End Sub
nice but you're forgetting that the integers in the hash strings are bigger than 32bit so that code won't work. Keep in mind that unlike C which automatically treats overflows, VB doesn't ex:
(this is a bad example, i'd much rather do it with unsigned variables, but you get the point)
#include <iostream.h>
void main()
{
long lngA = 2147483647;
lngA++;
cout << lngA;
}
that's legal C and lngA will result in being -2147483648
Sub Main()
Dim lngA As Long
lngA = 2147483647
lngA = lngA + 1
MsgBox lngA
End Sub
lngA = lngA + 1 will overflow.
EDIT: I tested my code with this string:
A=3201142061 C=2154661726 B=1164683444 4 A=A+S B=B-C C=C+A A=A+B
EDIT2: Actually your code returns wrong result anyways:
Hash Used: A=32011420 C=21546617 B=11646834 4 A=A+S B=B-C C=C+A A=A+B
Finished!
BNCSUtil CR: BF 07 67 75
My CR : BF 07 67 75
Ringo CR : 12 EB 0F 94
Quote from: l2k-Shadow on May 30, 2007, 11:45 PM
nice but you're forgetting that the integers in the hash strings are bigger than 32bit so that code won't work.
Ye, thats why I explained about the value string I used in testing and used "working" with a question mark. :P
I kinda slapped it together asap, to work with my test string, just to test speed.
Quote from: l2k-Shadow on May 30, 2007, 11:45 PM
EDIT: I tested my code with this string:
A=3201142061 C=2154661726 B=1164683444 4 A=A+S B=B-C C=C+A A=A+B
EDIT2: Actually your code returns wrong result anyways:
Hash Used: A=32011420 C=21546617 B=11646834 4 A=A+S B=B-C C=C+A A=A+B
Finished!
BNCSUtil CR: BF 07 67 75
My CR : BF 07 67 75
Ringo CR : 12 EB 0F 94
Ah I see, that is abit unexpected. I wasnt aware that the values can come in any order, and am supprised that they are not handled in the order they are in.
Edited my post from yesterday and added a WrapArroundDbl() function to handle bigger values for a keycode value.
I Also added some code to sort the keycode/values before going onto parseing the rest of the string.
Should work on any combo/formula now :)
Quote from: l2k-Shadow on May 30, 2007, 11:45 PM
nice but you're forgetting that the integers in the hash strings are bigger than 32bit so that code won't work. Keep in mind that unlike C which automatically treats overflows, VB doesn't ex:
(this is a bad example, i'd much rather do it with unsigned variables, but you get the point)
#include <iostream.h>
void main()
{
long lngA = 2147483647;
lngA++;
cout << lngA;
}
that's legal C and lngA will result in being -2147483648
Sub Main()
Dim lngA As Long
lngA = 2147483647
lngA = lngA + 1
MsgBox lngA
End Sub
lngA = lngA + 1 will overflow.
Sorry for the bump, but..
Compile to an EXE, and disable integer overflow checks. My ancient VB CRev algorithm runs plenty fast; I've got preprocessor directives to an overloaded adder function that will handle overflows, and I disable it when I compile. In the IDE, it crawls through checkrevision - it will actually call out to bnetauth.dll if it's found in the working directory - but it runs acceptably fast once it's compiled.
I released my vb checkrevision module years ago, if you look hard enough you can probably find it.
That said, you should move on to a slower language like Java.