using VbTrickThreading-master examples without the typelibs for Callback and Marshal

**smkperu** · Dec 28th, 2022, 06:03 AM

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

**The trick** · Dec 28th, 2022, 08:01 AM

Originally Posted by smkperu

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);

Thanks

It's VB6-Form interface.

**smkperu** · Dec 28th, 2022, 08:54 AM

Originally Posted by The trick

It's VB6-Form interface.

Hello Trick,

If we had used two different forms say frmThread1 and frmThread2 in CallbackThread how are they distinguised.

Thanks

**The trick** · Dec 28th, 2022, 10:06 AM

Originally Posted by smkperu

Hello Trick,

If we had used two different forms say frmThread1 and frmThread2 in CallbackThread how are they distinguised.

Thanks

You could use Implement keyword for example.

**smkperu** · Dec 28th, 2022, 10:23 AM

Originally Posted by The trick

You could use Implement keyword for example.

Hello Trick,

1. Can you show me how to do this for more than one form in CallbackThread vb6 dll and access in C based exe.

2. How to do this for vb6 Classes in addition to forms.

Thanks

**smkperu** · Dec 29th, 2022, 11:55 AM

Originally Posted by The trick

It's VB6-Form interface.

Hello Trick,

Now I understood that using Guid method of InterfaceInfo object created InterfaceInfoFromObject we get guid of class or form from Typelib Information.

Like you have done in CallbackThread project can you provide a simple example of how to access a vb6 form/Class method from c application using vtbl.

Thanks

**smkperu** · Dec 31st, 2022, 10:46 AM

Hello Trick,

I understood that by sending IUnknown pointer of vb6 class object I was able to access it in c application using its lpvtbl.

Thanks

**smkperu** · Dec 31st, 2022, 10:50 AM

Hello Trick,

I am unable to send PM as your inbox is full.Please clear some messages.

Thanks

**smkperu** · Feb 15th, 2023, 05:31 AM

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 Trick,

The e_lfanew is last field of IMAGE_DOS_HEADER structure.

How is the offset of &H3C calculated in the SearchForVbHeader in modDllInitialize module in the following code:

Code:

 ' // Get e_lfanew
    VBDll.GetMem4 ByVal hInstance + &H3C, ptr

In a similar way how is &H80 calculated in the following code.

Code:

  ' // Get IAT
    VBDll.GetMem4 ByVal ptr + &H80 + hInstance, pImportDesc

Thanks

**smkperu** · Apr 7th, 2023, 05:08 AM

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 Trick,

How to call a third party vb6 standard dll exported function using Declare statement
or LoadLibrary/GetProcAddress in a vb6 standard exe.Here I cannot make the following code from modDllInitialize.bas of DllMain() run automatically in this third party dll since the dll is third party dll (ie., .dll without source code).

Code:

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

Thanks

**jsvenu** · Apr 8th, 2023, 05:51 AM

Originally Posted by smkperu

Hello Trick,

How to call a third party vb6 standard dll exported function using Declare statement
or LoadLibrary/GetProcAddress in a vb6 standard exe.Here I cannot make the following code from modDllInitialize.bas of DllMain() run automatically in this third party dll since the dll is third party dll (ie., .dll without source code).

Code:

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

Thanks

Dear smkperu,

The following is the code which you have to use to call any exported function of your 3rd party standard dll without restrictions in your vb6 standard exe.

Code:

Dim tClsId      As tCurGUID
Dim tIID        As tCurGUID
Dim  dllhinstance   As long
Dim vbhdr as long

    dllhinstance = LoadLibrary("full path of third party dll") 
        
    vbhdr = SearchForVbHeader(dllhinstance) 'getvbheader
   
    'get IID_IUnknown
    tIID.c2 = 504403158265495.5712@
    
    ' init runtime
    VBDll.VBDllGetClassObject dllhinstance , 0, vbhdr , tClsId, tIID, 0 

    'call any exported function of the third party dll which  you have already declared using Declare statement.

regards,

JSVenu

**smkperu** · Apr 9th, 2023, 10:27 PM

Originally Posted by jsvenu

Dear smkperu,

The following is the code which you have to use to call any exported function of your 3rd party standard dll without restrictions in your vb6 standard exe.

Code:

Dim tClsId      As tCurGUID
Dim tIID        As tCurGUID
Dim  dllhinstance   As long
Dim vbhdr as long

    dllhinstance = LoadLibrary("full path of third party dll") 
        
    vbhdr = SearchForVbHeader(dllhinstance) 'getvbheader
   
    'get IID_IUnknown
    tIID.c2 = 504403158265495.5712@
    
    ' init runtime
    VBDll.VBDllGetClassObject dllhinstance , 0, vbhdr , tClsId, tIID, 0 

    'call any exported function of the third party dll which  you have already declared using Declare statement.

regards,

JSVenu

Hello JSVenu,

Thanks for the working code.

Thanks

Thread: using VbTrickThreading-master examples without the typelibs for Callback and Marshal

Thread Tools

Display

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Re: using VbTrickThreading-master examples without the typelibs for Callback and Mar

Posting Permissions