VB6 Hijacking

Option Explicit
'add one listbox and two buttons

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Sub GetMem4 Lib "msvbvm60.dll" (ByVal lAddress As Long, var As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)

Private Type extEntry
    flag As Long
    offset As Long
End Type

Dim readyToReturn As Boolean

Private Sub Command1_Click()
    readyToReturn = True
End Sub

Function IsIde() As Boolean
    On Error GoTo out
    Debug.Print 1 / 0
out: IsIde = Err
End Function

Private Sub Command2_Click()
    End
End Sub

Private Sub Form_Load()

'    Dim v  As VB.Global
'    MsgBox v.App.EXEName 'variable not set..this is good, sanity check
'    End
    
    If IsIde Then
        MsgBox "Only run compiled"
        End
    Else
        Me.Caption = "It worked!"
        Command1.Caption = "Continue"
        Command2.Caption = "End"
        List1.Move 0, 0, 8000, 8000
        Me.Width = 8400
        Me.Height = 9100
        Command1.Move Me.Width - 3000, 8025
        Command2.Move Me.Width - 1500, 8025
        DoTheTrickStuff
    End If
    
End Sub

Sub xx(msg As String, v As Long, Optional wait As Boolean = False)
    List1.AddItem msg & ": " & Hex(v) & IIf(wait, "  --- Waiting for continue click...", Empty)
    List1.Refresh
    DoEvents
    If wait Then
        readyToReturn = False
        While Not readyToReturn
            DoEvents
        Wend
    End If
End Sub




Private Sub DoTheTrickStuff()
   
    Dim vbHeader As Long, lpProjectData As Long, projectDataPointerValue As Long
    Dim lpExternalTable As Long, externalTablePointerValue As Long
    Dim externalCount As Long, lpExternalCount As Long
    Dim i As Integer, e As extEntry, myCaption As String
    Dim globalPtr As Long, lpGlobalPtr As Long, globalClone As VB.Global

    Me.Visible = True
    xx "The pointer I am after", ObjPtr(VB.Global)
     
    vbHeader = GetVBHeader()
    xx "Header", vbHeader
    
    lpProjectData = vbHeader + &H30
    GetMem4 ByVal lpProjectData, projectDataPointerValue
    xx "lpProject", projectDataPointerValue

    lpExternalCount = projectDataPointerValue + &H238
    xx "lpExternalCount", lpExternalCount
    
    GetMem4 ByVal lpExternalCount, externalCount
    xx "ExtCount", externalCount
    
    lpExternalTable = projectDataPointerValue + &H234
    xx "lpExtTable", lpExternalTable
    
    GetMem4 ByVal lpExternalTable, externalTablePointerValue
    xx "ExtTable", externalTablePointerValue
    
    For i = 0 To externalCount
        CopyMemory ByVal VarPtr(e), ByVal externalTablePointerValue, 8
        
        Debug.Print i & ") " & Hex(externalTablePointerValue) & " " & e.flag & " " & Hex(e.offset)
        
        If e.flag = 6 Then 'Tag of global object
            xx "Found flag", e.flag
        
            GetMem4 ByVal e.offset + 4, lpGlobalPtr
            xx "lpGlobalPointer", lpGlobalPtr
            
            GetMem4 ByVal lpGlobalPtr, globalPtr
            xx "GlobalPointer", globalPtr
            
            If globalPtr = ObjPtr(VB.Global) Then
                List1.AddItem "Success!!"
            Else
                List1.AddItem "FAIL!!"
                Exit For
            End If
            
            Set globalClone = GlobalFromPointer(ByVal globalPtr)
            xx "ObjPtr(globalClone)", ObjPtr(globalClone) ', True

            myCaption = globalClone.Forms(0).Caption
            List1.AddItem "globalClone.Forms(0).Caption = " & myCaption
            globalClone.Forms(0).Caption = "Are you sure?!"
            
            Exit For
        End If
        
        externalTablePointerValue = externalTablePointerValue + 8
    Next
    
    List1.AddItem "Complete"
    
End Sub

Private Function GlobalFromPointer(ByVal ptr&) As VB.Global
  ' this function returns a reference to our form class
  
  ' dimension an object variable that we can copy the
  ' passed pointer into
  Dim globalClone As VB.Global
    
  ' use the CopyMemory API function to copy the
  ' long pointer into the object variable.
  CopyMemory globalClone, ptr, 4&
  Set GlobalFromPointer = globalClone
  CopyMemory ptr&, 0&, 4&
  
End Function

Public Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj As Object
    CopyMemory obj, pObj, LenB(obj) 'not size 4!
    Set ObjFromPtr = obj
    CopyMemory obj, 0&, LenB(obj) 'not size 4!
End Function

' // Get VBHeader structure
Private Function GetVBHeader() As Long
    Dim ptr     As Long
    Dim hModule As Long
    hModule = GetModuleHandle(ByVal "Project1.exe")
    ' Get e_lfanew
    GetMem4 ByVal hModule + &H3C, ptr
    ' Get AddressOfEntryPoint
    GetMem4 ByVal ptr + &H28 + hModule, ptr
    ' Get VBHeader
    GetMem4 ByVal ptr + hModule + 1, GetVBHeader
    
End Function

Private Sub Form_Resize()
    On Error Resume Next
    List1.Width = Me.Width
End Sub