Advanced procedure hacking-VBForums
Results 1 to 2 of 2

Thread: Advanced procedure hacking

  1. #1

    Thread Starter
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Advanced procedure hacking

    Note: most of these features can be simply replicated with API calls that are about equal in speed. TLB files can perfectly replicate these features and be faster too. These may be interesting if you want to do advanced optimization or if you want to work with string arrays in a more powerful manner.

    As such these aren't very useful, but provide some nice insight into internal data structures in VB6. I probably revise this post at a later date with more information.

    Feel free to ask questions.


    Code:
    ' Advanced.bas
    Option Explicit
    
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Ptr As Long, Value As Long)
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
    
    Public Function InIDE(Optional IDE) As Boolean
        If IsMissing(IDE) Then Debug.Assert Not InIDE(InIDE) Else IDE = True
    End Function
    
    Public Property Get Procedure(ByVal AddressOfDest As Long) As Long
        Procedure = AddressOfDest
    End Property
    
    Public Property Let Procedure(ByVal AddressOfDest As Long, ByVal AddressOfSrc As Long)
        Dim JMP As Currency, PID As Long
        ' get process handle
        PID = OpenProcess(&H1F0FFF, 0&, GetCurrentProcessId)
        If PID Then
            If InIDE Then
                ' get correct pointers to procedures in IDE
                GetMem4 AddressOfDest + &H16&, AddressOfDest
                GetMem4 AddressOfSrc + &H16&, AddressOfSrc
            End If
            Debug.Assert App.hInstance
            ' ASM JMP (0xE9) followed by bytes to jump in memory
            JMP = (&HE9& * 0.0001@) + (AddressOfSrc - AddressOfDest - 5@) * 0.0256@
            ' write the JMP over the destination procedure
            WriteProcessMemory PID, ByVal AddressOfDest, JMP, 5
            ' close process handle
            CloseHandle PID
        End If
    End Property
    Code:
    ' Cast.bas
    Option Explicit
    
    Public Sub CurAsLong(ByVal Value As Currency, Low As Long, High As Long)
        Procedure(AddressOf Cast.CurAsLong) = Procedure(AddressOf Cast.z_CurAsLong)
        Cast.CurAsLong Value, Low, High
    End Sub
    
    Public Function IntAsLong(ByVal Low As Integer, ByVal High As Integer) As Long
        Procedure(AddressOf Cast.IntAsLong) = Procedure(AddressOf Cast.z_IntAsLong)
        IntAsLong = Cast.IntAsLong(Low, High)
    End Function
    
    Public Function LngAsCurrency(ByVal Low As Long, ByVal High As Long) As Currency
        Procedure(AddressOf Cast.LngAsCurrency) = Procedure(AddressOf Cast.z_LngAsCurrency)
        LngAsCurrency = Cast.LngAsCurrency(Low, High)
    End Function
    
    Public Sub LngAsInteger(ByVal Value As Long, Low As Integer, High As Integer)
        Procedure(AddressOf Cast.LngAsInteger) = Procedure(AddressOf Cast.z_LngAsInteger)
        Cast.LngAsInteger Value, Low, High
    End Sub
    
    Public Function LngAsSingle(ByVal Value As Long) As Single
        Procedure(AddressOf Cast.LngAsSingle) = Procedure(AddressOf Cast.z_LngAsSingle)
        LngAsSingle = Cast.LngAsSingle(Value)
    End Function
    
    Public Function SngAsLong(ByVal Value As Single) As Long
        Procedure(AddressOf Cast.SngAsLong) = Procedure(AddressOf Cast.z_SngAsLong)
        SngAsLong = Cast.SngAsLong(Value)
    End Function
    
    
    
    Public Sub z_CurAsLong(ByVal CurLow As Long, ByVal CurHigh As Long, Low As Long, High As Long)
        Low = CurLow
        High = CurHigh
    End Sub
    
    Public Function z_IntAsLong(ByVal Value As Long) As Long
        z_IntAsLong = Value
    End Function
    
    Public Function z_LngAsCurrency(ByVal Value As Currency) As Currency
        z_LngAsCurrency = Value
    End Function
    
    Public Sub z_LngAsInteger(ByVal CurLow As Integer, ByVal CurHigh As Integer, Low As Integer, High As Integer)
        Low = CurLow
        High = CurHigh
    End Sub
    
    Public Function z_LngAsSingle(ByVal Value As Single) As Single
        z_LngAsSingle = Value
    End Function
    
    Public Function z_SngAsLong(ByVal Value As Long) As Long
        z_SngAsLong = Value
    End Function
    Code:
    ' Pointer.bas
    Option Explicit
    
    Public Function BytArrPtr(Arr() As Byte) As Long
        Procedure(AddressOf Pointer.BytArrPtr) = Procedure(AddressOf Pointer.z_ArrPtr)
        BytArrPtr = Pointer.BytArrPtr(Arr)
    End Function
    
    Public Function GetLong(ByVal Ptr As Long) As Long
        Procedure(AddressOf Pointer.GetLong) = Procedure(AddressOf Pointer.z_GetLong)
        GetLong = Pointer.GetLong(Ptr)
    End Function
    
    Public Function IntArrPtr(Arr() As Integer) As Long
        Procedure(AddressOf Pointer.IntArrPtr) = Procedure(AddressOf Pointer.z_ArrPtr)
        IntArrPtr = Pointer.IntArrPtr(Arr)
    End Function
    
    Public Sub PutCurrency(ByVal Ptr As Long, ByVal Value As Currency)
        Procedure(AddressOf Pointer.PutCurrency) = Procedure(AddressOf z_PutCurrency)
        Pointer.PutCurrency Ptr, Value
    End Sub
    
    Public Sub PutLong(ByVal Ptr As Long, ByVal Value As Long)
        Procedure(AddressOf Pointer.PutLong) = Procedure(AddressOf Pointer.z_PutLong)
        Pointer.PutLong Ptr, Value
    End Sub
    
    Public Function StrArrPtr(Arr() As String) As Long
        Procedure(AddressOf Pointer.StrArrPtr) = Procedure(AddressOf Pointer.z_ArrPtr)
        StrArrPtr = Pointer.StrArrPtr(Arr)
    End Function
    
    
    
    Public Function z_ArrPtr(ByVal Value As Long) As Long
        z_ArrPtr = Value
    End Function
    
    Public Function z_GetLong(Ptr As Long) As Long
        z_GetLong = Ptr
    End Function
    
    Public Sub z_PutCurrency(Ptr As Currency, ByVal Value As Currency)
        Ptr = Value
    End Sub
    
    Public Sub z_PutLong(Ptr As Long, ByVal Value As Long)
        Ptr = Value
    End Sub
    Code:
    ' SafeArray.bas
    Option Explicit
    
    Public Function BytArrAsInteger(Arr() As Byte) As Integer()
        Dim Ptr As Long, UB As Long
        Ptr = Not Not Arr
        Debug.Assert App.hInstance
        If Ptr Then
            UB = UBound(Arr)
            If UB And 1 Then
                PutLong BytArrPtr(Arr), 0
                If GetLong(Ptr) And &H800000 Then PutLong Ptr - 4, vbInteger
                PutLong Ptr + 4, 2
                PutLong Ptr + 16, (UB + 1) \ 2
                PutLong IntArrPtr(BytArrAsInteger), Ptr
            End If
        End If
    End Function
    
    Public Function IntArrAsByte(Arr() As Integer) As Byte()
        Dim Ptr As Long, UB As Long
        Ptr = Not Not Arr
        Debug.Assert App.hInstance
        If Ptr Then
            UB = UBound(Arr)
            PutLong IntArrPtr(Arr), 0
            If GetLong(Ptr) And &H800000 Then PutLong Ptr - 4, vbByte
            PutLong Ptr + 4, 1
            PutLong Ptr + 16, (UB + 1) * 2
            PutLong BytArrPtr(IntArrAsByte), Ptr
        End If
    End Function
    
    Public Function NewByteArray() As Byte()
        Dim H() As Long ' safe array header for an empty byte array
        ReDim H(0 To 6): H(0) = vbByte: H(1) = &H800001: H(2) = 1
        ' H(1) becomes ArrPtr; H(0) is a negative item telling array datatype
        PutLong Pointer.BytArrPtr(NewByteArray), VarPtr(H(1))
        ' remove items from H array
        PutCurrency (Not Not H) + 12, 0
    End Function
    
    Public Function NewStringArray() As String()
        Dim H() As Long ' safe array header for an empty string array
        ReDim H(0 To 6): H(0) = vbString: H(1) = &H1800001: H(2) = 4
        ' H(1) becomes ArrPtr; H(0) is a negative item telling array datatype
        PutLong Pointer.StrArrPtr(NewStringArray), VarPtr(H(1))
        ' remove items from H array
        PutCurrency (Not Not H) + 12, 0
    End Function
    Last edited by Merri; Jun 12th, 2010 at 04:05 AM.

  2. #2

    Thread Starter
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Advanced procedure hacking

    Reserved for possible future code or first post running out of space.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.