1VERSION 1.0 CLASS
2BEGIN
3  MultiUse = -1  'True
4  Persistable = 0  'NotPersistable
5  DataBindingBehavior = 0  'vbNone
6  DataSourceBehavior  = 0  'vbNone
7  MTSTransactionMode  = 0  'NotAnMTSObject
8END
9Attribute VB_Name = "CDisassembler"
10Attribute VB_GlobalNameSpace = False
11Attribute VB_Creatable = True
12Attribute VB_PredeclaredId = False
13Attribute VB_Exposed = False
14Option Explicit
15
16'Capstone Disassembly Engine bindings for VB6
17'Contributed by FireEye FLARE Team
18'Author:  David Zimmer <david.zimmer@fireeye.com>, <dzzie@yahoo.com>
19'License: Apache
20'Copyright: FireEye 2017
21
22
23'NOTE: the VB code was built and tested against Capstone v3.0 rc4
24'      if the capstone C structures change, the VB code will have to
25'      be adjusted to match!
26'
27'      instructions details are currently only implemented for x86
28
29Public arch As cs_arch
30Public mode As cs_mode
31Public hCapstone As Long
32Public hLib As Long
33
34Public version As String
35Public vMajor As Long
36Public vMinor As Long
37
38Public errMsg As String
39Public lastErr As cs_err
40
41Private Function CheckPath(pth As String) As Long
42
43    Dim hCap As Long, capPth As String, shimPth As String
44
45    shimPth = pth & "\vbCapstone.dll"
46    capPth = pth & "\capstone.dll"
47
48    If Not FileExists(shimPth) Then Exit Function
49
50    hCap = LoadLibrary(capPth)
51    If hCap = 0 Then hCap = LoadLibrary("capstone.dll")
52    If hCap = 0 Then errMsg = "Could not find capstone.dll"
53
54    CheckPath = LoadLibrary(shimPth)
55    'If CheckPath = 0 Then MsgBox Err.LastDllError
56
57End Function
58
59Public Function init(arch As cs_arch, mode As cs_mode, Optional enableDetails As Boolean = False) As Boolean
60
61    errMsg = Empty
62    hLib = GetModuleHandle("vbCapstone.dll")
63
64    If hLib = 0 Then hLib = CheckPath(App.path & "\bin\")
65    If hLib = 0 Then hLib = CheckPath(App.path & "\")
66    If hLib = 0 Then hLib = CheckPath(App.path & "\..\")
67    If hLib = 0 Then hLib = LoadLibrary("vbCapstone.dll")
68
69    If hLib = 0 Then
70        errMsg = errMsg & " Could not load vbCapstone.dll"
71        Exit Function
72    End If
73
74    Me.arch = arch
75    Me.mode = mode
76
77    cs_version vMajor, vMinor
78    version = vMajor & "." & vMinor
79
80    If cs_support(arch) = 0 Then
81        errMsg = "specified architecture not supported"
82        Exit Function
83    End If
84
85    Dim handle As Long 'in vb class a public var is actually a property get/set can not use as byref to api..
86    lastErr = cs_open(arch, mode, handle)
87    If lastErr <> CS_ERR_OK Then
88        errMsg = err2str(lastErr)
89        Exit Function
90    End If
91
92    hCapstone = handle
93    If enableDetails Then          'vb bindings currently only support details for x86
94        If arch = CS_ARCH_X86 Then
95            cs_option handle, CS_OPT_DETAIL, CS_OPT_ON
96        End If
97    End If
98
99    init = True
100
101End Function
102
103'base is a variant and currently accepts the following input types:
104'  x64 number held as currency type (ex.  makeCur(&haabbccdd, &h11223344) )
105'  int/long value (ex. &h1000 or 12345)
106'  numeric string or 0x/&h prefixed hex string (ex. "12345", "0x1200", "&haabbccdd")
107Function disasm(ByVal base, code() As Byte, Optional count As Long = 0) As Collection
108
109    Dim c As Long
110    Dim instAry As Long
111    Dim ret As New Collection
112    Dim ci As CInstruction
113    Dim i As Long
114    Dim address As Currency
115
116    On Error Resume Next
117
118    Set disasm = ret
119
120    If TypeName(base) = "Currency" Then
121        address = base
122    Else
123        If TypeName(base) = "String" Then base = Replace(Trim(base), "0x", "&h")
124        address = lng2Cur(CLng(base))
125        If Err.Number <> 0 Then
126            errMsg = "Could not convert base address to long"
127            Exit Function
128        End If
129    End If
130
131    c = cs_disasm(Me.hCapstone, code(0), UBound(code) + 1, address, count, instAry)
132    If c = 0 Then Exit Function
133
134    For i = 0 To c - 1
135        Set ci = New CInstruction
136        ci.LoadInstruction instAry, i, Me
137        ret.Add ci
138    Next
139
140    cs_free instAry, c
141
142End Function
143
144
145Private Sub Class_Terminate()
146    Dim msg As String
147    If DEBUG_DUMP Then
148        msg = "CDissembler.Terminate " & Hex(hCapstone)
149        If hCapstone <> 0 Then lastErr = cs_close(hCapstone)
150        Debug.Print msg & " : " & lastErr
151    End If
152End Sub
153
154