ver-IX86-x.mpq CheckRevision in VB

[l2k-Shadow]

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

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.

[Barabajagal]

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.

[l2k-Shadow]

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.

[Barabajagal]

I don't follow your logic at all, but whatever.

[l2k-Shadow]

If this doesn't perfectly show you the dramatic limits and slowness of the language, I'm not sure what else will.

[l)ragon]

you could probably make that move a bit faster if you re think those math functions.

[Warrior]

Shh, leave reality alone. VB6 goes perfectly with his uncommented codde (poetry) and PLUM keyboard.

[Ringo]

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.

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.

[Ringo]

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.

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.

Code Select Expand


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


[l2k-Shadow]

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)

Code Select Expand


#include <iostream.h>
void main()
{
     long lngA = 2147483647;
     lngA++;
     cout << lngA;
}

that's legal C and lngA will result in being -2147483648

Code Select Expand


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:

Code Select Expand


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:

Code Select Expand


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


[Ringo]

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.
I kinda slapped it together asap, to work with my test string, just to test speed.

EDIT: I tested my code with this string:

Code Select Expand


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:

Code Select Expand


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

[Camel]

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)

Code Select Expand


#include <iostream.h>
void main()
{
     long lngA = 2147483647;
     lngA++;
     cout << lngA;
}

that's legal C and lngA will result in being -2147483648

Code Select Expand


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.