Attribute VB_Name = "mKeyStone"
Option Explicit

'Keystone Assembly Engine bindings for VB6
'Contributed by FireEye FLARE Team
'Author:  David Zimmer <david.zimmer@fireeye.com>, <dzzie@yahoo.com>
'License: Apache
'Copyright: FireEye 2017

'NOTE: the VB code was built and tested against the latest binary release: Keystone 0.9.1
'      I will enabled the symbol resolver once it makes it into the stable release

Public hLib As Long
Public version As String
Public vMajor As Long
Public vMinor As Long

Public Enum ks_arch
    KS_ARCH_ARM = 1 ' ARM architecture (including Thumb, Thumb-2)
    KS_ARCH_ARM64   ' ARM-64, also called AArch64
    KS_ARCH_MIPS    ' Mips architecture
    KS_ARCH_X86     ' X86 architecture (including x86 & x86-64)
    KS_ARCH_PPC     ' PowerPC architecture (currently unsupported)
    KS_ARCH_SPARC   ' Sparc architecture
    KS_ARCH_SYSTEMZ ' SystemZ architecture (S390X)
    KS_ARCH_HEXAGON ' Hexagon architecture
    KS_ARCH_MAX
End Enum

Public Enum ks_mode
    KS_MODE_LITTLE_ENDIAN = 0       ' little-endian mode (default mode)
    KS_MODE_BIG_ENDIAN = &H40000000 ' big-endian mode
    '  arm / arm64
    KS_MODE_ARM = 1                 ' ARM mode
    KS_MODE_THUMB = &H10            ' THUMB mode (including Thumb-2)
    KS_MODE_V8 = &H40               ' ARMv8 A32 encodings for ARM
    '  mips
    KS_MODE_MICRO = &H10            ' MicroMips mode
    KS_MODE_MIPS3 = &H20            ' Mips III ISA
    KS_MODE_MIPS32R6 = &H40         ' Mips32r6 ISA
    KS_MODE_MIPS32 = 4              ' Mips32 ISA
    KS_MODE_MIPS64 = 8              ' Mips64 ISA
    '  x86 / x64
    KS_MODE_16 = 2                  ' 16-bit mode
    KS_MODE_32 = 4                  ' 32-bit mode
    KS_MODE_64 = 8                  ' 64-bit mode
    '  ppc
    KS_MODE_PPC32 = 4               ' 32-bit mode
    KS_MODE_PPC64 = 8               ' 64-bit mode
    KS_MODE_QPX = &H10              ' Quad Processing eXtensions mode
    '  sparc
    KS_MODE_SPARC32 = 4             ' 32-bit mode
    KS_MODE_SPARC64 = 8             ' 64-bit mode
    KS_MODE_V9 = &H10               ' SparcV9 mode
End Enum

'All generic errors related to input assembly >= KS_ERR_ASM
Public Const KS_ERR_ASM = 128

'All architecture-specific errors related to input assembly >= KS_ERR_ASM_ARCH
Public Const KS_ERR_ASM_ARCH = 512

