1 files changed, 385 insertions, 0 deletions
diff --git a/capstone/bindings/vb6/mMisc.bas b/capstone/bindings/vb6/mMisc.bas
new file mode 100644
index 000000000..2ccb1308e
--- /dev/null
+++ b/capstone/bindings/vb6/mMisc.bas
@@ -0,0 +1,385 @@
+Attribute VB_Name = "mMisc"
+Option Explicit
+
+'These are old library functions
+
+Private Type Bit64Currency
+  value As Currency
+End Type
+
+Private Type Bit64Integer
+  LowValue As Long
+  HighValue As Long
+End Type
+
+Global Const LANG_US = &H409
+
+Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
+Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
+Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
+Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
+Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
+Public Declare Function SetDllDirectory Lib "kernel32" Alias "SetDllDirectoryA" (ByVal lpPathName As String) As Long
+
+Function makeCur(high As Long, low As Long) As Currency
+  Dim c As Bit64Currency
+  Dim dl As Bit64Integer
+  dl.LowValue = low
+  dl.HighValue = high
+  LSet c = dl
+  makeCur = c.value
+End Function
+
+Function lng2Cur(v As Long) As Currency
+  Dim c As Bit64Currency
+  Dim dl As Bit64Integer
+  dl.LowValue = v
+  dl.HighValue = 0
+  LSet c = dl
+  lng2Cur = c.value
+End Function
+
+Function cur2str(v As Currency) As String
+    Dim c As Bit64Currency
+    Dim dl As Bit64Integer
+    c.value = v
+    LSet dl = c
+    If dl.HighValue = 0 Then
+        cur2str = Right("00000000" & Hex(dl.LowValue), 8)
+    Else
+        cur2str = Right("00000000" & Hex(dl.HighValue), 8) & "`" & Right("00000000" & Hex(dl.LowValue), 8)
+    End If
+End Function
+
+Function x64StrToCur(ByVal str As String) As Currency
+        
+    str = Replace(Trim(str), "0x", "")
+    str = Replace(str, " ", "")
+    str = Replace(str, "`", "")
+     
+    Dim low As String, high As String
+    Dim c As Bit64Currency
+    Dim dl As Bit64Integer
+    
+    low = VBA.Right(str, 8)
+    dl.LowValue = CLng("&h" & low)
+    
+    If Len(str) > 8 Then
+        high = Mid(str, 1, Len(str) - 8)
+        dl.HighValue = CLng("&h" & high)
+    End If
+     
+    LSet c = dl
+    x64StrToCur = c.value
+      
+End Function
+
+Function cur2lng(v As Currency) As Long
+  Dim c As Bit64Currency
+  Dim dl As Bit64Integer
+  c.value = v
+  LSet dl = c
+  cur2lng = dl.LowValue
+End Function
+
+Function readLng(offset As Long) As Long
+    Dim tmp As Long
+    CopyMemory ByVal VarPtr(tmp), ByVal offset, 4
+    readLng = tmp
+End Function
+
+Function readByte(offset As Long) As Byte
+    Dim tmp As Byte
+    CopyMemory ByVal VarPtr(tmp), ByVal offset, 1
+    readByte = tmp
+End Function
+
+Function readCur(offset As Long) As Currency
+    Dim tmp As Currency
+    CopyMemory ByVal VarPtr(tmp), ByVal offset, 8
+    readCur = tmp
+End Function
+
+Function col2Str(c As Collection, Optional emptyVal = "") As String
+    Dim v, tmp As String
+    
+    If c.count = 0 Then
+        col2Str = emptyVal
+    Else
+        For Each v In c
+            col2Str = col2Str & hhex(v) & ", "
+        Next
+        col2Str = Mid(col2Str, 1, Len(col2Str) - 2)
+    End If
+    
+End Function
+
+Function regCol2Str(hEngine As Long, c As Collection) As String
+    Dim v, tmp As String
+    
+    If c.count = 0 Then Exit Function
+    
+    For Each v In c
+        regCol2Str = regCol2Str & regName(hEngine, CLng(v)) & ", "
+    Next
+    regCol2Str = Mid(regCol2Str, 1, Len(regCol2Str) - 2)
+    
+End Function
+
+
+
+Function b2Str(b() As Byte) As String
+    Dim i As Long
+    
+    If AryIsEmpty(b) Then
+         b2Str = "Empty"
+    Else
+        For i = 0 To UBound(b)
+             b2Str = b2Str & hhex(b(i)) & " "
+        Next
+        b2Str = Trim(b2Str)
+    End If
+
+End Function
+
+
+
+Function AryIsEmpty(ary) As Boolean
+  Dim i As Long
+  
+  On Error GoTo oops
+    i = UBound(ary)  '<- throws error if not initalized
+    AryIsEmpty = False
+  Exit Function
+oops: AryIsEmpty = True
+End Function
+
+Public Function toBytes(ByVal hexstr, Optional strRet As Boolean = False)
+
+'supports:
+'11 22 33 44   spaced hex chars
+'11223344      run together hex strings
+'11,22,33,44   csv hex
+'\x11,0x22     misc C source rips
+'
+'ignores common C source prefixes, operators, delimiters, and whitespace
+'
+'not supported
+'1,2,3,4        all hex chars are must have two chars even if delimited
+'
+'a version which supports more formats is here:
+'  https://github.com/dzzie/libs/blob/master/dzrt/globals.cls
+
+    Dim ret As String, x As String, str As String
+    Dim r() As Byte, b As Byte, b1 As Byte
+    Dim foundDecimal As Boolean, tmp, i, a, a2
+    Dim pos As Long, marker As String
+    
+    On Error GoTo nope
+    
+    str = Replace(hexstr, vbCr, Empty)
+    str = Replace(str, vbLf, Empty)
+    str = Replace(str, vbTab, Empty)
+    str = Replace(str, Chr(0), Empty)
+    str = Replace(str, "{", Empty)
+    str = Replace(str, "}", Empty)
+    str = Replace(str, ";", Empty)
+    str = Replace(str, "+", Empty)
+    str = Replace(str, """""", Empty)
+    str = Replace(str, "'", Empty)
+    str = Replace(str, " ", Empty)
+    str = Replace(str, "0x", Empty)
+    str = Replace(str, "\x", Empty)
+    str = Replace(str, ",", Empty)
+    
+    For i = 1 To Len(str) Step 2
+        x = Mid(str, i, 2)
+        If Not isHexChar(x, b) Then Exit Function
+        bpush r(), b
+    Next
+    
+    If strRet Then
+        toBytes = StrConv(r, vbUnicode, LANG_US)
+    Else
+        toBytes = r
+    End If
+    
+nope:
+End Function
+
+Private Sub bpush(bAry() As Byte, b As Byte) 'this modifies parent ary object
+    On Error GoTo init
+    Dim x As Long
+    
+    x = UBound(bAry) '<-throws Error If Not initalized
+    ReDim Preserve bAry(UBound(bAry) + 1)
+    bAry(UBound(bAry)) = b
+    
+    Exit Sub
+
+init:
+    ReDim bAry(0)
+    bAry(0) = b
+    
+End Sub
+
+Sub push(ary, value) 'this modifies parent ary object
+    On Error GoTo init
+    Dim x
+       
+    x = UBound(ary)
+    ReDim Preserve ary(x + 1)
+    
+    If IsObject(value) Then
+        Set ary(x + 1) = value
+    Else
+        ary(x + 1) = value
+    End If
+    
+    Exit Sub
+init:
+    ReDim ary(0)
+    If IsObject(value) Then
+        Set ary(0) = value
+    Else
+        ary(0) = value
+    End If
+End Sub
+
+
+Public Function isHexChar(hexValue As String, Optional b As Byte) As Boolean
+    On Error Resume Next
+    Dim v As Long
+    
+    If Len(hexValue) = 0 Then GoTo nope
+    If Len(hexValue) > 2 Then GoTo nope 'expecting hex char code like FF or 90
+    
+    v = CLng("&h" & hexValue)
+    If Err.Number <> 0 Then GoTo nope 'invalid hex code
+    
+    b = CByte(v)
+    If Err.Number <> 0 Then GoTo nope  'shouldnt happen.. > 255 cant be with len() <=2 ?
+
+    isHexChar = True
+    
+    Exit Function
+nope:
+    Err.Clear
+    isHexChar = False
+End Function
+
+Function hhex(b) As String
+    hhex = Right("00" & Hex(b), 2)
+End Function
+
+Function rpad(x, i, Optional c = " ")
+    rpad = Left(x & String(i, c), i)
+End Function
+
+Function HexDump(bAryOrStrData, Optional hexOnly = 0, Optional ByVal startAt As Long = 1, Optional ByVal length As Long = -1) As String
+    Dim s() As String, chars As String, tmp As String
+    On Error Resume Next
+    Dim ary() As Byte
+    Dim offset As Long
+    Const LANG_US = &H409
+    Dim i As Long, tt, h, x
+
+    offset = 0
+    
+    If TypeName(bAryOrStrData) = "Byte()" Then
+        ary() = bAryOrStrData
+    Else
+        ary = StrConv(CStr(bAryOrStrData), vbFromUnicode, LANG_US)
+    End If
+    
+    If startAt < 1 Then startAt = 1
+    If length < 1 Then length = -1
+    
+    While startAt Mod 16 <> 0
+        startAt = startAt - 1
+    Wend
+    
+    startAt = startAt + 1
+    
+    chars = "   "
+    For i = startAt To UBound(ary) + 1
+        tt = Hex(ary(i - 1))
+        If Len(tt) = 1 Then tt = "0" & tt
+        tmp = tmp & tt & " "
+        x = ary(i - 1)
+        'chars = chars & IIf((x > 32 And x < 127) Or x > 191, Chr(x), ".") 'x > 191 causes \x0 problems on non us systems... asc(chr(x)) = 0
+        chars = chars & IIf((x > 32 And x < 127), Chr(x), ".")
+        If i > 1 And i Mod 16 = 0 Then
+            h = Hex(offset)
+            While Len(h) < 6: h = "0" & h: Wend
+            If hexOnly = 0 Then
+                push s, h & "   " & tmp & chars
+            Else
+                push s, tmp
+            End If
+            offset = offset + 16
+            tmp = Empty
+            chars = "   "
+        End If
+        If length <> -1 Then
+            length = length - 1
+            If length = 0 Then Exit For
+        End If
+    Next
+    
+    'if read length was not mod 16=0 then
+    'we have part of line to account for
+    If tmp <> Empty Then
+        If hexOnly = 0 Then
+            h = Hex(offset)
+            While Len(h) < 6: h = "0" & h: Wend
+            h = h & "   " & tmp
+            While Len(h) <= 56: h = h & " ": Wend
+            push s, h & chars
+        Else
+            push s, tmp
+        End If
+    End If
+    
+    HexDump = Join(s, vbCrLf)
+    
+    If hexOnly <> 0 Then
+        HexDump = Replace(HexDump, " ", "")
+        HexDump = Replace(HexDump, vbCrLf, "")
+    End If
+    
+End Function
+
+
+
+Function FileExists(path As String) As Boolean
+  On Error GoTo hell
+    
+  If Len(path) = 0 Then Exit Function
+  If Right(path, 1) = "\" Then Exit Function
+  If Dir(path, vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then FileExists = True
+  
+  Exit Function
+hell: FileExists = False
+End Function
+
+Sub WriteFile(path, it)
+    Dim f
+    f = FreeFile
+    Open path For Output As #f
+    Print #f, it
+    Close f
+End Sub
+
+Function GetParentFolder(path) As String
+    Dim tmp() As String, ub As Long
+    On Error Resume Next
+    tmp = Split(path, "\")
+    ub = tmp(UBound(tmp))
+    If Err.Number = 0 Then
+        GetParentFolder = Replace(Join(tmp, "\"), "\" & ub, "")
+    Else
+        GetParentFolder = path
+    End If
+End Function
+