What's new

My Super Reverse Engineering Vb6 module (For all your RE Newbs, i mean err.., Needs!)

jahra!n

New member
I released this in another thread but i beleave this deserves its own thread. For all the reverse engineering projects i took on for reverse engineering model and animation etc... file types in games i use this really simple to use module i created over time. I feel its at a point where i can share it with anyone whos interested in getting into reverse engineering and has basic knowlege of VB6 programming. All you need besides this is a hex editor to study the hex file structures, this module has all you may need to convert data from the hex in the files to stuff like floats, integers, endian swapped values, etc. Also a quick start tutorial on how to use it is also included in the code.

Theres lots of low level functions in here so if you really dont want to learn C++ to do reverse engineering, you can use these low level functions in vb6.

anyways, heres the code for the modules, just copy paste it into a new module in vb6 and save it.

Enjoy
Code:
'******Jahrain's 3d Reverse Engineering Functions********
'The sources of most of this stuff comes from all over the net
'big thanks goes out to Yomamma for the low level Floating point
'from and to hex conversion functions.
'Please Share the source code to any applications using or
'referencing anything from this code
'       _____________    __  __  ____   ___   _____  ____   __
'      /____  ___/   |\ / /\/ /\/ _  \ /   |\/_  _/\/   |\ / /\
'      \___/ /\_/ /| ||/ /_/ / / /\/ |/ /| ||\/ /\\/ /| ||/ / /
'     __  / / // /_| |/ __  / / __¯ </ /_| ||/ / // / | |/ / /
'    |  \/ / // ___  / / / / / /\_| / ___  |/ /_// / /|   / /
'     \___/ //_/\__|/_/ /_/ /_/ //_/_/ __|/____//_/ / |__/ /
'      \__\/ \_\/  \\_\/\_\/\_\/ \_\_\/  \\____\\_\/  \__\/
'-Word art by Jahrain

'*****Instructions*******
'To use any of these functions, its simple
'just add this module to the project. and use this to open the file into the Global Hex Array.

'    Open "C:\My File.dat" For Binary As #1
'    ReDim ByteArray(0 To LOF(1) - 1) As Byte
'    Get 1, , ByteArray
'    Close #1

'Now any function in this can be used on any array number or offset in the file
'for example, if you want to read a Single Precision floating point number from
'the offset of 32
'just type this

'   text1.text = GetSingle(32)

'and this returns the float value of that offset in the opened file and displays it in the textbox

'Now happy reverse engineering :)


Public ByteArray() As Byte 'this is the global array of the
'Hex bytes in a file opened used in this module.

'These are common data types used to store information in models, animations etc...

Type Vector3d 'this is mainly for vertecies, normals etc...
x As Single
y As Single
Z As Single
End Type

Type Vector2d 'this is mainly for texture coords and other 2 dimentional vectors
U As Single
V As Single
End Type

Type Vector4d 'Although rarely used, this is for 4 dimentional data types such as quaternions which are used in bone orientation and animation
i As Single
j As Single
k As Single
W As Single
End Type

Type FaceIndex3d 'These are for storing Triangle Data for models
a As Integer
B As Integer
C As Integer
End Type

'These are more complex types used to hold lots of model data in groups and what not
Type MESH
'for storing model mesh data and hex offsets
MeshName As String
MeshOffset As Double

VertexCount As Long
INDEXCOUNT As Long

VTXBlock() As Vector3d
INDBlock() As FaceIndex3d
End Type

Type BM8
'you probably wont use this
BMOffset As Double
BMSize As Long
End Type
Type TGA
'or this either
TGAOffset As Double
TGAsize As Long
End Type


Public Function GetTag(Offset As Double) As String 'This Function returns a string of 4 Characters at any given offset.
'Certain file types identify blocks by 4 letter 'tags' so this may proove helpful.
    tmp1 = Chr$(ByteArray(Offset))
    tmp2 = Chr$(ByteArray(Offset + 1))
    tmp3 = Chr$(ByteArray(Offset + 2))
    tmp4 = Chr$(ByteArray(Offset + 3))
    
    GetTag = tmp1 & tmp2 & tmp3 & tmp4
    
