├── .gitattributes ├── .gitignore ├── README.md ├── VB64BitDllUsage.exe ├── VB64BitDllUsage.vbp ├── dll ├── dll.dll └── main.c ├── frmMain.frm └── modX64Call.bas /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | * text eol=crlf 4 | 5 | *.bin binary 6 | *.tlb binary 7 | *.ico binary 8 | *.cur binary 9 | *.exe binary 10 | *.dll binary 11 | *.frx binary 12 | *.exp binary 13 | *.lib binary 14 | *.pdb binary 15 | *.RES binary 16 | *.obj binary 17 | *.png binary 18 | *.wav binary -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.vbw 2 | *.pdb 3 | *.exp 4 | *.lib 5 | dll/* 6 | !dll/main.c 7 | !dll/dll.dll -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Vb64BitDllUsage 2 | Using 64-bit dll in VB6 (in WOW64). It uses [modX64Call.bas](https://github.com/thetrik/MemoryUsage/blob/master/modX64Call.bas) for calling 64-bit functions. Your dll can use only native-api-functions. This example shows how to call **GetProcessMemoryInfo64** function from the 64-bit C-dll. 3 | 4 | -------------------------------------------------------------------------------- /VB64BitDllUsage.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vb64BitDllUsage/cb90cd081df4e8093b05f2084faded18468c4510/VB64BitDllUsage.exe -------------------------------------------------------------------------------- /VB64BitDllUsage.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=frmMain.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 4 | Module=modX64Call; modX64Call.bas 5 | IconForm="frmMain" 6 | Startup="frmMain" 7 | HelpFile="" 8 | ExeName32="VB64BitDllUsage.exe" 9 | Command32="" 10 | Name="VB64BitDllUsage" 11 | HelpContextID="0" 12 | CompatibleMode="0" 13 | MajorVer=1 14 | MinorVer=0 15 | RevisionVer=0 16 | AutoIncrementVer=0 17 | ServerSupportFiles=0 18 | VersionCompanyName="Microsoft" 19 | CompilationType=0 20 | OptimizationType=0 21 | FavorPentiumPro(tm)=-1 22 | CodeViewDebugInfo=-1 23 | NoAliasing=-1 24 | BoundsCheck=-1 25 | OverflowCheck=-1 26 | FlPointCheck=-1 27 | FDIVCheck=-1 28 | UnroundedFP=-1 29 | StartMode=0 30 | Unattended=0 31 | Retained=0 32 | ThreadPerObject=0 33 | MaxNumberOfThreads=1 34 | -------------------------------------------------------------------------------- /dll/dll.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/Vb64BitDllUsage/cb90cd081df4e8093b05f2084faded18468c4510/dll/dll.dll -------------------------------------------------------------------------------- /dll/main.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include 4 | 5 | #pragma comment (lib, "ntdll.lib") 6 | #pragma comment (linker, "/EXPORT:GetProcessMemoryInfo64") 7 | 8 | typedef enum _PROCESSINFOCLASS { 9 | ProcessVmCounters = 3 10 | } PROCESSINFOCLASS; 11 | 12 | typedef struct _VM_COUNTERS { 13 | SIZE_T PeakVirtualSize; 14 | SIZE_T VirtualSize; 15 | ULONG PageFaultCount; 16 | SIZE_T PeakWorkingSetSize; 17 | SIZE_T WorkingSetSize; 18 | SIZE_T QuotaPeakPagedPoolUsage; 19 | SIZE_T QuotaPagedPoolUsage; 20 | SIZE_T QuotaPeakNonPagedPoolUsage; 21 | SIZE_T QuotaNonPagedPoolUsage; 22 | SIZE_T PagefileUsage; 23 | SIZE_T PeakPagefileUsage; 24 | SIZE_T PrivatePageCount; 25 | } VM_COUNTERS; 26 | 27 | typedef struct _CLIENT_ID { 28 | HANDLE UniqueProcess; 29 | HANDLE UniqueThread; 30 | } CLIENT_ID, *PCLIENT_ID; 31 | 32 | typedef struct _UNICODE_STRING { 33 | USHORT Length; 34 | USHORT MaximumLength; 35 | PWSTR Buffer; 36 | } UNICODE_STRING, *PUNICODE_STRING; 37 | 38 | typedef struct _OBJECT_ATTRIBUTES { 39 | ULONG Length; 40 | HANDLE RootDirectory; 41 | PUNICODE_STRING ObjectName; 42 | ULONG Attributes; 43 | PVOID SecurityDescriptor; 44 | PVOID SecurityQualityOfService; 45 | } OBJECT_ATTRIBUTES; 46 | typedef OBJECT_ATTRIBUTES *POBJECT_ATTRIBUTES; 47 | 48 | NTSTATUS NTAPI 49 | NtOpenProcess ( 50 | __out PHANDLE ProcessHandle, 51 | __in ACCESS_MASK DesiredAccess, 52 | __in POBJECT_ATTRIBUTES ObjectAttributes, 53 | __in_opt PCLIENT_ID ClientId 54 | ); 55 | 56 | NTSTATUS NTAPI 57 | NtQueryInformationProcess( 58 | IN HANDLE ProcessHandle, 59 | IN PROCESSINFOCLASS ProcessInformationClass, 60 | OUT PVOID ProcessInformation, 61 | IN ULONG ProcessInformationLength, 62 | OUT PULONG ReturnLength OPTIONAL); 63 | 64 | NTSTATUS NTAPI 65 | NtClose( 66 | IN HANDLE Handle 67 | ); 68 | 69 | #ifndef NT_SUCCESS 70 | #define NT_SUCCESS(x) ((x)>=0) 71 | #define STATUS_SUCCESS ((NTSTATUS)0) 72 | #endif 73 | 74 | BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpReserved) { 75 | return TRUE; 76 | } 77 | 78 | BOOL WINAPI GetProcessMemoryInfo64 (DWORD dwPID, PROCESS_MEMORY_COUNTERS *ppsmemCounters) { 79 | VM_COUNTERS tVmCounters; 80 | CLIENT_ID tClientId; 81 | OBJECT_ATTRIBUTES tObjAttr; 82 | HANDLE hProcess; 83 | ULONG uRet; 84 | BOOL bRet = FALSE; 85 | 86 | if (!ppsmemCounters || ppsmemCounters->cb != sizeof(PROCESS_MEMORY_COUNTERS)) 87 | return FALSE; 88 | 89 | tClientId.UniqueThread = 0; 90 | tClientId.UniqueProcess = (HANDLE)dwPID; 91 | 92 | tObjAttr.Length = sizeof(OBJECT_ATTRIBUTES); 93 | tObjAttr.Attributes = 0; 94 | tObjAttr.RootDirectory = 0; 95 | tObjAttr.ObjectName = 0; 96 | tObjAttr.SecurityDescriptor = 0; 97 | tObjAttr.SecurityQualityOfService = 0; 98 | 99 | if (!NT_SUCCESS(NtOpenProcess(&hProcess, PROCESS_QUERY_LIMITED_INFORMATION, &tObjAttr, &tClientId))) 100 | return FALSE; 101 | 102 | if (NT_SUCCESS(NtQueryInformationProcess(hProcess, ProcessVmCounters, &tVmCounters, sizeof(tVmCounters), &uRet))) { 103 | 104 | ppsmemCounters->PageFaultCount = tVmCounters.PageFaultCount; 105 | ppsmemCounters->PagefileUsage = tVmCounters.PagefileUsage; 106 | ppsmemCounters->PeakPagefileUsage = tVmCounters.PeakPagefileUsage; 107 | ppsmemCounters->PeakWorkingSetSize = tVmCounters.PeakWorkingSetSize; 108 | ppsmemCounters->QuotaNonPagedPoolUsage = tVmCounters.QuotaNonPagedPoolUsage; 109 | ppsmemCounters->QuotaPagedPoolUsage = tVmCounters.QuotaPagedPoolUsage; 110 | ppsmemCounters->QuotaPeakNonPagedPoolUsage = tVmCounters.QuotaPeakNonPagedPoolUsage; 111 | ppsmemCounters->QuotaPeakPagedPoolUsage = tVmCounters.QuotaPeakPagedPoolUsage; 112 | ppsmemCounters->WorkingSetSize = tVmCounters.WorkingSetSize; 113 | 114 | bRet = TRUE; 115 | 116 | } 117 | 118 | NtClose(hProcess); 119 | 120 | return bRet; 121 | 122 | 123 | } -------------------------------------------------------------------------------- /frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "64bit dll usage by The trick" 5 | ClientHeight = 3405 6 | ClientLeft = 45 7 | ClientTop = 375 8 | ClientWidth = 4935 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 3405 13 | ScaleWidth = 4935 14 | StartUpPosition = 3 'Windows Default 15 | Begin VB.TextBox txtInfo 16 | BackColor = &H8000000F& 17 | BorderStyle = 0 'None 18 | Height = 1575 19 | Left = 120 20 | Locked = -1 'True 21 | MultiLine = -1 'True 22 | TabIndex = 3 23 | Top = 60 24 | Width = 4635 25 | End 26 | Begin VB.TextBox txtPID 27 | Height = 315 28 | Left = 60 29 | TabIndex = 1 30 | Text = "0" 31 | Top = 2040 32 | Width = 4695 33 | End 34 | Begin VB.CommandButton cmdGetInfo 35 | Caption = "Get info using 64 bit dll" 36 | Enabled = 0 'False 37 | Height = 735 38 | Left = 480 39 | TabIndex = 0 40 | Top = 2460 41 | Width = 3615 42 | End 43 | Begin VB.Label lblPID 44 | Caption = "PID:" 45 | Height = 315 46 | Left = 60 47 | TabIndex = 2 48 | Top = 1740 49 | Width = 2415 50 | End 51 | End 52 | Attribute VB_Name = "frmMain" 53 | Attribute VB_GlobalNameSpace = False 54 | Attribute VB_Creatable = False 55 | Attribute VB_PredeclaredId = True 56 | Attribute VB_Exposed = False 57 | ' // 58 | ' // 64bit dll working demonstartion (loading / calling function) 59 | ' // By The trick, 2022 60 | ' // 61 | 62 | Option Explicit 63 | 64 | Private Type PROCESS_MEMORY_COUNTERS64 65 | cb As Long 66 | PageFaultCount As Long 67 | PeakWorkingSetSize As Currency 68 | WorkingSetSize As Currency 69 | QuotaPeakPagedPoolUsage As Currency 70 | QuotaPagedPoolUsage As Currency 71 | QuotaPeakNonPagedPoolUsage As Currency 72 | QuotaNonPagedPoolUsage As Currency 73 | PagefileUsage As Currency 74 | PeakPagefileUsage As Currency 75 | End Type 76 | 77 | Private Type UNICODE_STRING64 78 | Length As Integer 79 | MaxLength As Integer 80 | lPad As Long 81 | lpBuffer As Currency 82 | End Type 83 | 84 | Private Type ANSI_STRING64 85 | Length As Integer 86 | MaxLength As Integer 87 | lPad As Long 88 | lpBuffer As Currency 89 | End Type 90 | 91 | Private Declare Function StrFormatKBSize Lib "shlwapi" _ 92 | Alias "StrFormatKBSizeW" ( _ 93 | ByVal qdw As Currency, _ 94 | ByVal pszBuf As Long, _ 95 | ByVal cchBuf As Long) As Long 96 | Private Declare Function GetMem4 Lib "msvbvm60.dll" ( _ 97 | ByRef pSrc As Any, _ 98 | ByRef pDst As Any) As Long 99 | 100 | Private m_h64Lib As Currency 101 | Private m_p64Fn As Currency 102 | 103 | Private Sub Form_Load() 104 | Dim h64NtDll As Currency 105 | Dim p64LdrLoad As Currency 106 | Dim p64LdrGetProc As Currency 107 | Dim sDllPath As String 108 | Dim sFnName As String 109 | Dim tDllPath As UNICODE_STRING64 110 | Dim tFnName As ANSI_STRING64 111 | Dim lStatus As Long 112 | 113 | On Error GoTo err_handler 114 | 115 | If Not modX64Call.Initialize() Then 116 | MsgBox "Unable to initialize x64 call module", vbCritical 117 | Exit Sub 118 | End If 119 | 120 | h64NtDll = GetModuleHandle64("ntdll.dll") 121 | If h64NtDll = 0 Then 122 | MsgBox "Unable to get ntdll64", vbCritical 123 | Exit Sub 124 | End If 125 | 126 | p64LdrLoad = GetProcAddress64(h64NtDll, "LdrLoadDll") 127 | If p64LdrLoad = 0 Then 128 | MsgBox "Unable to get LdrLoadDll", vbCritical 129 | Exit Sub 130 | End If 131 | 132 | p64LdrGetProc = GetProcAddress64(h64NtDll, "LdrGetProcedureAddress") 133 | If p64LdrGetProc = 0 Then 134 | MsgBox "Unable to get LdrGetProcedureAddress", vbCritical 135 | Exit Sub 136 | End If 137 | 138 | ' // Load 64 bit dll 139 | sDllPath = App.Path & "\dll\dll.dll" 140 | 141 | tDllPath.Length = LenB(sDllPath) 142 | tDllPath.MaxLength = tDllPath.Length + 2 143 | GetMem4 StrPtr(sDllPath), tDllPath.lpBuffer 144 | 145 | GetMem4 CallX64(p64LdrLoad, 0&, 0&, VarPtr(tDllPath), VarPtr(m_h64Lib)), lStatus 146 | 147 | If lStatus < 0 Then 148 | MsgBox "Unable to load dll " & lStatus, vbCritical 149 | Exit Sub 150 | End If 151 | 152 | ' // GetProcAddress 153 | sFnName = StrConv("GetProcessMemoryInfo64", vbFromUnicode) 154 | 155 | tFnName.Length = LenB(sFnName) 156 | tFnName.MaxLength = tFnName.Length + 1 157 | GetMem4 StrPtr(sFnName), tFnName.lpBuffer 158 | 159 | GetMem4 CallX64(p64LdrGetProc, m_h64Lib, VarPtr(tFnName), 0, VarPtr(m_p64Fn)), lStatus 160 | 161 | If lStatus < 0 Then 162 | MsgBox "Unable to get procedure address " & lStatus, vbCritical 163 | Exit Sub 164 | End If 165 | 166 | cmdGetInfo.Enabled = True 167 | 168 | Exit Sub 169 | 170 | err_handler: 171 | 172 | MsgBox "An error occured " & Err.Number, vbCritical 173 | 174 | End Sub 175 | 176 | Private Sub cmdGetInfo_Click() 177 | Dim lPID As Long 178 | Dim tMemInfo As PROCESS_MEMORY_COUNTERS64 179 | 180 | On Error GoTo err_handler 181 | 182 | lPID = Val(txtPID.Text) 183 | 184 | ' // Call 64 bit function 185 | tMemInfo.cb = LenB(tMemInfo) 186 | 187 | If CallX64(m_p64Fn, lPID, VarPtr(tMemInfo)) = 0 Then 188 | MsgBox "GetProcessMemoryInfo64 failed", vbInformation 189 | Else 190 | With tMemInfo 191 | txtInfo.Text = "WorkingSetSize: " & FormatSize(.WorkingSetSize) & vbNewLine & _ 192 | "PagefileUsage: " & FormatSize(.PagefileUsage) & vbNewLine & _ 193 | "PageFaultCount: " & .PageFaultCount & vbNewLine & _ 194 | "PeakPagefileUsage: " & FormatSize(.PeakPagefileUsage) & vbNewLine & _ 195 | "PeakWorkingSetSize: " & FormatSize(.PeakWorkingSetSize) & vbNewLine & _ 196 | "QuotaNonPagedPoolUsage: " & FormatSize(.QuotaNonPagedPoolUsage) & vbNewLine & _ 197 | "QuotaPagedPoolUsage: " & FormatSize(.QuotaPagedPoolUsage) & vbNewLine & _ 198 | "QuotaPeakNonPagedPoolUsage: " & FormatSize(.QuotaPeakNonPagedPoolUsage) & vbNewLine & _ 199 | "QuotaPeakPagedPoolUsage: " & FormatSize(.QuotaPeakPagedPoolUsage) 200 | End With 201 | End If 202 | 203 | Exit Sub 204 | 205 | err_handler: 206 | 207 | MsgBox "An error occured " & Err.Number, vbCritical 208 | 209 | End Sub 210 | 211 | Private Function FormatSize( _ 212 | ByVal cValue As Currency) As String 213 | 214 | FormatSize = Space$(32) 215 | 216 | If StrFormatKBSize(cValue, StrPtr(FormatSize), Len(FormatSize)) Then 217 | FormatSize = Left$(FormatSize, InStr(1, FormatSize, vbNullChar) - 1) 218 | Else 219 | FormatSize = "ERROR" 220 | End If 221 | 222 | End Function 223 | 224 | Private Sub Form_Unload( _ 225 | ByRef Cancel As Integer) 226 | modX64Call.Uninitialize 227 | End Sub 228 | -------------------------------------------------------------------------------- /modX64Call.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modX64Call" 2 | 3 | ' // 4 | ' // modX64Call.bas 5 | ' // Module for calling functions in long-mode (x64) 6 | ' // by The trick 2018 - 2020 7 | ' // 8 | 9 | Option Explicit 10 | 11 | Private Const ProcessBasicInformation As Long = 0 12 | Private Const MEM_RESERVE As Long = &H2000& 13 | Private Const MEM_COMMIT As Long = &H1000& 14 | Private Const MEM_RELEASE As Long = &H8000& 15 | Private Const PAGE_READWRITE As Long = 4& 16 | Private Const FADF_AUTO As Long = 1 17 | Private Const PAGE_EXECUTE_READWRITE As Long = &H40& 18 | Private Const PROCESS_VM_READ As Long = &H10 19 | 20 | Private Type UNICODE_STRING64 21 | Length As Integer 22 | MaxLength As Integer 23 | lPad As Long 24 | lpBuffer As Currency 25 | End Type 26 | 27 | Private Type ANSI_STRING64 28 | Length As Integer 29 | MaxLength As Integer 30 | lPad As Long 31 | lpBuffer As Currency 32 | End Type 33 | 34 | Private Type PROCESS_BASIC_INFORMATION64 35 | ExitStatus As Long 36 | Reserved0 As Long 37 | PebBaseAddress As Currency 38 | AffinityMask As Currency 39 | BasePriority As Long 40 | Reserved1 As Long 41 | uUniqueProcessId As Currency 42 | uInheritedFromUniqueProcessId As Currency 43 | End Type 44 | 45 | Private Type IMAGE_DATA_DIRECTORY 46 | VirtualAddress As Long 47 | Size As Long 48 | End Type 49 | 50 | Private Type IMAGE_EXPORT_DIRECTORY 51 | Characteristics As Long 52 | TimeDateStamp As Long 53 | MajorVersion As Integer 54 | MinorVersion As Integer 55 | pName As Long 56 | Base As Long 57 | NumberOfFunctions As Long 58 | NumberOfNames As Long 59 | AddressOfFunctions As Long 60 | AddressOfNames As Long 61 | AddressOfNameOrdinals As Long 62 | End Type 63 | 64 | Private Type SAFEARRAYBOUND 65 | cElements As Long 66 | lLbound As Long 67 | End Type 68 | 69 | Private Type SAFEARRAY1D 70 | cDims As Integer 71 | fFeatures As Integer 72 | cbElements As Long 73 | cLocks As Long 74 | pvData As Long 75 | Bounds As SAFEARRAYBOUND 76 | End Type 77 | 78 | Private Declare Function OpenProcess Lib "kernel32" ( _ 79 | ByVal dwDesiredAccess As Long, _ 80 | ByVal bInheritHandle As Long, _ 81 | ByVal dwProcessId As Long) As Long 82 | Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long 83 | Private Declare Function CloseHandle Lib "kernel32" ( _ 84 | ByVal hObject As Long) As Long 85 | Private Declare Function NtWow64QueryInformationProcess64 Lib "ntdll" ( _ 86 | ByVal hProcess As Long, _ 87 | ByVal ProcessInformationClass As Long, _ 88 | ByRef pProcessInformation As Any, _ 89 | ByVal uProcessInformationLength As Long, _ 90 | ByRef puReturnLength As Long) As Long 91 | Private Declare Function NtWow64ReadVirtualMemory64 Lib "ntdll" ( _ 92 | ByVal hProcess As Long, _ 93 | ByVal p64Address As Currency, _ 94 | ByRef Buffer As Any, _ 95 | ByVal l64BufferLen As Currency, _ 96 | ByRef pl64ReturnLength As Currency) As Long 97 | Private Declare Function GetMem8 Lib "msvbvm60" ( _ 98 | ByRef Src As Any, _ 99 | ByRef Dst As Any) As Long 100 | Private Declare Function GetMem4 Lib "msvbvm60" ( _ 101 | ByRef Src As Any, _ 102 | ByRef Dst As Any) As Long 103 | Private Declare Function GetMem2 Lib "msvbvm60" ( _ 104 | ByRef Src As Any, _ 105 | ByRef Dst As Any) As Long 106 | Private Declare Function GetMem1 Lib "msvbvm60" ( _ 107 | ByRef Src As Any, _ 108 | ByRef Dst As Any) As Long 109 | Private Declare Function VirtualAlloc Lib "kernel32" ( _ 110 | ByVal lpAddress As Long, _ 111 | ByVal dwSize As Long, _ 112 | ByVal flAllocationType As Long, _ 113 | ByVal flProtect As Long) As Long 114 | Private Declare Function VirtualFree Lib "kernel32" ( _ 115 | ByVal lpAddress As Long, _ 116 | ByVal dwSize As Long, _ 117 | ByVal dwFreeType As Long) As Long 118 | Private Declare Function DispCallFunc Lib "oleaut32.dll" ( _ 119 | ByRef pvInstance As Any, _ 120 | ByVal oVft As Long, _ 121 | ByVal cc As Long, _ 122 | ByVal vtReturn As VbVarType, _ 123 | ByVal cActuals As Long, _ 124 | ByRef prgvt As Any, _ 125 | ByRef prgpvarg As Any, _ 126 | ByRef pvargResult As Variant) As Long 127 | Private Declare Function lstrcmp Lib "kernel32" _ 128 | Alias "lstrcmpA" ( _ 129 | ByRef lpString1 As Any, _ 130 | ByRef lpString2 As Any) As Long 131 | Private Declare Function lstrcmpi Lib "kernel32" _ 132 | Alias "lstrcmpiA" ( _ 133 | ByRef lpString1 As Any, _ 134 | ByRef lpString2 As Any) As Long 135 | Private Declare Function ArrPtr Lib "msvbvm60" _ 136 | Alias "VarPtr" ( _ 137 | ByRef psa() As Any) As Long 138 | Private Declare Sub MoveArray Lib "msvbvm60" _ 139 | Alias "__vbaAryMove" ( _ 140 | ByRef Destination() As Any, _ 141 | ByRef Source As Any) 142 | 143 | Private m_pCodeBuffer As Long 144 | Private m_hCurHandle As Long 145 | 146 | ' // Initialize module 147 | Public Function Initialize() As Boolean 148 | 149 | If m_pCodeBuffer = 0 Then 150 | 151 | m_hCurHandle = OpenProcess(PROCESS_VM_READ, 0, GetCurrentProcessId()) 152 | 153 | If m_hCurHandle = 0 Then 154 | Exit Function 155 | End If 156 | 157 | ' // Temporary buffer for caller 158 | ' // Be careful it doesn't support threading 159 | ' // To support threading you should ensure atomic access to that buffer 160 | m_pCodeBuffer = VirtualAlloc(0, 4096, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE) 161 | 162 | If m_pCodeBuffer = 0 Then 163 | CloseHandle m_hCurHandle 164 | Exit Function 165 | End If 166 | 167 | End If 168 | 169 | Initialize = True 170 | 171 | End Function 172 | 173 | ' // Uninitialize module 174 | Public Sub Uninitialize() 175 | 176 | If m_hCurHandle Then 177 | CloseHandle m_hCurHandle 178 | End If 179 | 180 | If m_pCodeBuffer Then 181 | VirtualFree m_pCodeBuffer, 0, MEM_RELEASE 182 | End If 183 | 184 | End Sub 185 | 186 | ' // 187 | ' // Call 64 bit function by pointer 188 | ' // 189 | Public Function CallX64( _ 190 | ByVal pfn64 As Currency, _ 191 | ParamArray vArgs() As Variant) As Currency 192 | Dim bCode() As Byte ' // Array to map code 193 | Dim vArg As Variant 194 | Dim lIndex As Long 195 | Dim lByteIdx As Long 196 | Dim lArgs As Long 197 | Dim tArrDesc As SAFEARRAY1D 198 | Dim vRet As Variant 199 | Dim hr As Long 200 | 201 | If m_pCodeBuffer = 0 Then 202 | 203 | ' // Isn't initialized 204 | Err.Raise 5 205 | Exit Function 206 | 207 | End If 208 | 209 | ' // Map array 210 | tArrDesc.cbElements = 1 211 | tArrDesc.cDims = 1 212 | tArrDesc.fFeatures = FADF_AUTO 213 | tArrDesc.Bounds.cElements = 4096 214 | tArrDesc.pvData = m_pCodeBuffer 215 | 216 | MoveArray bCode(), VarPtr(tArrDesc) 217 | 218 | ' // Make x64call 219 | 220 | ' // JMP FAR 33:ADDR 221 | bCode(0) = &HEA 222 | 223 | GetMem4 m_pCodeBuffer + 7, bCode(1) 224 | GetMem2 &H33, bCode(5) 225 | 226 | lByteIdx = 7 227 | 228 | ' // stack alignment 229 | 230 | ' // PUSH RBX 231 | ' // MOV RBX, SS 232 | ' // PUSH RBP 233 | ' // MOV RBP, RSP 234 | ' // AND ESP, 0xFFFFFFF0 235 | ' // SUB RSP, 0x28 + Args 236 | 237 | If UBound(vArgs) <= 3 Then 238 | lArgs = 4 239 | Else 240 | lArgs = ((UBound(vArgs) - 3) + 1) And &HFFFFFFFE 241 | End If 242 | 243 | lArgs = lArgs * 8 + &H20 244 | 245 | GetMem8 -140194732553717.1373@, bCode(lByteIdx): lByteIdx = lByteIdx + 8 246 | GetMem8 26004001868.3011@, bCode(lByteIdx): lByteIdx = lByteIdx + 6 247 | GetMem4 lArgs, bCode(lByteIdx): lByteIdx = lByteIdx + 4 248 | 249 | For Each vArg In vArgs 250 | 251 | Select Case VarType(vArg) 252 | Case vbLong, vbString, vbInteger, vbByte, vbBoolean 253 | 254 | Select Case lIndex 255 | Case 0: GetMem4 &HC1C748, bCode(lByteIdx): lByteIdx = lByteIdx + 3 256 | Case 1: GetMem4 &HC2C748, bCode(lByteIdx): lByteIdx = lByteIdx + 3 257 | Case 2: GetMem4 &HC0C749, bCode(lByteIdx): lByteIdx = lByteIdx + 3 258 | Case 3: GetMem4 &HC1C749, bCode(lByteIdx): lByteIdx = lByteIdx + 3 259 | Case Else 260 | 261 | GetMem4 &H2444C748, bCode(lByteIdx): lByteIdx = lByteIdx + 4 262 | GetMem1 (lIndex - 4) * 8 + &H20, bCode(lByteIdx): lByteIdx = lByteIdx + 1 263 | 264 | End Select 265 | 266 | Select Case VarType(vArg) 267 | Case vbLong, vbInteger, vbByte, vbBoolean 268 | GetMem4 CLng(vArg), bCode(lByteIdx): lByteIdx = lByteIdx + 4 269 | Case vbString 270 | GetMem4 ByVal StrPtr(vArg), bCode(lByteIdx): lByteIdx = lByteIdx + 4 271 | End Select 272 | 273 | Case vbCurrency 274 | 275 | Select Case lIndex 276 | Case 0: GetMem2 &HB948, bCode(lByteIdx): lByteIdx = lByteIdx + 2 277 | Case 1: GetMem2 &HBA48, bCode(lByteIdx): lByteIdx = lByteIdx + 2 278 | Case 2: GetMem2 &HB849, bCode(lByteIdx): lByteIdx = lByteIdx + 2 279 | Case 3: GetMem2 &HB949, bCode(lByteIdx): lByteIdx = lByteIdx + 2 280 | Case Else 281 | 282 | GetMem2 &HB848, bCode(lByteIdx): lByteIdx = lByteIdx + 2 283 | GetMem8 CCur(vArg), bCode(lByteIdx): lByteIdx = lByteIdx + 8 284 | GetMem4 &H24448948, bCode(lByteIdx): lByteIdx = lByteIdx + 4 285 | GetMem1 (lIndex - 4) * 8 + &H20, bCode(lByteIdx): lByteIdx = lByteIdx + 1 286 | 287 | End Select 288 | 289 | If lIndex < 4 Then 290 | GetMem8 CCur(vArg), bCode(lByteIdx): lByteIdx = lByteIdx + 8 291 | End If 292 | 293 | Case Else 294 | 295 | Err.Raise 13 296 | Exit Function 297 | 298 | End Select 299 | 300 | lIndex = lIndex + 1 301 | 302 | Next 303 | 304 | ' // MOV RAX, pfn: CALL RAX 305 | GetMem2 &HB848, bCode(lByteIdx): lByteIdx = lByteIdx + 2 306 | GetMem8 pfn64, bCode(lByteIdx): lByteIdx = lByteIdx + 8 307 | GetMem2 &HD0FF&, bCode(lByteIdx): lByteIdx = lByteIdx + 2 308 | 309 | ' // LEAVE 310 | ' // MOV SS, RBX 311 | ' // POP RBX 312 | GetMem8 39439134.1257@, bCode(lByteIdx): lByteIdx = lByteIdx + 5 313 | 314 | ' // RAX to EAX/EDX pair 315 | ' // MOV RDX, RAX 316 | ' // SHR RDX, 0x20 317 | GetMem8 926531512503.7384@, bCode(lByteIdx): 318 | lByteIdx = lByteIdx + 7 319 | 320 | ' // JMP FAR 23: 321 | GetMem2 &H2DFF, bCode(lByteIdx): lByteIdx = lByteIdx + 2 322 | GetMem4 0&, bCode(lByteIdx): lByteIdx = lByteIdx + 4 323 | GetMem4 m_pCodeBuffer + lByteIdx + 6, bCode(lByteIdx) 324 | 325 | lByteIdx = lByteIdx + 4 326 | GetMem2 &H23&, bCode(lByteIdx): lByteIdx = lByteIdx + 2 327 | 328 | bCode(lByteIdx) = &HC3 329 | 330 | hr = DispCallFunc(ByVal 0&, m_pCodeBuffer, 4, vbCurrency, 0, ByVal 0&, ByVal 0&, vRet) 331 | 332 | GetMem4 0&, ByVal ArrPtr(bCode) 333 | 334 | If hr < 0 Then 335 | Err.Raise hr 336 | Exit Function 337 | End If 338 | 339 | CallX64 = vRet 340 | 341 | End Function 342 | 343 | ' // 344 | ' // Get procedure arrdess from 64 bit dll 345 | ' // 346 | Public Function GetProcAddress64( _ 347 | ByVal h64Lib As Currency, _ 348 | ByRef sFunctionName As String) As Currency 349 | Dim lRvaNtHeaders As Long 350 | Dim tExportData As IMAGE_DATA_DIRECTORY 351 | Dim tExportDirectory As IMAGE_EXPORT_DIRECTORY 352 | Dim lIndex As Long 353 | Dim p64SymName As Currency 354 | Dim tasFunction As ANSI_STRING64 355 | Dim tasSymbol As ANSI_STRING64 356 | Dim sAnsiString As String 357 | Dim lOrdinal As Long 358 | Dim p64Address As Currency 359 | 360 | If h64Lib = 0 Then 361 | 362 | h64Lib = GetModuleHandle64(vbNullString) 363 | 364 | If h64Lib = 0 Then 365 | 366 | Err.Raise 5 367 | Exit Function 368 | 369 | End If 370 | 371 | End If 372 | 373 | sAnsiString = StrConv(sFunctionName, vbFromUnicode) 374 | 375 | GetMem4 StrPtr(sAnsiString), tasFunction.lpBuffer 376 | tasFunction.Length = LenB(sAnsiString) 377 | tasFunction.MaxLength = tasFunction.Length + 1 378 | 379 | ReadMem64 VarPtr(lRvaNtHeaders), h64Lib + 0.006@, Len(lRvaNtHeaders) 380 | ReadMem64 VarPtr(tExportData), h64Lib + lRvaNtHeaders / 10000 + 0.0136@, Len(tExportData) 381 | 382 | If tExportData.VirtualAddress = 0 Or tExportData.Size = 0 Then 383 | Err.Raise 453 384 | Exit Function 385 | End If 386 | 387 | ReadMem64 VarPtr(tExportDirectory), h64Lib + tExportData.VirtualAddress / 10000, Len(tExportDirectory) 388 | 389 | For lIndex = 0 To tExportDirectory.NumberOfNames - 1 390 | 391 | p64SymName = 0 392 | 393 | ReadMem64 VarPtr(p64SymName), (tExportDirectory.AddressOfNames + lIndex * 4) / 10000 + h64Lib, 4 394 | 395 | p64SymName = p64SymName + h64Lib 396 | 397 | tasSymbol.Length = StringLen64(p64SymName) * 10000 398 | tasSymbol.MaxLength = tasSymbol.Length 399 | tasSymbol.lpBuffer = p64SymName 400 | 401 | If CompareAnsiStrings64(tasFunction, tasSymbol, True) = 0 Then 402 | 403 | ReadMem64 VarPtr(lOrdinal), (tExportDirectory.AddressOfNameOrdinals + lIndex * 2) / 10000 + h64Lib, 2 404 | ReadMem64 VarPtr(p64Address), (tExportDirectory.AddressOfFunctions + lOrdinal * 4) / 10000 + h64Lib, 4 405 | 406 | GetProcAddress64 = p64Address + h64Lib 407 | 408 | Exit For 409 | 410 | End If 411 | 412 | Next 413 | 414 | End Function 415 | 416 | ' // 417 | ' // Get 64-bit lib handle 418 | ' // 419 | Public Property Get GetModuleHandle64( _ 420 | ByRef sLib As String) As Currency 421 | Dim tPBI64 As PROCESS_BASIC_INFORMATION64 422 | Dim lStatus As Long 423 | Dim p64LdrData As Currency 424 | Dim p64ListEntry As Currency 425 | Dim p64LdrEntry As Currency 426 | Dim p64DllName As Currency 427 | Dim tusDll As UNICODE_STRING64 428 | Dim tusLib As UNICODE_STRING64 429 | 430 | GetMem4 StrPtr(sLib), tusDll.lpBuffer ' // Address 431 | tusDll.Length = LenB(sLib) 432 | tusDll.MaxLength = tusDll.Length + 2 433 | 434 | ' // We need 64-bit PEB 435 | lStatus = NtWow64QueryInformationProcess64(-1, ProcessBasicInformation, tPBI64, Len(tPBI64), 0) 436 | 437 | If lStatus < 0 Then 438 | Err.Raise lStatus 439 | Exit Property 440 | End If 441 | 442 | ' // Read PEB.Ldr 443 | ReadMem64 VarPtr(p64LdrData), tPBI64.PebBaseAddress + 0.0024@, Len(p64LdrData) 444 | 445 | p64ListEntry = p64LdrData + 0.0016@ ' // PEB_LDR_DATA.InLoadOrderModuleList.Flink 446 | 447 | ' // *PEB_LDR_DATA.InLoadOrderModuleList.Flink 448 | ReadMem64 VarPtr(p64LdrEntry), p64ListEntry, Len(p64LdrEntry) 449 | 450 | Do 451 | 452 | p64DllName = p64LdrEntry + 0.0088@ ' // LDR_DATA_TABLE_ENTRY.BaseDllName 453 | 454 | If Len(sLib) = 0 Then 455 | 456 | ReadMem64 VarPtr(GetModuleHandle64), p64LdrEntry + 0.0048@, Len(GetModuleHandle64) 457 | Exit Do 458 | 459 | Else 460 | 461 | ReadMem64 VarPtr(tusLib), p64DllName, Len(tusLib) 462 | 463 | If CompareUnicodeStrings64(tusLib, tusDll) = 0 Then 464 | 465 | ReadMem64 VarPtr(GetModuleHandle64), p64LdrEntry + 0.0048@, Len(GetModuleHandle64) 466 | Exit Do 467 | 468 | End If 469 | 470 | End If 471 | 472 | ReadMem64 VarPtr(p64LdrEntry), p64LdrEntry, Len(p64LdrEntry) 473 | 474 | Loop Until p64ListEntry = p64LdrEntry 475 | 476 | End Property 477 | 478 | ' // Read memory at specified 64-bit address 479 | Public Sub ReadMem64( _ 480 | ByVal pTo As Long, _ 481 | ByVal p64From As Currency, _ 482 | ByVal lSize As Long) 483 | Dim lStatus As Long 484 | 485 | lStatus = NtWow64ReadVirtualMemory64(m_hCurHandle, p64From, ByVal pTo, lSize / 10000, 0) 486 | 487 | If lStatus < 0 Then 488 | Err.Raise lStatus 489 | Exit Sub 490 | End If 491 | 492 | End Sub 493 | 494 | ' // Get null-terminated string length 495 | Private Function StringLen64( _ 496 | ByVal p64 As Currency) As Currency 497 | Dim pAddrPair(1) As Long 498 | Dim bPage() As Byte 499 | Dim lSize As Long 500 | Dim lStatus As Long 501 | Dim lIndex As Long 502 | Dim p64Start As Currency 503 | 504 | p64Start = p64 505 | 506 | GetMem8 p64, pAddrPair(0) 507 | 508 | ' // Get number of bytes to end page boundry 509 | lSize = &H1000 - (pAddrPair(0) And &HFFF) 510 | 511 | Do 512 | 513 | ' // Read page 514 | ReDim Preserve bPage(lSize - 1) 515 | 516 | lStatus = NtWow64ReadVirtualMemory64(m_hCurHandle, p64, bPage(0), lSize / 10000, 0) 517 | 518 | If lStatus < 0 Then 519 | Err.Raise lStatus 520 | Exit Function 521 | End If 522 | 523 | For lIndex = 0 To lSize - 1 524 | 525 | ' // Test for null terminal 526 | If bPage(lIndex) = 0 Then 527 | 528 | StringLen64 = (p64 + lIndex / 10000) - p64Start 529 | Exit Do 530 | 531 | End If 532 | 533 | Next 534 | 535 | ' // Next page 536 | p64 = p64 + lSize / 10000 537 | 538 | lSize = 4096 539 | 540 | Loop While True 541 | 542 | End Function 543 | 544 | ' // Compare 2 ANSI strings 545 | Private Function CompareAnsiStrings64( _ 546 | ByRef tasStr1 As ANSI_STRING64, _ 547 | ByRef tasStr2 As ANSI_STRING64, _ 548 | Optional ByVal bCaseSensitive As Boolean) As Long 549 | Dim bBuf1() As Byte 550 | Dim bBuf2() As Byte 551 | 552 | If tasStr1.Length > 0 Then 553 | 554 | ReDim bBuf1(tasStr1.Length) 555 | ReadMem64 VarPtr(bBuf1(0)), tasStr1.lpBuffer, tasStr1.Length 556 | 557 | End If 558 | 559 | If tasStr2.Length > 0 Then 560 | 561 | ReDim bBuf2(tasStr2.Length) 562 | ReadMem64 VarPtr(bBuf2(0)), tasStr2.lpBuffer, tasStr2.Length 563 | 564 | End If 565 | 566 | If bCaseSensitive Then 567 | CompareAnsiStrings64 = lstrcmp(bBuf1(0), bBuf2(0)) 568 | Else 569 | CompareAnsiStrings64 = lstrcmpi(bBuf1(0), bBuf2(0)) 570 | End If 571 | 572 | End Function 573 | 574 | ' // Compare 2 strings 575 | Private Function CompareUnicodeStrings64( _ 576 | ByRef tusStr1 As UNICODE_STRING64, _ 577 | ByRef tusStr2 As UNICODE_STRING64, _ 578 | Optional ByVal bCaseSensitive As Boolean) As Long 579 | Dim bBuf1() As Byte 580 | Dim bBuf2() As Byte 581 | 582 | If tusStr1.Length > 0 Then 583 | 584 | ReDim bBuf1(tusStr1.Length - 1) 585 | ReadMem64 VarPtr(bBuf1(0)), tusStr1.lpBuffer, tusStr1.Length 586 | 587 | End If 588 | 589 | If tusStr2.Length > 0 Then 590 | 591 | ReDim bBuf2(tusStr2.Length - 1) 592 | ReadMem64 VarPtr(bBuf2(0)), tusStr2.lpBuffer, tusStr2.Length 593 | 594 | End If 595 | 596 | If bCaseSensitive Then 597 | CompareUnicodeStrings64 = StrComp(bBuf1, bBuf2, vbBinaryCompare) 598 | Else 599 | CompareUnicodeStrings64 = StrComp(bBuf1, bBuf2, vbTextCompare) 600 | End If 601 | 602 | End Function 603 | 604 | --------------------------------------------------------------------------------