'All type of errors encountered by Keystone API.
Public Enum ks_err                   ' All type of errors encountered by Keystone API.
    KS_ERR_OK = 0                    ' No error: everything was fine
    KS_ERR_NOMEM                     ' Out-Of-Memory error: ks_open(), ks_emulate()
    KS_ERR_ARCH                      ' Unsupported architecture: ks_open()
    KS_ERR_HANDLE                    ' Invalid handle
    KS_ERR_MODE                      ' Invalid/unsupported mode: ks_open()
    KS_ERR_VERSION                   ' Unsupported version (bindings)
    KS_ERR_OPT_INVALID               ' Unsupported option
                                     '  generic input assembly errors - parser specific
    KS_ERR_ASM_EXPR_TOKEN = 128      'KS_ERR_ASM ' unknown token in expression
    KS_ERR_ASM_DIRECTIVE_VALUE_RANGE ' literal value out of range for directive
    KS_ERR_ASM_DIRECTIVE_ID          ' expected identifier in directive
    KS_ERR_ASM_DIRECTIVE_TOKEN       ' unexpected token in directive
    KS_ERR_ASM_DIRECTIVE_STR         ' expected string in directive
    KS_ERR_ASM_DIRECTIVE_COMMA       ' expected comma in directive
    KS_ERR_ASM_DIRECTIVE_RELOC_NAME  ' expected relocation name in directive
    KS_ERR_ASM_DIRECTIVE_RELOC_TOKEN ' unexpected token in .reloc directive
    KS_ERR_ASM_DIRECTIVE_FPOINT      ' invalid floating point in directive
    KS_ERR_ASM_DIRECTIVE_UNKNOWN     ' unknown directive
    KS_ERR_ASM_DIRECTIVE_EQU         ' invalid equal directive
    KS_ERR_ASM_DIRECTIVE_INVALID     ' (generic) invalid directive
    KS_ERR_ASM_VARIANT_INVALID       ' invalid variant
    KS_ERR_ASM_EXPR_BRACKET          ' brackets expression not supported on this target
    KS_ERR_ASM_SYMBOL_MODIFIER       ' unexpected symbol modifier following '@'
    KS_ERR_ASM_SYMBOL_REDEFINED      ' invalid symbol redefinition
    KS_ERR_ASM_SYMBOL_MISSING        ' cannot find a symbol
    KS_ERR_ASM_RPAREN                ' expected ')' in parentheses expression
    KS_ERR_ASM_STAT_TOKEN            ' unexpected token at start of statement
    KS_ERR_ASM_UNSUPPORTED           ' unsupported token yet
    KS_ERR_ASM_MACRO_TOKEN           ' unexpected token in macro instantiation
    KS_ERR_ASM_MACRO_PAREN           ' unbalanced parentheses in macro argument
    KS_ERR_ASM_MACRO_EQU             ' expected '=' after formal parameter identifier
    KS_ERR_ASM_MACRO_ARGS            ' too many positional arguments
    KS_ERR_ASM_MACRO_LEVELS_EXCEED   ' macros cannot be nested more than 20 levels deep
    KS_ERR_ASM_MACRO_STR             ' invalid macro string
    KS_ERR_ASM_MACRO_INVALID         ' invalid macro (generic error)
    KS_ERR_ASM_ESC_BACKSLASH         ' unexpected backslash at end of escaped string
    KS_ERR_ASM_ESC_OCTAL             ' invalid octal escape sequence  (out of range)
    KS_ERR_ASM_ESC_SEQUENCE          ' invalid escape sequence (unrecognized character)
    KS_ERR_ASM_ESC_STR               ' broken escape string
    KS_ERR_ASM_TOKEN_INVALID         ' invalid token
    KS_ERR_ASM_INSN_UNSUPPORTED      ' this instruction is unsupported in this mode
    KS_ERR_ASM_FIXUP_INVALID         ' invalid fixup
    KS_ERR_ASM_LABEL_INVALID         ' invalid label
    KS_ERR_ASM_FRAGMENT_INVALID      ' invalid fragment
                                     '  generic input assembly errors - architecture specific
    KS_ERR_ASM_INVALIDOPERAND = 512  'KS_ERR_ASM_ARCH
    KS_ERR_ASM_MISSINGFEATURE
    KS_ERR_ASM_MNEMONICFAIL
End Enum

'Runtime option for the Keystone engine
Public Enum ks_opt_type     ' Runtime option for the Keystone engine
    KS_OPT_SYNTAX = 1 ' Choose syntax for input assembly
End Enum


'Runtime option value (associated with ks_opt_type above)
Public Enum ks_opt_value
    KS_OPT_SYNTAX_INTEL = 1   ' X86 Intel syntax - default on X86 (KS_OPT_SYNTAX).
    KS_OPT_SYNTAX_ATT = 2     ' X86 ATT asm syntax (KS_OPT_SYNTAX).
    KS_OPT_SYNTAX_NASM = 4    ' X86 Nasm syntax (KS_OPT_SYNTAX).
    KS_OPT_SYNTAX_MASM = 8    ' X86 Masm syntax (KS_OPT_SYNTAX) - unsupported yet.
    KS_OPT_SYNTAX_GAS = &H10  ' X86 GNU GAS syntax (KS_OPT_SYNTAX).
End Enum

Public Enum KS_ERR_ASM
    KS_ERR_ASM_INVALIDOPERAND = 512  'KS_ERR_ASM_ARCH
    KS_ERR_ASM_MISSINGFEATURE
    KS_ERR_ASM_MNEMONICFAIL
End Enum

' Resolver callback to provide value for a missing symbol in @symbol.
' To handle a symbol, the resolver must put value of the symbol in @value,
' then returns True.
' If we do not resolve a missing symbol, this function must return False.
' In that case, ks_asm() would eventually return with error KS_ERR_ASM_SYMBOL_MISSING.
'
' To register the resolver, pass its function address to ks_option(), using
' option KS_OPT_SYM_RESOLVER. For example, see samples/sample.c.
'typedef bool (*ks_sym_resolver)(const char *symbol, uint64_t *value);
'public function vbSymResolver(byval symbol as long , byref value as currency) as long

'void __stdcall setResolver(ks_engine *ks, unsigned int lpfnVBResolver){
'Public Declare Function setResolver Lib "vbKeyStone.dll" (ByVal hEngine As Long, ByVal lpfnVBResolver As Long) As Long


'/*
' Return combined API version & major and minor version numbers.
'
' @major: major number of API version
' @minor: minor number of API version
'
' @return hexical number as (major << 8 | minor), which encodes both
'     major & minor versions.
'     NOTE: This returned value can be compared with version number made
'     with macro KS_MAKE_VERSION
'
' For example, second API version would return 1 in @major, and 1 in @minor
' The return value would be 0x0101
'
' NOTE: if you only care about returned value, but not major and minor values,
' set both @major & @minor arguments to NULL.
'*/
'unsigned int ks_version(unsigned int *major, unsigned int *minor);
Public Declare Function ks_version Lib "vbKeyStone.dll" Alias "vs_version" (ByRef major As Long, ByRef minor As Long) As Long

'
'
'/*
' Determine if the given architecture is supported by this library.
'
' @arch: architecture type (KS_ARCH_*)
'
' @return True if this library supports the given arch.
'*/
'bool ks_arch_supported(ks_arch arch);
Public Declare Function ks_arch_supported Lib "vbKeyStone.dll" Alias "vs_arch_supported" (ByVal arch As ks_arch) As Long

'
'
'/*
' Create new instance of Keystone engine.
'
' @arch: architecture type (KS_ARCH_*)
' @mode: hardware mode. This is combined of KS_MODE_*
' @ks: pointer to ks_engine, which will be updated at return time
'
' @return KS_ERR_OK on success, or other value on failure (refer to ks_err enum
'   for detailed error).
'*/
'ks_err ks_open(ks_arch arch, int mode, ks_engine **ks);
Public Declare Function ks_open Lib "vbKeyStone.dll" Alias "vs_open" (ByVal arch As ks_arch, ByVal mode As Long, ByRef hEngine As Long) As ks_err


'
'/*
' Close KS instance: MUST do to release the handle when it is not used anymore.
' NOTE: this must be called only when there is no longer usage of Keystone.
' The reason is the this API releases some cached memory, thus access to any
' Keystone API after ks_close() might crash your application.
' After this, @ks is invalid, and nolonger usable.
'
' @ks: pointer to a handle returned by ks_open()
'
' @return KS_ERR_OK on success, or other value on failure (refer to ks_err enum
'   for detailed error).
'*/
'ks_err ks_close(ks_engine *ks);
Public Declare Function ks_close Lib "vbKeyStone.dll" Alias "vs_close" (ByVal hEngine As Long) As ks_err


'
'/*
' Report the last error number when some API function fail.
' Like glibc's errno, ks_errno might not retain its old error once accessed.
'
' @ks: handle returned by ks_open()
'
' @return: error code of ks_err enum type (KS_ERR_*, see above)
'*/
'ks_err ks_errno(ks_engine *ks);
Public Declare Function ks_errno Lib "vbKeyStone.dll" Alias "vs_errno" (ByVal hEngine As Long) As ks_err


'
'/*
' Return a string describing given error code.
'
' @code: error code (see KS_ERR_* above)
'
' @return: returns a pointer to a string that describes the error code
'   passed in the argument @code
' */
'const char *ks_strerror(ks_err code);
Public Declare Function ks_strerror Lib "vbKeyStone.dll" Alias "vs_strerror" (ByVal code As ks_err) As Long


'
'/*
' Set option for Keystone engine at runtime
'
' @ks: handle returned by ks_open()
' @type: type of option to be set
' @value: option value corresponding with @type
'
' @return: KS_ERR_OK on success, or other value on failure.
' Refer to ks_err enum for detailed error.
'*/
'ks_err ks_option(ks_engine *ks, ks_opt_type type, size_t value);
Public Declare Function ks_option Lib "vbKeyStone.dll" Alias "vs_option" (ByVal hEngine As Long, ByVal opt As ks_opt_type, ByVal value As Long) As ks_err


'/*
' Assemble a string given its the buffer, size, start address and number
' of instructions to be decoded.
' This API dynamically allocate memory to contain assembled instruction.
' Resulted array of bytes containing the machine code  is put into @*encoding
'
' NOTE 1: this API will automatically determine memory needed to contain
' output bytes in *encoding.
'
' NOTE 2: caller must free the allocated memory itself to avoid memory leaking.
'
' @ks: handle returned by ks_open()
' @str: NULL-terminated assembly string. Use ; or \n to separate statements.
' @address: address of the first assembly instruction, or 0 to ignore.
' @encoding: array of bytes containing encoding of input assembly string.
'       NOTE: *encoding will be allocated by this function, and should be freed
'       with ks_free() function.
' @encoding_size: size of *encoding
' @stat_count: number of statements successfully processed
'
' @return: 0 on success, or -1 on failure.
'
' On failure, call ks_errno() for error code.
'*/

'int ks_asm(ks_engine *ks,
'        const char *string,
'        uint64_t address,
'        unsigned char **encoding, size_t *encoding_size,
'        size_t *stat_count);