End Function
Public Function GetLong(Offset As Double) As Double 'Returns a unsigned Long integer value from the specified offset in the global bytearray

    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))
    tmp3 = Hex(ByteArray(Offset + 2))
    tmp4 = Hex(ByteArray(Offset + 3))
    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
    If Len(tmp3) = 1 Then tmp3 = "0" & tmp3
    If Len(tmp4) = 1 Then tmp4 = "0" & tmp4
    
    GetLong = HexToDec(tmp4 & tmp3 & tmp2 & tmp1)
    
End Function
Public Function GetLongS(Offset As Double) As Double 'Returns a Endian Swapped unsigned Long integer value from the specified offset in the global bytearray
If Offset < UBound(ByteArray) Then
    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))
    tmp3 = Hex(ByteArray(Offset + 2))
    tmp4 = Hex(ByteArray(Offset + 3))
    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
    If Len(tmp3) = 1 Then tmp3 = "0" & tmp3
    If Len(tmp4) = 1 Then tmp4 = "0" & tmp4
    
    GetLongS = HexToDec(tmp1 & tmp2 & tmp3 & tmp4)
    Else
    GetLongS = 0
    End If
End Function
Public Function GetInt(Offset As Double) As Long 'Returns a unsigned short integer value from the specified offset in the global bytearray
    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))

    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2

    
    GetInt = HexToDec(tmp2 & tmp1)
    
End Function
Public Function GetIntS(Offset As Double) As Long 'Returns a endian swapped unsigned short integer value from the specified offset in the global bytearray

    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))

    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2

    
    GetIntS = HexToDec(tmp1 & tmp2)
    
End Function
Public Function GetByte(Offset As Double) As Long 'returns a unsigned Byte value from the specified offset
If Offset < UBound(ByteArray) Then
    tmp1 = Hex(ByteArray(Offset))


    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1

    
    GetByte = HexToDec(tmp1)
    Else
     GetByte = 0
     End If
End Function
Public Function GetIntS1(Offset As Double) As Long 'same as GetIntS except it swaps bytes. example: reads A0 1F instead of 0A F1
    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))
    If Len(tmp1) = 2 Then tmp1 = Mid(tmp1, 2, 1) & Mid(tmp1, 1, 1)
    If Len(tmp2) = 2 Then tmp2 = Mid(tmp2, 2, 1) & Mid(tmp2, 1, 1)

    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2

    tmp3 = tmp2 & tmp1

    
    GetIntS = CLng("&h" & tmp3)
End Function

Public Function IsTag(Offset As Double) As Boolean 'just a boolean to return if an offset is a specified 4 byte tag, add some to the long list of ifs to check ;)
If GetTag(Offset) = "MATE" Or GetTag(Offset) = "OBJM" Or GetTag(Offset) = "CNST" Or GetTag(Offset) = "TEXT" Or GetTag(Offset) = "LIGH" Or GetTag(Offset) = "MESH" Or GetTag(Offset) = "MORP" Or GetTag(Offset) = "MATA" Or GetTag(Offset) = "BLND" Or GetTag(Offset) = "FRAM" Or GetTag(Offset) = "ANIM" Or GetTag(Offset) = "FOG " Or GetTag(Offset) = "ENVL" Then
IsTag = True
Else
IsTag = False
End If


End Function

Private Function HexToDec(ByVal HexStr As String) As Double 'Low level hex to decimal conversion
Dim mult As Double
Dim DecNum As Double
Dim ch As String
Dim i As Integer
mult = 1
DecNum = 0
For i = Len(HexStr) To 1 Step -1
    ch = Mid(HexStr, i, 1)
    If (ch >= "0") And (ch <= "9") Then
        DecNum = DecNum + (Val(ch) * mult)
    Else
        If (ch >= "A") And (ch <= "F") Then
            DecNum = DecNum + ((Asc(ch) - Asc("A") + 10) * mult)
        Else
            If (ch >= "a") And (ch <= "f") Then
                DecNum = DecNum + ((Asc(ch) - Asc("a") + 10) * mult)
            Else
                HexToDec = 0
                Exit Function
            End If
        End If
    End If
    mult = mult * 16
Next i
HexToDec = DecNum
End Function

Public Function GetFSingleS(ByRef address As Double, Optional Scalar As Integer = 512) As Single 'This reads a 16bit Fixed decimal signed integer and devides it by the scalar to get the floating point value. This is commonly used in GameCube Models
Dim TmpInt As Long
TmpInt = GetIntS(address)
GetFSingleS = nSigned(TmpInt) / Scalar

