Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Модуль для создания нативных DLL в VB6 из проектов типа Standard EXE. / 1 сообщений из 1, страница 1 из 1
12.01.2020, 17:41
    #39913004
ATM-TURBO 2
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Модуль для создания нативных DLL в VB6 из проектов типа Standard EXE.
Архив содержит модуль и несколько примеров использования на языках (VB6, C, PureBasic):

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

[LIST]
[*] Simple - показ сообщения из DLL;
[*] ShowForm - показ формы из DLL;
[*] CallbackThread - создание потока в DLL и вызов колбека из этого потока в EXE (используется модуль " http://www.cyberforum.ru/blogs/354370/blog5296.html%22%5DVbTrickThreading]http://www.cyberforum.ru/blogs/354370/blog5296.html"]VbTrickThreading ).
[/LIST]

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

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
#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:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
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



https://yadi.sk/d/1vI4ZbGwJfhLvQ
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Модуль для создания нативных DLL в VB6 из проектов типа Standard EXE. / 1 сообщений из 1, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]