Public Declare Function ks_asm Lib "vbKeyStone.dll" Alias "vs_asm" ( _
    ByVal hEngine As Long, _
    ByVal asm As String, _
    ByVal address As Currency, _
    ByRef bytesOut As Long, _
    ByRef encodedSize As Long, _
    ByRef linesAssembled As Long _
) As ks_err



'/*
' Free memory allocated by ks_asm()
' @p: memory allocated in @encoding argument of ks_asm()
'*/
'void ks_free(unsigned char *p);
Public Declare Sub ks_free Lib "vbKeyStone.dll" Alias "vs_free" (ByVal buf As Long)

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Function cstr2vb(lpStr As Long) As String

    Dim length As Long
    Dim buf() As Byte

    If lpStr = 0 Then Exit Function

    length = lstrlen(lpStr)
    If length < 1 Then Exit Function
    
    ReDim buf(1 To length)
    CopyMemory buf(1), ByVal lpStr, length

    cstr2vb = StrConv(buf, vbUnicode, &H409)

End Function

Function err2str(e As ks_err) As String
    Dim lpStr As Long
    lpStr = ks_strerror(e)
    err2str = cstr2vb(lpStr)
End Function

Function ks_arch2str(v As ks_arch) As String
     Dim r As String
    If v = KS_ARCH_ARM Then r = "KS_ARCH_ARM"
    If v = KS_ARCH_ARM64 Then r = "KS_ARCH_ARM64"
    If v = KS_ARCH_MIPS Then r = "KS_ARCH_MIPS"
    If v = KS_ARCH_X86 Then r = "KS_ARCH_X86"
    If v = KS_ARCH_PPC Then r = "KS_ARCH_PPC"
    If v = KS_ARCH_SPARC Then r = "KS_ARCH_SPARC"
    If v = KS_ARCH_SYSTEMZ Then r = "KS_ARCH_SYSTEMZ"
    If v = KS_ARCH_HEXAGON Then r = "KS_ARCH_HEXAGON"
    If v = KS_ARCH_MAX Then r = "KS_ARCH_MAX"
    If Len(r) = 0 Then r = "Unknown: " & Hex(v)
    ks_arch2str = r
End Function

Function ks_opt_value2str(v As ks_opt_value) As String
    Dim r As String
    If v = KS_OPT_SYNTAX_INTEL Then r = "KS_OPT_SYNTAX_INTEL"
    If v = KS_OPT_SYNTAX_ATT Then r = "KS_OPT_SYNTAX_ATT"
    If v = KS_OPT_SYNTAX_NASM Then r = "KS_OPT_SYNTAX_NASM"
    If v = KS_OPT_SYNTAX_MASM Then r = "KS_OPT_SYNTAX_MASM"
    If v = KS_OPT_SYNTAX_GAS Then r = "KS_OPT_SYNTAX_GAS"
    If Len(r) = 0 Then r = "Unknown: " & Hex(v)
    ks_opt_value2str = r
End Function

Private Function CheckPath(pth As String, Optional errMsg As String) As Long
    
    Dim hCap As Long, capPth As String, shimPth As String
    
    shimPth = pth & "\vbKeystone.dll"
    capPth = pth & "\keystone.dll"
    
    If Not FileExists(shimPth) Then Exit Function
       
    hCap = LoadLibrary(capPth)
    If hCap = 0 Then hCap = LoadLibrary("keystone.dll")
    If hCap = 0 Then errMsg = "Could not find keystone.dll"
    
    CheckPath = LoadLibrary(shimPth)
    'If CheckPath = 0 Then MsgBox Err.LastDllError
    
End Function

Public Function initDll(Optional ByRef r As CAsmResult) As Boolean
    
    Dim errMsg As String
    
    hLib = GetModuleHandle("vbKeystone.dll")
   
    If hLib = 0 Then hLib = CheckPath(App.path & "\bin\", errMsg)
    If hLib = 0 Then hLib = CheckPath(App.path & "\", errMsg)
    If hLib = 0 Then hLib = CheckPath(App.path & "\..\", errMsg)
    If hLib = 0 Then hLib = LoadLibrary("vbKeystone.dll")
    
    If hLib = 0 Then
        If Not r Is Nothing Then r.errMsg = errMsg & " Could not load vbKeystone.dll"
        Exit Function
    End If
        
    ks_version vMajor, vMinor
    version = vMajor & "." & vMinor
    initDll = True
    
End Function

'untested
'Public Function vbSymResolver(ByVal symbol As Long, ByRef value As Currency) As Long
'
'    Dim sym As String
'
'    sym = cstr2vb(symbol)
'
'    If sym = "_l1" Then
'        value = lng2Cur(&H1002)
'        vbSymResolver = 1
'    Else
'        vbSymResolver = 0
'    End If
'
'End Function
