Модуль для создания нативных DLL в VB6

[The trick]

Модуль позволяет создавать нативные DLL в VB6 из проектов типа Standard EXE.

Архив содержит модуль и несколько примеров использования на языках (VB6, C, PureBasic):

• Simple - показ сообщения из DLL;
• ShowForm - показ формы из DLL;
• CallbackThread - создание потока в DLL и вызов колбека из этого потока в EXE (используется модуль VbTrickThreading).

Пример использования DLL из C:

Код: Выделить всё

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

}

Из PureBasic:

Код: Выделить всё

IncludeFile "interfaces.pbi"

Prototype.l CallbackProto(pObj.IUnknown)
Prototype.l SetCallback(CallbackProto_)

Procedure Callback(pObj.IUnknown)
  pFrm._Form
  fWidth.f
  fHeight.f
 
  If pObj\QueryInterface(?IID__Form, @pFrm) = #S_OK

    If pFrm\get_ScaleWidth(@fWidth.f) = #S_OK And pFrm\get_ScaleHeight(@fHeight.f) = #S_OK
      pFrm\Circle(0, Mod(Random(100000), fWidth), Mod(Random(100000), fWidth), Mod(Random(100000), 500), 0, 0, 0, 0)
    EndIf
   
    pFrm\Release()
   
  EndIf
 
EndProcedure

; Load dll
If OpenLibrary(0, "CallbackThread.dll")
 
  ; Get proc address
  SetCallback.SetCallback = GetFunction(0, "SetCallback")

  If SetCallback
   
    ; Call exported function
    SetCallback(@Callback())

  EndIf
 
  OpenConsole()
  PrintN("Press enter to close program")
  Input()
 
EndIf