End Function
Public Function GetSingle(ByRef address As Double) 'Returns a Single Point Precision Decimal number from the specified offset in the global hex array
tmph = ""
    For i = 0 To 3
        x = CStr(Hex(ByteArray(address + i)))
        If Len(x) = 1 Then x = "0" & x
        tmph = tmph & x
    Next i
    
       GetSingle = CSng(HaloFloat(CStr(tmph)))
End Function

Public Function GetSingleS(ByRef address As Double) 'Returns a Endian Swapped Single Point Precision Decimal number from the specified offset in the global hex array
tmph = ""
    For i = 3 To 0 Step -1
        x = CStr(Hex(ByteArray(address + i)))
        If Len(x) = 1 Then x = "0" & x
        tmph = tmph & x
    Next i
    
       GetSingleS = CDbl(HaloFloat(CStr(tmph)))
End Function






Private Function BinToDec(ByVal num As String) As String 'Converts a Binary string to Decimal
bins = num
tmp1 = InStr(1, bins, ".")
If tmp1 = 0 Then
 unman = bins
 man = ""
Else
 unman = Mid$(bins, 1, tmp1 - 1)
 man = Mid$(bins, tmp1 + 1)
End If
For i = 1 To Len(unman) - 1
 tmp2 = Mid$(unman, Len(unman) - i, 1)
 If tmp2 = 1 Then total = total + 2 ^ i
Next i
For i = 1 To Len(man)
 tmp2 = Mid$(man, i, 1)
 If tmp2 = 1 Then total = total + 2 ^ (i * -1)
Next i
If Right(unman, 1) = "1" Then total = total + 1
BinToDec = Str$(total)
End Function
Private Function HexToBin(ByVal hexy As String) As String
'Converts Hex to binary
For i = 1 To Len(hexy)
 chexy = Mid$(hexy, i, 1)
 
Select Case chexy
 Case "0"
 tmp1 = tmp1 + "0000"
 Case "1"
 tmp1 = tmp1 + "0001"
 Case "2"
 tmp1 = tmp1 + "0010"
 Case "3"
 tmp1 = tmp1 + "0011"
 Case "4"
 tmp1 = tmp1 + "0100"
 Case "5"
 tmp1 = tmp1 + "0101"
 Case "6"
 tmp1 = tmp1 + "0110"
 Case "7"
 tmp1 = tmp1 + "0111"
 Case "8"
 tmp1 = tmp1 + "1000"
 Case "9"
 tmp1 = tmp1 + "1001"
 Case "A"
 tmp1 = tmp1 + "1010"
 Case "B"
 tmp1 = tmp1 + "1011"
 Case "C"
 tmp1 = tmp1 + "1100"
 Case "D"
 tmp1 = tmp1 + "1101"
 Case "E"
 tmp1 = tmp1 + "1110"
 Case "F"
 tmp1 = tmp1 + "1111"
End Select

Next i

HexToBin = tmp1
End Function
Private Function HaloFloat(hexs As String) As Double
'Low level function to convert 4 byte hex strings into floats
For i = 1 To Len(hexs)
If Mid$(hexs, i, 1) <> "0" Then GoTo exitthiscrap
Next i
s = 0
GoTo endingskip

exitthiscrap:
For i = 1 To Len(hexs) Step 2
 tmp1 = Mid$(hexs, i, 2) + tmp1
Next i
tmp1 = HexToBin(tmp1)

'Split
sign = Mid$(tmp1, 1, 1)
exponent = Mid$(tmp1, 2, 8)
mantissa = Mid$(tmp1, 10, 23)

'Sign
If sign = "0" Then
 s = 1
Else
 s = -1
End If

'Exponent
e = Val(BinToDec(exponent)) - 127

'Mantissa
m = Val(BinToDec("1." + mantissa))

endingskip:
HaloFloat = s * m * (2 ^ e)
End Function
Private Function DecOfBin(ByVal num As String) As String
'Converts Binary string to decimal values
bins = num
tmp1 = InStr(1, bins, ".")
If tmp1 = 0 Then
 unman = bins
 man = ""
