Attribute VB_Name = "Module1"
'******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
' _____________ __ __ ____ ___ _____ ____ __
' /____ ___/ |\ / /\/ /\/ _ \ / |\/_ _/\/ |\ / /\
' \___/ /\_/ /| ||/ /_/ / / /\/ |/ /| ||\/ /\\/ /| ||/ / /
' __ / / // /_| |/ __ / / __¯ </ /_| ||/ / // / | |/ / /
' | \/ / // ___ / / / / / /\_| / ___ |/ /_// / /| / /
' \___/ //_/\__|/_/ /_/ /_/ //_/_/ __|/____//_/ / |__/ /
' \__\/ \_\/ [URL="file://\\_\/\_\/\_\/"]\\_\/\_\/\_\/[/URL] \_\_\/ [URL="file://\\____\\_\/"]\\____\\_\/[/URL] \__\/
'-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
Av As Long
An As Long
At As Long
Bv As Long
Bn As Long
Bt As Long
Cv As Long
Cn As Long
Ct As Long
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
If Offset > UBound(ByteArray) - 1 Then
GetIntS = 0
GoTo enthisfunc1
End If
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)
enthisfunc1:
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
GetIntS1 = 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 Long = 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)
If Scalar = 0 Then Scalar = 512
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 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)
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
