928 lines
24 KiB
OpenEdge ABL
928 lines
24 KiB
OpenEdge ABL
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
|
|
|