Else
 unman = Mid$(bins, 1, tmp1 - 1)
 man = Mid$(bins, tmp1 + 1)
End If
For i = 1 To Len(unman) - 1
 tmp2 = Mid$(unman, Len(unman) - i, 1)
 If tmp2 = 1 Then total = total + 2 ^ i
Next i
For i = 1 To Len(man)
 tmp2 = Mid$(man, i, 1)
 If tmp2 = 1 Then total = total + 2 ^ (i * -1)
Next i
If Right(unman, 1) = "1" Then total = total + 1
DecOfBin = Str$(total)
End Function

Private Function DecOfFloat(ByVal Float As String) As String
'Converts floating point string to decimal values
Dim sign, mantissa1, mantissa2, exponent As String

'If Left(Float, 1) = 1 Then sign = "-" Else sign = ""
If Left(Float, 1) = 1 Then sign = -1 Else sign = 1

exponent = Mid(Float, 2, 8)

exponent = DecOfBin(exponent)

exponent = (exponent - 127)

'mantissa1 = 1 & Mid(Float, 10, exponent)

'mantissa2 = Mid(Float, (10 + exponent), 32)

'mantissa1 = DecOfBin(mantissa1)
'mantissa2 = DecOfPointBin(mantissa2)

man2 = "1." + Mid$(Float, 10)
man1 = DecOfBin(man2)

DecOfFloat = sign * man1 * 2 ^ exponent

'DecOfFloat = sign & (Val(mantissa1) + Val(mantissa2))


End Function
Private Function BinOfDec(ByVal number As String, Optional length As Integer) As String

Dim d, B, L, wk, C

d = number
L = 0


If length = Empty Then
    Do
        If d Mod 2 Then B = "1" & B Else B = "0" & B
        d = d \ 2
    Loop Until d = 0
Else
    Do
        If d Mod 2 Then B = "1" & B Else B = "0" & B
        d = d \ 2
        L = L + 1
    Loop Until L = length
End If

If number < 0 And length = 8 Then GoTo TwosCompliment

GoTo BinAns

TwosCompliment:     'the binary is inverted and 1 is added, this is how minus numbers are represented in binary
    L = Len(B)
    d = 0
    C = 1
        For d = L To 1 Step -1
            wk = Mid(B, d, 1)
            
            If wk = 1 Then wk = 0 Else wk = 1   'inverse
            
            If wk = 1 And C = 1 Then            'add 1
                wk = 0
                C = 1
            ElseIf wk = 0 And C = 1 Then
                wk = 1
                C = 0
            ElseIf wk = 1 And C = 0 Then
                wk = 1
                C = 0
            ElseIf wk = 0 And C = 0 Then
                wk = 0
                C = 0
            End If
                        
            BinOfDec = BinOfDec & wk
                        
        Next d
  
Exit Function
BinAns:
BinOfDec = B

End Function

Private Function DefOfBin(ByVal number As String) As String

    Dim k%
    Dim L%
    Dim d&
    Dim B$

    B = CStr(number)
    L = Len(B)

    For k = 1 To L
        If Mid(B, k, 1) = "1" Then d = d + (2 ^ (L - k))
    Next

    DefOfBin = d

End Function
Public Function GetString(Offset As Double, Lenth As Long) As String
'Returns a string to a specified lenth from a specified offset
    For i = Offset To Offset + Lenth
    If ByteArray(i) = 0 Then GoTo endthisstring
    tmptext = tmptext & Chr$(ByteArray(i))
    Next i
endthisstring:
    GetString = tmptext
End Function
Public Function LoadString(Offset As Double) As String
'Returns a string from the specified offset, the lenth is detemined by when the reading runs into a '00' byte
p = Offset
tmpu = ""
taglenth = 0
r = 0
Dim TmpTxt As String

L = Offset
TmpTxt = ""


    Do
      TmpTxt = TmpTxt & Chr$(ByteArray(L))
    r = r + 1
    L = L + 1

    
    
    Loop Until ByteArray(L) = 0


LoadString = Left(TmpTxt, r - 1)
End Function

