VB6 bindings and dynload update w/ uc_context* and uc_free api,… (#715)
* msvc unicorn.def and dynload.c added new uc_context* and uc_free api, includes support for older dlls compiled with uc_context_free (can remove next binary release) * vb6 bindings & x86 32bit sample class for unicorn
This commit is contained in:
David Zimmer
committed by
Nguyen Anh Quynh
Nguyen Anh Quynh
parent
47150b6df3
commit
523fb9d9fc
927
bindings/vb6/ucIntel32.cls
Normal file
927
bindings/vb6/ucIntel32.cls
Normal file
@@ -0,0 +1,927 @@
|
||||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
Persistable = 0 'NotPersistable
|
||||
DataBindingBehavior = 0 'vbNone
|
||||
DataSourceBehavior = 0 'vbNone
|
||||
MTSTransactionMode = 0 'NotAnMTSObject
|
||||
END
|
||||
Attribute VB_Name = "ucIntel32"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = True
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'Unicorn Engine x86 32bit wrapper class for vb6
|
||||
|
||||
'Contributed by: FireEye FLARE team
|
||||
'Author: David Zimmer <david.zimmer@fireeye.com>, <dzzie@yahoo.com>
|
||||
'License: Apache
|
||||
|
||||
'we hide the extra labor of x64 conversion from the user. I could simplify
|
||||
'this at the C shim layer but I might write an x64 class later
|
||||
'
|
||||
'since the vb long type only natively supports signed math, I have also handed off a couple
|
||||
'calculations in this class to a C stub just to be safe.
|
||||
'
|
||||
'you can find a full unsigned and x64 safe library for vb6 here:
|
||||
' https://github.com/dzzie/libs/tree/master/vb6_utypes
|
||||
|
||||
Public hLib As Long
|
||||
Public uc As Long
|
||||
Public errMsg As String
|
||||
Public Version As String
|
||||
Public major As Long
|
||||
Public minor As Long
|
||||
|
||||
Private r32 As Variant
|
||||
Private r16 As Variant
|
||||
Private r8 As Variant
|
||||
Private rs_ As Variant
|
||||
Private rs_Name As Variant
|
||||
Private r32_Name As Variant
|
||||
Private r16_Name As Variant
|
||||
Private r8_Name As Variant
|
||||
Private hooks As New Collection
|
||||
Private m_DisasmOk As Boolean
|
||||
|
||||
Event CodeHook(ByVal address As Long, ByVal size As Long)
|
||||
Event BlockHook(ByVal address As Long, ByVal size As Long)
|
||||
Event MemAccess(ByVal t As uc_mem_type, ByVal address As Long, ByVal size As Long, ByVal value As Long)
|
||||
Event InvalidMem(ByVal t As uc_mem_type, ByVal address As Long, ByVal size As Long, ByVal value As Long, ByRef continue As Boolean)
|
||||
Event Interrupt(ByVal intno As Long)
|
||||
|
||||
'our vb enum is 0 based then mapped to the real C values so we can loop them to dump with name lookup
|
||||
'these sub enums also keep the intellisense lists short and focused when reading/writing vals
|
||||
'they are accessed through reg32, reg16, reg8, rs properties, or use raw full enum through reg property
|
||||
'the names of each can be looked up through the reg32n etc properties
|
||||
Public Enum reg_32
|
||||
eax_r = 0
|
||||
ecx_r = 1
|
||||
edx_r = 2
|
||||
ebx_r = 3
|
||||
esp_r = 4
|
||||
ebp_r = 5
|
||||
esi_r = 6
|
||||
edi_r = 7
|
||||
End Enum
|
||||
|
||||
Public Enum reg_16
|
||||
ax_r = 0
|
||||
cx_r = 1
|
||||
dx_r = 2
|
||||
bx_r = 3
|
||||
sp_r = 4
|
||||
bp_r = 5
|
||||
si_r = 6
|
||||
di_r = 7
|
||||
End Enum
|
||||
|
||||
Public Enum reg_8
|
||||
ah_r = 0
|
||||
ch_r = 1
|
||||
dh_r = 2
|
||||
bh_r = 3
|
||||
al_r = 4
|
||||
cl_r = 5
|
||||
dl_r = 6
|
||||
bl_r = 7
|
||||
End Enum
|
||||
|
||||
Public Enum reg_Special
|
||||
CS_r = 0
|
||||
DS_r = 1
|
||||
ES_r = 2
|
||||
FS_r = 3
|
||||
GS_r = 4
|
||||
SS_r = 5
|
||||
IDTR_r = 6
|
||||
GDTR_r = 7
|
||||
LDTR_r = 8
|
||||
End Enum
|
||||
|
||||
Property Get DisasmAvail() As Boolean
|
||||
DisasmAvail = m_DisasmOk
|
||||
End Property
|
||||
|
||||
Property Get lastError() As Long
|
||||
lastError = ucs_errno(uc)
|
||||
End Property
|
||||
|
||||
Property Get hadErr() As Boolean
|
||||
If Len(errMsg) > 0 Then hadErr = True
|
||||
End Property
|
||||
|
||||
Property Get eip() As Long
|
||||
Dim e As uc_err, value As Long
|
||||
e = ucs_reg_read(uc, UC_X86_REG_EIP, value)
|
||||
eip = value
|
||||
End Property
|
||||
|
||||
Property Let eip(v As Long)
|
||||
Dim e As uc_err
|
||||
e = ucs_reg_write(uc, UC_X86_REG_EIP, v)
|
||||
End Property
|
||||
|
||||
Property Get eflags() As Long
|
||||
Dim e As uc_err, value As Long
|
||||
e = ucs_reg_read(uc, UC_X86_REG_EFLAGS, value)
|
||||
eflags = value
|
||||
End Property
|
||||
|
||||
Property Let eflags(v As Long)
|
||||
Dim e As uc_err
|
||||
e = ucs_reg_write(uc, UC_X86_REG_EFLAGS, v)
|
||||
End Property
|
||||
|
||||
|
||||
'full access to all registers if you need it..
|
||||
Property Get reg(r As uc_x86_reg) As Long
|
||||
Dim e As uc_err, value As Long
|
||||
e = ucs_reg_read(uc, r, value)
|
||||
reg = value
|
||||
End Property
|
||||
|
||||
Property Let reg(r As uc_x86_reg, value As Long)
|
||||
Dim e As uc_err
|
||||
e = ucs_reg_write(uc, r, value)
|
||||
End Property
|
||||
|
||||
'32 bit registers
|
||||
Property Get reg32(r As reg_32) As Long
|
||||
Dim e As uc_err, value As Long
|
||||
If r < 0 Or r > UBound(r32) Then Exit Property
|
||||
e = ucs_reg_read(uc, r32(r), value)
|
||||
reg32 = value
|
||||
End Property
|
||||
|
||||
Property Let reg32(r As reg_32, value As Long)
|
||||
Dim e As uc_err
|
||||
If r < 0 Or r > UBound(r32) Then Exit Property
|
||||
e = ucs_reg_write(uc, r32(r), value)
|
||||
End Property
|
||||
|
||||
'16 bit registers
|
||||
Property Get reg16(r As reg_16) As Long
|
||||
Dim e As uc_err, value As Long
|
||||
If r < 0 Or r > UBound(r16) Then Exit Property
|
||||
e = ucs_reg_read(uc, r16(r), value)
|
||||
reg16 = CInt(value)
|
||||
End Property
|
||||
|
||||
Property Let reg16(r As reg_16, ByVal value As Long)
|
||||
Dim e As uc_err
|
||||
value = value And &HFFFF
|
||||
If r < 0 Or r > UBound(r16) Then Exit Property
|
||||
e = ucs_reg_write(uc, r16(r), value)
|
||||
End Property
|
||||
|
||||
'8 bit registers
|
||||
Property Get reg8(r As reg_8) As Long
|
||||
Dim e As uc_err, value As Long
|
||||
If r < 0 Or r > UBound(r8) Then Exit Property
|
||||
e = ucs_reg_read(uc, r8(r), value)
|
||||
reg8 = value
|
||||
End Property
|
||||
|
||||
Property Let reg8(r As reg_8, ByVal value As Long)
|
||||
Dim e As uc_err
|
||||
value = value And &HFF
|
||||
If r < 0 Or r > UBound(r8) Then Exit Property
|
||||
e = ucs_reg_write(uc, r8(r), value)
|
||||
End Property
|
||||
|
||||
'special registers
|
||||
Property Get rs(r As reg_Special) As Long
|
||||
Dim e As uc_err, value As Long
|
||||
If r < 0 Or r > UBound(rs_) Then Exit Property
|
||||
e = ucs_reg_read(uc, rs_(r), value)
|
||||
rs = value
|
||||
End Property
|
||||
|
||||
Property Let rs(r As reg_Special, ByVal value As Long)
|
||||
Dim e As uc_err
|
||||
If r < 0 Or r > UBound(rs_) Then Exit Property
|
||||
e = ucs_reg_write(uc, rs_(r), value)
|
||||
End Property
|
||||
|
||||
|
||||
'reg index to name translation for looping
|
||||
Property Get reg32n(r As reg_32) As String
|
||||
If r < 0 Or r > UBound(r32_Name) Then Exit Property
|
||||
reg32n = r32_Name(r)
|
||||
End Property
|
||||
|
||||
Property Get reg16n(r As reg_16) As String
|
||||
If r < 0 Or r > UBound(r16_Name) Then Exit Property
|
||||
reg16n = r16_Name(r)
|
||||
End Property
|
||||
|
||||
Property Get reg8n(r As reg_8) As String
|
||||
If r < 0 Or r > UBound(r8_Name) Then Exit Property
|
||||
reg8n = r8_Name(r)
|
||||
End Property
|
||||
|
||||
Property Get rsn(r As reg_Special) As String
|
||||
If r < 0 Or r > UBound(rs_Name) Then Exit Property
|
||||
rsn = rs_Name(r)
|
||||
End Property
|
||||
|
||||
Function regDump(Optional includeState As Boolean = True) As String
|
||||
Dim i As Long
|
||||
Dim tmp As String
|
||||
|
||||
For i = 0 To UBound(r32)
|
||||
tmp = tmp & reg32n(i) & "=" & Hex(reg32(i)) & " "
|
||||
'if i mod 3 = 0 and i <> 0 then tmp = tmp & vbcrlf
|
||||
Next
|
||||
|
||||
regDump = tmp
|
||||
|
||||
If includeState Then
|
||||
regDump = regDump & "eip=" & Hex(Me.eip) & " " & dumpFlags()
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function dumpFlags() As String
|
||||
|
||||
Dim ret() As String
|
||||
Dim n As Variant
|
||||
Dim i As Long
|
||||
Dim flags As Long
|
||||
|
||||
'http://www.c-jump.com/CIS77/ASM/Instructions/I77_0050_eflags.htm
|
||||
n = Array("C ", 0, "P ", 0, "A ", 0, "Z ", "S ", _
|
||||
"T ", "I ", "D ", "O ", "IOPL ", "IOPL ", "NT ", 0, _
|
||||
"RF ", "VM ", "AC ", "VIF ", "VIP ", "ID ", 0)
|
||||
|
||||
flags = Me.eflags
|
||||
push ret, "EFL " & Hex(flags)
|
||||
|
||||
For i = 0 To 21
|
||||
If flags And ULong(1, i, op_lsh) Then
|
||||
If n(i) <> 0 Then push ret, n(i)
|
||||
End If
|
||||
Next
|
||||
|
||||
dumpFlags = Join(ret, " ")
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
|
||||
Dim e As uc_err
|
||||
|
||||
'mapping our simplified to real values..
|
||||
r32 = Array(UC_X86_REG_EAX, UC_X86_REG_ECX, UC_X86_REG_EDX, UC_X86_REG_EBX, UC_X86_REG_ESP, UC_X86_REG_EBP, UC_X86_REG_ESI, UC_X86_REG_EDI)
|
||||
r32_Name = Array("eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi")
|
||||
|
||||
r16 = Array(UC_X86_REG_AX, UC_X86_REG_CX, UC_X86_REG_DX, UC_X86_REG_BX, UC_X86_REG_SP, UC_X86_REG_BP, UC_X86_REG_SI, UC_X86_REG_DI)
|
||||
r16_Name = Array("ax", "cx", "dx", "bx", "sp", "bp", "si", "di")
|
||||
|
||||
r8 = Array(UC_X86_REG_AH, UC_X86_REG_CH, UC_X86_REG_DH, UC_X86_REG_BH, UC_X86_REG_AL, UC_X86_REG_CL, UC_X86_REG_DL, UC_X86_REG_Bl)
|
||||
r8_Name = Array("ah", "ch", "dh", "bh", "al", "cl", "dl", "bl")
|
||||
|
||||
rs_ = Array(UC_X86_REG_CS, UC_X86_REG_DS, UC_X86_REG_ES, UC_X86_REG_FS, UC_X86_REG_GS, UC_X86_REG_SS, UC_X86_REG_IDTR, UC_X86_REG_GDTR, UC_X86_REG_LDTR)
|
||||
rs_Name = Array("cs", "ds", "es", "fs", "gs", "ss", "idtr", "gdtr", "ldtr")
|
||||
|
||||
'just to ensure IDE finds the dll before we try to use it...
|
||||
Const dllName As String = "ucvbshim.dll"
|
||||
|
||||
If Len(UNICORN_PATH) = 0 Then
|
||||
UNICORN_PATH = vbNullString
|
||||
ElseIf FolderExists(UNICORN_PATH) Then
|
||||
UNICORN_PATH = UNICORN_PATH & IIf(Right(UNICORN_PATH, 1) = "\", "", "\") & "unicorn.dll"
|
||||
End If
|
||||
|
||||
If hLib = 0 Then
|
||||
hLib = GetModuleHandle(dllName)
|
||||
If hLib = 0 Then
|
||||
hLib = LoadLibrary(GetParentFolder(UNICORN_PATH) & "\" & dllName)
|
||||
If hLib = 0 Then
|
||||
hLib = LoadLibrary(dllName)
|
||||
If hLib = 0 Then
|
||||
errMsg = "Could not load " & dllName
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
If DYNLOAD = 0 Then
|
||||
DYNLOAD = ucs_dynload(UNICORN_PATH)
|
||||
If DYNLOAD = 0 Then
|
||||
errMsg = "Dynamic Loading of unicorn.dll failed " & IIf(Len(UNICORN_PATH) > 0, "path: " & UNICORN_PATH, "")
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
ucs_version major, minor
|
||||
Version = major & "." & minor
|
||||
|
||||
If ucs_arch_supported(UC_ARCH_X86) <> 1 Then
|
||||
errMsg = "UC_ARCH_X86 not supported"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
e = ucs_open(UC_ARCH_X86, UC_MODE_32, uc)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = "Failed to create new x86 32bit engine instance " & err2str(e)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If GetProcAddress(hLib, "disasm_addr") <> 0 Then m_DisasmOk = True
|
||||
|
||||
instances.Add Me, "objptr:" & ObjPtr(Me)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
If uc = 0 Then Exit Sub
|
||||
stopEmu
|
||||
ucs_close uc
|
||||
On Error Resume Next
|
||||
instances.Remove "objptr:" & ObjPtr(Me)
|
||||
End Sub
|
||||
|
||||
Function mapMem(address As Long, size As Long, Optional protection As uc_prot = UC_PROT_ALL) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
|
||||
e = ucs_mem_map(uc, addr, size, protection)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
mapMem = True
|
||||
|
||||
End Function
|
||||
|
||||
'address and size must be 4kb aligned, real buffer must be at least of size, and not go out of scope!
|
||||
Function mapMemPtr(ByRef b() As Byte, address As Long, size As Long, Optional protection As uc_prot = UC_PROT_ALL) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
|
||||
If UBound(b) < size Then
|
||||
errMsg = "Buffer is < size"
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If size Mod &H1000 <> 0 Then
|
||||
errMsg = "Size must be 4kb aligned"
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If address Mod &H1000 <> 0 Then
|
||||
errMsg = "address must be 4kb aligned"
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
e = ucs_mem_map_ptr(uc, addr, size, protection, VarPtr(b(0)))
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
mapMemPtr = True
|
||||
|
||||
End Function
|
||||
|
||||
Function findAlloc(address As Long, Optional inRange As Boolean = False) As CMemRegion
|
||||
Dim m As CMemRegion
|
||||
Dim found As Boolean
|
||||
|
||||
For Each m In getMemMap()
|
||||
If inRange Then
|
||||
If ULong(address, m.address, op_gteq) = 1 And ULong(address, m.address, op_lteq) = 1 Then found = True
|
||||
Else
|
||||
If m.address = address Then found = True
|
||||
End If
|
||||
If found Then
|
||||
Set findAlloc = m
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
'we could accept a variant here instead of CMemRegion
|
||||
'if typename(v) = "Long" then enum regions and find cmem, else expect CMemRegion..
|
||||
'would be convient.. or a findAlloc(base as long) as CMemRegion
|
||||
Function changePermissions(m As CMemRegion, newProt As uc_prot)
|
||||
Dim e As uc_err
|
||||
Dim addr64 As Currency
|
||||
|
||||
errMsg = Empty
|
||||
|
||||
If m Is Nothing Then Exit Function
|
||||
|
||||
If newProt = m.perm Then
|
||||
changePermissions = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
addr64 = lng2Cur(m.address)
|
||||
|
||||
e = ucs_mem_protect(uc, addr64, m.size, newProt)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
m.perm = newProt
|
||||
changePermissions = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function unMapMem(base As Long) As Boolean
|
||||
|
||||
Dim m As CMemRegion
|
||||
Dim e As uc_err
|
||||
Dim addr64 As Currency
|
||||
|
||||
errMsg = Empty
|
||||
addr64 = lng2Cur(base)
|
||||
|
||||
For Each m In getMemMap()
|
||||
If m.address = base Then
|
||||
e = ucs_mem_unmap(uc, addr64, m.size)
|
||||
unMapMem = (e = uc_err_ok)
|
||||
If Not unMapMem Then errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
|
||||
End Function
|
||||
|
||||
'this function maps and writes (note 32bit only right now)
|
||||
Function writeBlock(address As Long, buf() As Byte, Optional perm As uc_prot = UC_PROT_ALL) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
|
||||
addr = lng2Cur(address)
|
||||
|
||||
errMsg = Empty
|
||||
e = mem_write_block(uc, addr, buf(0), UBound(buf) + 1, perm)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
writeBlock = True
|
||||
|
||||
End Function
|
||||
|
||||
'this function requires the memory already be mapped in, use writeBlock for easier access...
|
||||
Function writeMem(address As Long, buf() As Byte) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
|
||||
e = ucs_mem_write(uc, addr, buf(0), UBound(buf) + 1)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
writeMem = True
|
||||
|
||||
End Function
|
||||
|
||||
Function writeByte(address As Long, b As Byte) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
Dim buf(0) As Byte
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
buf(0) = b
|
||||
|
||||
e = ucs_mem_write(uc, addr, buf(0), 1)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
writeByte = True
|
||||
|
||||
End Function
|
||||
|
||||
Function writeLong(address As Long, value As Long) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
Dim buf(0 To 3) As Byte
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
CopyMemory buf(0), ByVal VarPtr(value), 4
|
||||
|
||||
e = ucs_mem_write(uc, addr, buf(0), 4)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
writeLong = True
|
||||
|
||||
End Function
|
||||
|
||||
Function writeInt(address As Long, value As Integer) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
Dim buf(0 To 1) As Byte
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
CopyMemory buf(0), ByVal VarPtr(value), 2
|
||||
|
||||
e = ucs_mem_write(uc, addr, buf(0), 2)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
writeInt = True
|
||||
|
||||
End Function
|
||||
|
||||
Function readMem(address As Long, ByRef buf() As Byte, ByVal size As Long) As Boolean
|
||||
|
||||
Dim addr As Currency
|
||||
Dim e As uc_err
|
||||
|
||||
errMsg = Empty
|
||||
addr = lng2Cur(address)
|
||||
ReDim buf(size - 1) '0 based..
|
||||
|
||||
e = ucs_mem_read(uc, addr, buf(0), UBound(buf) + 1)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
readMem = True
|
||||
|
||||
End Function
|
||||
|
||||
Function readByte(address As Long, ByRef b As Byte) As Boolean
|
||||
|
||||
Dim buf() As Byte
|
||||
|
||||
readMem address, buf, 1
|
||||
If hadErr Then Exit Function
|
||||
|
||||
b = buf(0)
|
||||
readByte = True
|
||||
|
||||
End Function
|
||||
|
||||
Function readLong(address As Long, ByRef retVal As Long) As Boolean
|
||||
|
||||
Dim buf() As Byte
|
||||
|
||||
readMem address, buf, 4
|
||||
If hadErr Then Exit Function
|
||||
|
||||
CopyMemory ByVal VarPtr(retVal), buf(0), 4
|
||||
readLong = True
|
||||
|
||||
End Function
|
||||
|
||||
Function readInt(address As Long, ByRef retVal As Integer) As Boolean
|
||||
|
||||
Dim buf() As Byte
|
||||
|
||||
readMem address, buf, 2
|
||||
If hadErr Then Exit Function
|
||||
|
||||
CopyMemory ByVal VarPtr(retVal), buf(0), 2
|
||||
readInt = True
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Function saveContext() As Long
|
||||
|
||||
Dim hContext As Long
|
||||
Dim e As uc_err
|
||||
|
||||
errMsg = Empty
|
||||
e = ucs_context_alloc(uc, hContext)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
e = ucs_context_save(uc, hContext)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
e = ucs_free(hContext)
|
||||
If e <> uc_err_ok Then errMsg = errMsg & " error freeing context: " & err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
saveContext = hContext
|
||||
|
||||
End Function
|
||||
|
||||
Function restoreContext(hContext As Long) As Boolean
|
||||
|
||||
Dim e As uc_err
|
||||
|
||||
errMsg = Empty
|
||||
e = ucs_context_restore(uc, hContext)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
restoreContext = True
|
||||
|
||||
End Function
|
||||
|
||||
Function freeContext(hContext As Long) As Boolean
|
||||
Dim e As uc_err
|
||||
e = ucs_free(hContext)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Else
|
||||
freeContext = True
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function disasm(va As Long, Optional ByRef instrLen As Long) As String
|
||||
|
||||
Dim buf As String, i As Long, b() As Byte
|
||||
Dim dump As String
|
||||
On Error Resume Next
|
||||
|
||||
If Not m_DisasmOk Then
|
||||
disasm = Right("00000000" & Hex(va), 8)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
buf = String(300, Chr(0))
|
||||
|
||||
instrLen = disasm_addr(uc, va, buf, Len(buf))
|
||||
If instrLen < 1 Then
|
||||
Select Case instrLen
|
||||
Case -1: buf = "Buffer to small"
|
||||
Case -2: buf = "Failed to read memory"
|
||||
Case -3: buf = "Failed to disassemble"
|
||||
Case Default: buf = "Unknown error " & instrLen
|
||||
End Select
|
||||
dump = "?? ?? ??"
|
||||
GoTo end_of_func
|
||||
End If
|
||||
|
||||
i = InStr(buf, Chr(0))
|
||||
If i > 2 Then buf = VBA.Left(buf, i - 1) Else buf = Empty
|
||||
|
||||
readMem va, b(), instrLen
|
||||
|
||||
For i = 0 To UBound(b)
|
||||
dump = dump & hhex(b(i)) & " "
|
||||
Next
|
||||
|
||||
end_of_func:
|
||||
disasm = Right("00000000" & Hex(va), 8) & " " & rpad(dump, 25) & buf
|
||||
|
||||
End Function
|
||||
|
||||
Function startEmu(beginAt As Long, endAt As Long, Optional timeout As Long = 0, Optional count As Long = 0) As Boolean
|
||||
|
||||
Dim e As uc_err
|
||||
Dim a As Currency, b As Currency, t As Currency
|
||||
|
||||
a = lng2Cur(beginAt)
|
||||
b = lng2Cur(endAt)
|
||||
t = lng2Cur(timeout)
|
||||
|
||||
errMsg = Empty
|
||||
e = ucs_emu_start(uc, a, b, t, count)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
startEmu = True
|
||||
|
||||
End Function
|
||||
|
||||
Function stopEmu() As Boolean
|
||||
Dim e As uc_err
|
||||
errMsg = Empty
|
||||
e = ucs_emu_stop(uc)
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
stopEmu = True
|
||||
End Function
|
||||
|
||||
|
||||
Function addHook(catagory As hookCatagory, flags As uc_hook_type, Optional beginAt As Long = 1, Optional endAt As Long = 0) As Boolean
|
||||
|
||||
Dim e As uc_err
|
||||
Dim hHook As Long 'handle to remove hook
|
||||
Dim a As Currency, b As Currency
|
||||
|
||||
e = -1
|
||||
a = lng2Cur(beginAt)
|
||||
b = lng2Cur(endAt)
|
||||
errMsg = Empty
|
||||
|
||||
If KeyExistsInCollection(hooks, "flags:" & flags) Then
|
||||
addHook = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If catagory = hc_code Then e = ucs_hook_add(uc, hHook, flags, AddressOf code_hook, ObjPtr(Me), a, b, catagory)
|
||||
If catagory = hc_mem Then e = ucs_hook_add(uc, hHook, flags, AddressOf mem_hook, ObjPtr(Me), a, b, catagory)
|
||||
If catagory = hc_memInvalid Then e = ucs_hook_add(uc, hHook, flags, AddressOf invalid_mem_hook, ObjPtr(Me), a, b, catagory)
|
||||
If catagory = hc_block Then e = ucs_hook_add(uc, hHook, flags, AddressOf block_hook, ObjPtr(Me), a, b, catagory)
|
||||
If catagory = hc_int Then e = ucs_hook_add(uc, hHook, flags, AddressOf interrupt_hook, ObjPtr(Me), a, b, catagory)
|
||||
|
||||
If e = -1 Then
|
||||
errMsg = "Unimplemented hook catagory"
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
hooks.Add hHook, "flags:" & flags
|
||||
addHook = True
|
||||
|
||||
End Function
|
||||
|
||||
'actually these appear to use different prototypes for each instruction? (only in/out examples seen...)
|
||||
'what about all the others? not implemented yet in c or vb callback
|
||||
'Function hookInstruction(i As uc_x86_insn, Optional beginAt As Long = 1, Optional endAt As Long = 0) As Boolean
|
||||
'
|
||||
' Dim e As uc_err
|
||||
' Dim hHook As Long 'handle to remove hook
|
||||
' Dim a As Currency, b As Currency
|
||||
'
|
||||
' If i = UC_X86_INS_INVALID Then Exit Function
|
||||
'
|
||||
' e = -1
|
||||
' a = lng2Cur(beginAt)
|
||||
' b = lng2Cur(endAt)
|
||||
' errMsg = Empty
|
||||
'
|
||||
' If KeyExistsInCollection(hooks, "instr:" & i) Then
|
||||
' hookInstruction = True
|
||||
' Exit Function
|
||||
' End If
|
||||
'
|
||||
' e = ucs_hook_add(uc, hHook, UC_HOOK_INSN, AddressOf instruction_hook, ObjPtr(Me), a, b, hc_inst, i)
|
||||
'
|
||||
' If e <> UC_ERR_OK Then
|
||||
' errMsg = err2str(e)
|
||||
' Exit Function
|
||||
' End If
|
||||
'
|
||||
' hooks.Add hHook, "instr:" & i
|
||||
' hookInstruction = True
|
||||
'
|
||||
' End Function
|
||||
|
||||
|
||||
Function removeHook(ByVal flags As uc_hook_type) As Boolean
|
||||
|
||||
On Error Resume Next
|
||||
|
||||
Dim hHook As Long, e As uc_err, wasInstr As Boolean
|
||||
|
||||
errMsg = Empty
|
||||
hHook = hooks("flags:" & flags)
|
||||
|
||||
If hHook = 0 Then
|
||||
hHook = hooks("instr:" & flags) 'maybe it was an instruction hook?
|
||||
If hHook = 0 Then
|
||||
errMsg = "Hook handle not found for supplied flags."
|
||||
Exit Function
|
||||
Else
|
||||
wasInstr = True
|
||||
End If
|
||||
End If
|
||||
|
||||
e = ucs_hook_del(uc, hHook)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If wasInstr Then
|
||||
hooks.Remove "instr:" & flags
|
||||
Else
|
||||
hooks.Remove "flags:" & flags
|
||||
End If
|
||||
|
||||
removeHook = True
|
||||
|
||||
End Function
|
||||
|
||||
Function getMemMap() As Collection 'of 32bit CMemRegion
|
||||
Dim c As New Collection
|
||||
Dim ret As New Collection
|
||||
Dim mem As CMemRegion
|
||||
Dim e As uc_err
|
||||
Dim s, tmp, v
|
||||
|
||||
errMsg = Empty
|
||||
Set getMemMap = ret
|
||||
|
||||
e = get_memMap(uc, c)
|
||||
|
||||
If e <> uc_err_ok Then
|
||||
errMsg = err2str(e)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
For Each s In c '&h1000000,&h11fffff,&h7 these should always be 32bit safe values created in this class..
|
||||
If Len(s) > 0 Then
|
||||
tmp = Split(s, ",")
|
||||
If UBound(tmp) = 2 Then
|
||||
Set mem = New CMemRegion
|
||||
mem.address = CLng(tmp(0))
|
||||
mem.endsAt = CLng(tmp(1))
|
||||
mem.size = ULong(mem.endsAt, mem.address, op_sub) + 1 'vb native math is signed only..we play it safe..
|
||||
mem.perm = CLng(tmp(2))
|
||||
ret.Add mem
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'these are internal functions used from the callback in the module to route the message to the event interface
|
||||
'little confusing but in the end easier for the end user...also lays foundation for multiple live instances
|
||||
'(although only one can run at a time since vb is single threaded)
|
||||
|
||||
Friend Function internal_invalid_mem_hook(ByVal t As uc_mem_type, ByVal address As Currency, ByVal size As Long, ByVal value As Currency) As Long
|
||||
Dim addr As Long, v As Long, continue As Boolean
|
||||
addr = cur2lng(address)
|
||||
v = cur2lng(value)
|
||||
RaiseEvent InvalidMem(t, addr, size, v, continue)
|
||||
internal_invalid_mem_hook = IIf(continue, 1, 0)
|
||||
End Function
|
||||
|
||||
Friend Sub internal_mem_hook(ByVal t As uc_mem_type, ByVal address As Currency, ByVal size As Long, ByVal value As Currency)
|
||||
Dim addr As Long, v As Long
|
||||
addr = cur2lng(address)
|
||||
v = cur2lng(value)
|
||||
RaiseEvent MemAccess(t, addr, size, v)
|
||||
End Sub
|
||||
|
||||
Friend Sub internal_code_hook(ByVal address As Currency, ByVal size As Long)
|
||||
Dim addr As Long
|
||||
addr = cur2lng(address)
|
||||
RaiseEvent CodeHook(addr, size)
|
||||
End Sub
|
||||
|
||||
Friend Sub internal_block_hook(ByVal address As Currency, ByVal size As Long)
|
||||
Dim addr As Long
|
||||
addr = cur2lng(address)
|
||||
RaiseEvent BlockHook(addr, size)
|
||||
End Sub
|
||||
|
||||
Friend Sub internal_interrupt_hook(ByVal intno As Long)
|
||||
RaiseEvent Interrupt(intno)
|
||||
End Sub
|
||||
|
||||
Reference in New Issue
Block a user