AddressOf for Visual Basic 4.0

addressof.bas

Attribute VB_Name = "AddressOf"
Option Explicit

' This module is only needed in VB4.  The functions
' are used to get the addresses of variables as you
' would with AddressOf in VB5 or higher.
' If you use this, you need to call AllocAsmCode at
' the beginning of your program and check the return
' value.  Only continue the program if it returns
' True.  Also call FreeAsmCode before your program
' ends.

Dim AddressOfProc As Long

Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const MEM_COMMIT = &H1000&
Private Const MEM_RELEASE = &H8000&

Private Declare Function VirtualAlloc Lib "Kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "Kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Boolean
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByRef hWnd As Any, ByRef Msg As Any, ByRef wParam As Any, ByRef lParam As Any) As Long

' Make a copy of this function and modify the type
' of the variable varpt to get the address of other
' variable types
Function AddressOfByte(ByRef varpt As Byte) As Long
AddressOfByte = CallWindowProc(AddressOfProc, varpt, ByVal 0&, ByVal 0&, ByVal 0&)
End Function
Function AllocAsmCode() As Boolean
Dim buffer(11) As Byte
If AddressOfProc <> 0 Then
    AllocAsmCode = True
    Exit Function
End If
AddressOfProc = VirtualAlloc(0, 12, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
If AddressOfProc = 0 Then
    AllocAsmCode = False
    Exit Function
End If
AllocAsmCode = True
buffer(0) = &H55                                       'push ebp
buffer(1) = &H8B: buffer(2) = &HEC                     'mov         ebp,esp
buffer(3) = &H8B: buffer(4) = &H45: buffer(5) = &H8    'mov         eax,dword ptr [ebp+8]
buffer(6) = &H8B: buffer(7) = &HE5                     'mov         esp,ebp
buffer(8) = &H5D                                       'pop         ebp
buffer(9) = &HC2: buffer(10) = &H10: buffer(11) = &H0  'ret         10h

CopyMemory ByVal AddressOfProc, buffer(0), 12
End Function
Sub FreeAsmCode()
If AddressOfProc <> 0 Then _
    VirtualFree AddressOfProc, 0, MEM_RELEASE
End Sub