Public Function Get3dAngle(Quaternion As Vector4d, rad As Boolean) As Vector3d
'Converts a Quaternion 4 dimentional directional vector into eular 3d angle (yaw, pitch, roll)
Dim Scale3d As Double
Dim Pi As Double
Dim x As Double
Dim y As Double
Dim Z As Double
Dim q1 As Double
Dim q2 As Double
Dim q3 As Double
Dim q0 As Double
Dim tmp1 As Double
Dim tmp2 As Double

q1 = Round(Quaternion.i, 5)
q2 = Round(Quaternion.j, 5)
q3 = Round(Quaternion.k, 5)
q0 = Round(Quaternion.W, 5)
Pi = 3.14159265358979

tmp1 = (q0 ^ 2) + (q1 ^ 2) - (q2 ^ 2) - (q3 ^ 2)
tmp2 = (q0 ^ 2) - (q1 ^ 2) - (q2 ^ 2) + (q3 ^ 2)
If tmp1 = 0 Then
tmp1 = -1E-19
End If
If tmp2 = 0 Then
tmp2 = -1E-19
End If
   Z = Round(2 * ((q0 * q3) - (q1 * q2)) / tmp1, 5)
   y = Round(2 * ((q0 * q2) + (q1 * q3)), 5)
   x = Round(2 * ((q0 * q1) - (q2 * q3)) / tmp2, 5)
   
   If y > 1 Then y = 1
   If y < -1 Then y = -1
Get3dAngle.x = Atn(x)
Get3dAngle.y = ASin(y)
Get3dAngle.Z = Atn(Z)




End Function


Public Function OBJVertStr(VertexCoords() As Vector3d, VertexCount As Long) As String
'For logging an array of vertex coords into the format for the .OBJ file format
    Dim TmpTxt() As String
    ReDim TmpTxt(0 To VertexCount - 1)
    
    For i = 0 To VertexCount - 1
        TmpTxt(i) = "v " & VertexCoords(i).x & " " & VertexCoords(i).y & " " & VertexCoords(i).Z
    Next i

    OBJVertStr = Join(TmpTxt, vbCrLf)
End Function
Public Function OBJNormStr(VertexCoords() As Vector3d, NormalCount As Long) As String
'For logging an array of vertex normals into the format for the .OBJ file format
    Dim TmpTxt() As String
    ReDim TmpTxt(0 To NormalCount - 1)
    
    For i = 0 To NormalCount - 1
        TmpTxt(i) = "vn " & VertexCoords(i).x & " " & VertexCoords(i).y & " " & VertexCoords(i).Z
    Next i

    OBJNormStr = Join(TmpTxt, vbCrLf)
End Function
Public Function OBJUVStr(VertexCoords() As Vector2d, UVCount As Long) As String
'For logging an array of UVs into the format for the .OBJ file format
    Dim TmpTxt() As String
    ReDim TmpTxt(0 To UVCount - 1)
    
    For i = 0 To UVCount - 1
        TmpTxt(i) = "vt " & VertexCoords(i).U & " " & VertexCoords(i).V
    Next i

    OBJUVStr = Join(TmpTxt, vbCrLf)
End Function

Public Function nSigned(ByVal lUnsignedInt As Long) As Integer
'Converts an unsigned Integer into a signed integer
  Dim nReturnVal As Integer   ' Return value from Function

  If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
    Debug.Print "Error in conversion from Unsigned to nSigned Integer"
    nSigned = 0
    Exit Function
  End If

  If lUnsignedInt > 32767 Then
    nReturnVal = lUnsignedInt - 65536
  Else
    nReturnVal = lUnsignedInt
  End If

  nSigned = nReturnVal

End Function
Public Function IsSingle(address As Double, Optional UpperBound As Double = 100000000, Optional LowerBound As Double = 0.00000001) As Boolean
  'a very usefull function to test for possible floating point digits
    If GetSingle(address) ^ 2 < UpperBound And GetSingle(address) ^ 2 > LowerBound Then
    IsSingle = True
    Else
    IsSingle = False
    End If
    
End Function
Public Function IsSingleS(address As Double, Optional UpperBound As Double = 100000000, Optional LowerBound As Double = 0.00000001) As Boolean
  'a very usefull function to test for endian swapped possible floating point digits
    If GetSingleS(address) ^ 2 < UpperBound And GetSingleS(address) ^ 2 > LowerBound Then
    IsSingleS = True
    Else
    IsSingleS = False
    End If
End Function
 

Top