|
-
Dec 28th, 2022, 06:03 AM
#6
Addicted Member
Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar
 Originally Posted by The trick
You can't use an arbitrary code if you don't initialize the DLL-project-context, particularly the API calls declared in VB6.
The proper way is to call DLLGetClassObject and then to call the exported functions when you use the ActiveX Dll project type.
I had the thoughts to make the module which add the ability to initialize a context in DLL created as Standard EXE but there are some pitfalls like when you receive DLL_PROCESS_DETACH how you uninitialize the projects-context created in the other threads.
The attached archive contains the module and several examples of usage in 3 different languages (VB6, C, PureBasic):
- Simple - just show message box in DLL;
- ShowForm - show the Form from DLL;
- CallbackThread - create a thread in DLL and then call the callback function in EXE.
Because of the code module is quite raw one i don't publish it in the CodeBank:
Code:
' //
' // modDllInitialize.bas - The module provides support for runtime-initization for dynamic link libraries
' // Version 2
' // © Krivous Anatoly Anatolevich (The trick), 2015-2020
' // If you want to use additional callback from DllMain use DLL_USE_DLLMAIN conditional compilation adrgument
' // with the DllEntry callback function
' //
Option Explicit
Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const FADF_AUTO As Long = 1
Private Const VB_MAGIC As Long = &H21354256
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const HEAP_NO_SERIALIZE As Long = &H1
Private Const TLS_OUT_OF_INDEXES As Long = &HFFFF&
' // Lazy GUID structure
Private Type tCurGUID
c1 As Currency
c2 As Currency
End Type
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds As SAFEARRAYBOUND
End Type
Private Type tVBHeaderString
pNames(3) As Long
End Type
Private Const DLL_PROCESS_ATTACH As Long = 1
Private Const DLL_PROCESS_DETACH As Long = 0
Private Const DLL_THREAD_ATTACH As Long = 2
Private Const DLL_THREAD_DETACH As Long = 3
Private mlTlsSlot As Long ' // Index of the item in the TLS. There will be data specific to the thread.
Private mpVbHeader As Long ' // Pointer to VBHeader structure.
Private mhInstance As Long ' // Base address of the module
' // Unused
Private Sub Main()
End Sub
' // This function is called when the module is being loaded/unloaded to a process or a thread is created/destroyed
Public Function DllMain( _
ByVal hinstDLL As Long, _
ByVal fdwReason As Long, _
ByVal lpvReserved As Long) As Long
Select Case fdwReason
Case DLL_PROCESS_ATTACH
If VBDll.UserDllMain(mhInstance, 0, hinstDLL, fdwReason, lpvReserved) = 0 Then
GoTo CleanUp
End If
mlTlsSlot = VBDll.TlsAlloc()
If mlTlsSlot = TLS_OUT_OF_INDEXES Then GoTo CleanUp
DllMain = InitializeRuntimeForProject(hinstDLL, True) And 1
#If DLL_USE_DLLMAIN Then
If DllMain Then
DllMain = DllEntry(hinstDLL, fdwReason, lpvReserved)
End If
#End If
Case DLL_THREAD_ATTACH
If VBDll.UserDllMain(mhInstance, 0, hinstDLL, fdwReason, lpvReserved) = 0 Then
GoTo CleanUp
End If
DllMain = InitializeRuntimeForProject(hinstDLL, False) And 1
#If DLL_USE_DLLMAIN Then
If DllMain Then
DllMain = DllEntry(hinstDLL, fdwReason, lpvReserved)
End If
#End If
Case DLL_THREAD_DETACH
#If DLL_USE_DLLMAIN Then
DllEntry hinstDLL, fdwReason, lpvReserved
#End If
If VBDll.UserDllMain(mhInstance, 0, hinstDLL, fdwReason, lpvReserved) = 0 Then
GoTo CleanUp
End If
UninitializeRuntimeForProject hinstDLL
FreeHeaderForCurrentThread
DllMain = 1
Case DLL_PROCESS_DETACH
#If DLL_USE_DLLMAIN Then
DllEntry hinstDLL, fdwReason, lpvReserved
#End If
CanUnloadNowCall
VBDll.UserDllMain mhInstance, 0, hinstDLL, fdwReason, lpvReserved
FreeHeaderForCurrentThread
VBDll.TlsFree mlTlsSlot
mlTlsSlot = 0
mpVbHeader = 0
DllMain = 1
Exit Function
End Select
CleanUp:
End Function
' // Uninitialize the runime
Public Function UninitializeRuntimeForProject( _
ByVal hInstance As Long) As Boolean
Dim pNewHeader As Long
' // Check if the module is initialized
pNewHeader = VBDll.TlsGetValue(mlTlsSlot)
If pNewHeader = 0 Then Exit Function
VBDll.CoUninitialize
UninitializeRuntimeForProject = True
End Function
' // Free the current header
Public Function FreeHeaderForCurrentThread() As Boolean
Dim pNewHeader As Long
' // Check if the module is initialized
pNewHeader = VBDll.TlsGetValue(mlTlsSlot)
If pNewHeader = 0 Then Exit Function
VBDll.HeapFree VBDll.GetProcessHeap(), 0, pNewHeader
End Function
' // Initilaize the runtime
Public Function InitializeRuntimeForProject( _
ByVal hInstance As Long, _
ByVal bIsFirst As Boolean) As Boolean
Dim pNewHeader As Long
Dim tClsId As tCurGUID
Dim tIID As tCurGUID
Dim lUnused As Long
pNewHeader = VBDll.TlsGetValue(mlTlsSlot)
' // Check if the module already initialized
If pNewHeader Then
InitializeRuntimeForProject = True
Exit Function
End If
VBDll.CoInitialize ByVal 0&
If mpVbHeader = 0 Then
' // Search for VBHeader (EXEPROJECTINFO)
mpVbHeader = SearchForVbHeader(hInstance)
If mpVbHeader = 0 Then Exit Function
' // Modify header
ModifyVBHeader
End If
' // Create the new copy of headers for new instance
pNewHeader = CreateVBHeaderCopy()
' // Save it
VBDll.TlsSetValue mlTlsSlot, ByVal pNewHeader
If pNewHeader = 0 Then
Exit Function
End If
' // IID_IUnknown
tIID.c2 = 504403158265495.5712@
' // Call CThreadPool::InitDllAccess
VBDll.VBDllGetClassObject hInstance, 0, pNewHeader, tClsId, tIID, 0
If bIsFirst Then
' // Initialize App object
lUnused = App.ThreadID
End If
InitializeRuntimeForProject = True
End Function
Private Sub CanUnloadNowCall()
Dim pNewHeader As Long
Dim bThreading As Byte
' // Check if the module is initialized
pNewHeader = VBDll.TlsGetValue(mlTlsSlot)
If pNewHeader = 0 Then Exit Sub
' // To ensure cleaning of the project data set the threading model to the apartment one.
VBDll.GetMem1 ByVal pNewHeader + &H3C, bThreading
bThreading = bThreading Or 1
VBDll.GetMem1 bThreading, ByVal pNewHeader + &H3C
' // The runtime will call CThreadPool::CheckForProjectUnload and CVBThreadAction::CleanupProjData
If VBDll.VBDllCanUnloadNow(pNewHeader) Then
Exit Sub
End If
End Sub
' // Search for VBHeader(EXEPROJECTINFO)
Private Function SearchForVbHeader( _
ByVal hInstance As Long) As Long
Dim ptr As Long
Dim lSignature As Long
Dim pImportDesc As Long
Dim pStartSearch As Long
Dim pEndSearch As Long
Dim bData() As Byte
Dim tArrDesc As SAFEARRAY
Dim lIndex As Long
' // VBHeader is placed within the end of IAT and beginning of IMAGE_IMPORT_DESCRIPTOR
' // Get e_lfanew
VBDll.GetMem4 ByVal hInstance + &H3C, ptr
' // Get IAT
VBDll.GetMem4 ByVal ptr + &H80 + hInstance, pImportDesc
pEndSearch = hInstance + pImportDesc - 4
Do
' // Get IMAGE_IMPORT_DESCRIPTOR.FirstThunk
VBDll.GetMem4 ByVal pImportDesc + &H10 + hInstance, ptr
If ptr > pStartSearch Then
pStartSearch = ptr
End If
pImportDesc = pImportDesc + &H14
Loop While ptr
' // Search for null-thunk (skip valid IAT entries)
Do
VBDll.GetMem4 ByVal hInstance + pStartSearch, ptr
pStartSearch = pStartSearch + 4
Loop While ptr
pStartSearch = pStartSearch + hInstance
If pEndSearch < pStartSearch Then Exit Function
' // Map the array to the data
tArrDesc.cbElements = 1
tArrDesc.cDims = 1
tArrDesc.fFeatures = FADF_AUTO
tArrDesc.pvData = pStartSearch
tArrDesc.Bounds.cElements = pEndSearch - pStartSearch + 5
VBDll.MoveArray bData(), VarPtr(tArrDesc)
For lIndex = 0 To tArrDesc.Bounds.cElements - 5
' // __vbaS of an exe module has the following structure:
' // PUSH OFFSET VbHeader
' // CALL ThunRTMain
' // Search for PUSH IMM opcode
If bData(lIndex) = &H68 Then
' // Get Immediate value
VBDll.GetMem4 bData(lIndex + 1), ptr
' // Check range
If ptr >= pStartSearch And ptr < pEndSearch Then
' // Check signature (VB5!)
VBDll.GetMem4 ByVal ptr, lSignature
If lSignature = VB_MAGIC Then
SearchForVbHeader = ptr
Exit Function
End If
End If
End If
Next
End Function
' // Modify VBHeader to replace Sub Main
Private Sub ModifyVBHeader()
Dim ptr As Long
Dim lOldProtect As Long
Dim lFlags As Long
Dim lFormsCount As Long
Dim lModulesCount As Long
Dim lStructSize As Long
' // Allow to write to that page
VBDll.VirtualProtect ByVal mpVbHeader, &H64, PAGE_EXECUTE_READWRITE, lOldProtect
' // Remove Sub Main
ptr = mpVbHeader + &H2C
VBDll.GetMem4 0&, ByVal ptr
VBDll.VirtualProtect ByVal mpVbHeader, &H64, lOldProtect, 0
' // Remove startup form
VBDll.GetMem4 ByVal mpVbHeader + &H4C, ptr
' // Get number of forms
VBDll.GetMem2 ByVal mpVbHeader + &H44, lFormsCount
Do While lFormsCount > 0
' // Get structure size
VBDll.GetMem4 ByVal ptr, lStructSize
' // Get flag (unknown5) from current form
VBDll.GetMem4 ByVal ptr + &H28, lFlags
' // When set, bit 5,
If lFlags And &H10 Then
' // Unset bit 5
lFlags = lFlags And &HFFFFFFEF
' // Are allowed to write in the page
VBDll.VirtualProtect ByVal ptr, 4, PAGE_EXECUTE_READWRITE, lOldProtect
' // Write changet lFlags
VBDll.GetMem4 lFlags, ByVal ptr + &H28
' // Restoring the memory attributes
VBDll.VirtualProtect ByVal ptr, 4, lOldProtect, 0
End If
lFormsCount = lFormsCount - 1
ptr = ptr + lStructSize
Loop
End Sub
' // Create copy of VBHeader and other structures
Private Function CreateVBHeaderCopy() As Long
Dim pHeader As Long
Dim pOldProjInfo As Long
Dim pProjInfo As Long
Dim pObjTable As Long
Dim pOldObjTable As Long
Dim lDifference As Long
Dim lIndex As Long
Dim lSubIndex As Long
Dim tNames As tVBHeaderString
Dim lModulesCount As Long
Dim pDescriptors As Long
Dim pOldDesc As Long
Dim pVarBlock As Long
Dim lSizeOfHeaders As Long
Dim lExtCount As Long
Dim lNewExtCount As Long
Dim pOldExtApi As Long
Dim pExtApi As Long
Dim lExtFlags As Long
' // Get size of all headers
lSizeOfHeaders = &H6A + &H23C + &H54 + &HC
VBDll.GetMem4 ByVal mpVbHeader + &H30, pOldProjInfo
VBDll.GetMem4 ByVal pOldProjInfo + &H4, pOldObjTable
VBDll.GetMem4 ByVal pOldObjTable + &H30, pOldDesc
VBDll.GetMem2 ByVal pOldObjTable + &H2A, lModulesCount
lSizeOfHeaders = lSizeOfHeaders + &H30 * lModulesCount
' // Free API external block
VBDll.GetMem4 ByVal pOldProjInfo + &H238, lExtCount
VBDll.GetMem4 ByVal pOldProjInfo + &H234, pOldExtApi
For lIndex = 0 To lExtCount - 1
VBDll.GetMem4 ByVal pOldExtApi + lIndex * 8, lExtFlags
If lExtFlags <> 7 Then
lNewExtCount = lNewExtCount + 1
End If
Next
lSizeOfHeaders = lSizeOfHeaders + lNewExtCount * 8
' // Allocate memory for header
pHeader = VBDll.HeapAlloc(VBDll.GetProcessHeap(), HEAP_ZERO_MEMORY, lSizeOfHeaders)
If pHeader = 0 Then GoTo CleanUp
lDifference = pHeader - mpVbHeader
VBDll.CopyMemory ByVal pHeader, ByVal mpVbHeader, &H6A
' // Update strings offsets
VBDll.CopyMemory tNames.pNames(0), ByVal mpVbHeader + &H58, &H10
For lIndex = 0 To 3
tNames.pNames(lIndex) = tNames.pNames(lIndex) - lDifference
Next
VBDll.CopyMemory ByVal pHeader + &H58, tNames.pNames(0), &H10
' // In order to keep global variables
' // Change the VbPublicObjectDescriptor.lpPublicBytes, VbPublicObjectDescriptor.lpStaticBytes
pProjInfo = pHeader + &H6A
VBDll.CopyMemory ByVal pProjInfo, ByVal pOldProjInfo, &H23C
' // Update on VBHeader
VBDll.GetMem4 pProjInfo, ByVal pHeader + &H30
' // Create copy of Object table
pObjTable = pProjInfo + &H23C
VBDll.CopyMemory ByVal pObjTable, ByVal pOldObjTable, &H54
' // Update
VBDll.GetMem4 pObjTable, ByVal pProjInfo + &H4
' // Allocate descriptors
pDescriptors = pObjTable + &H54
VBDll.CopyMemory ByVal pDescriptors, ByVal pOldDesc, lModulesCount * &H30
' // Update
VBDll.GetMem4 pDescriptors, ByVal pObjTable + &H30
' // Allocate variables block
pVarBlock = pDescriptors + lModulesCount * &H30
For lIndex = 0 To lModulesCount - 1
' // Zero number of public and local variables
VBDll.GetMem4 pVarBlock, ByVal pDescriptors + lIndex * &H30 + &H8
VBDll.GetMem4 0&, ByVal pDescriptors + lIndex * &H30 + &HC
Next
' // Free API
pExtApi = pVarBlock + &HC
lSubIndex = 0
For lIndex = 0 To lExtCount - 1
VBDll.GetMem4 ByVal pOldExtApi + lIndex * 8, lExtFlags
If lExtFlags <> 7 Then
VBDll.GetMem8 ByVal pOldExtApi + lIndex * 8, ByVal pExtApi + lSubIndex * 8
lSubIndex = lSubIndex + 1
End If
Next
' // Update
VBDll.GetMem4 pExtApi, ByVal pProjInfo + &H234
VBDll.GetMem4 lNewExtCount, ByVal pProjInfo + &H238
CreateVBHeaderCopy = pHeader
CleanUp:
End Function
Usage in C:
Code:
#include <windows.h>
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <initguid.h>
#include "interfaces.h"
volatile DWORD g_TlsSlot;
LONG __stdcall CallBack(IUnknown *pObj) {
HRESULT hr;
_Form *pForm;
float fWidth, fHeight;
if (FAILED(hr = pObj->lpVtbl->QueryInterface(pObj, &IID__Form, (void**)&pForm))) {
return E_UNEXPECTED;
}
// Check if already initialized
if (!TlsGetValue(g_TlsSlot)) {
TlsSetValue(g_TlsSlot, (LPVOID)1);
srand(time(NULL));
}
if (SUCCEEDED(hr = pForm->lpVtbl->get_ScaleWidth(pForm, &fWidth)) &&
SUCCEEDED(hr = pForm->lpVtbl->get_ScaleHeight(pForm, &fHeight))) {
hr = pForm->lpVtbl->Circle(pForm, 0, rand() % (int)fWidth, rand() % (int)fHeight, rand() % 500, 0, 0, 0, 0);
}
pForm->lpVtbl->Release(pForm);
return hr;
}
int main(int argc, char **argv) {
HINSTANCE hLib = LoadLibrary("CallbackThread.dll");
DWORD g_TlsSlot = TlsAlloc();
VOID (__stdcall *SetCallback)(LONG (__stdcall *)(IUnknown *)) =
(VOID (__stdcall *)(LONG (__stdcall *)(IUnknown *)))GetProcAddress(hLib, "SetCallback");
if (!SetCallback)
return 1;
SetCallback(CallBack);
printf("press a button to exit\r\n");
getchar();
FreeLibrary(hLib);
TlsFree(g_TlsSlot);
return 0;
}
Hello the trick,
1. How is the following GUID extracted in the interfaces.h file of C based exe project for the frmThread form of the CallbackThread standard dll project.
(0x33AD4F39, 0x6699, 0x11CF, 0xB7, 0x0C, 0x00, 0xAA, 0x00, 0x60, 0xD3, 0x93);
2. Is there any way to programmatically extract GUID of any resource like form or class
in CallBackThread project.
Thanks
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote