2020-05-25 22:48:33 +02:00
|
|
|
(*
|
2019-03-11 09:59:55 +01:00
|
|
|
BSD 2-Clause License
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
Copyright (c) 2018-2020, Anton Krotov
|
2019-03-11 09:59:55 +01:00
|
|
|
All rights reserved.
|
2016-10-24 01:30:27 +02:00
|
|
|
*)
|
|
|
|
|
|
|
|
MODULE API;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
IMPORT SYSTEM;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
2019-10-06 19:55:12 +02:00
|
|
|
|
|
|
|
CONST
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
eol* = 0DX + 0AX;
|
|
|
|
|
2019-10-06 19:55:12 +02:00
|
|
|
SectionAlignment = 1000H;
|
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
DLL_PROCESS_ATTACH = 1;
|
|
|
|
DLL_THREAD_ATTACH = 2;
|
|
|
|
DLL_THREAD_DETACH = 3;
|
|
|
|
DLL_PROCESS_DETACH = 0;
|
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
KERNEL = "kernel32.dll";
|
|
|
|
USER = "user32.dll";
|
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
|
|
|
|
TYPE
|
|
|
|
|
|
|
|
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
|
|
|
|
|
2019-10-06 19:55:12 +02:00
|
|
|
|
2016-10-24 01:30:27 +02:00
|
|
|
VAR
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
base*: INTEGER;
|
2019-09-26 22:23:06 +02:00
|
|
|
heap: INTEGER;
|
2019-03-11 09:59:55 +01:00
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
process_detach,
|
|
|
|
thread_detach,
|
|
|
|
thread_attach: DLL_ENTRY;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
|
2020-10-13 09:58:51 +02:00
|
|
|
PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER);
|
|
|
|
PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER);
|
|
|
|
PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER;
|
|
|
|
PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
|
|
|
|
PROCEDURE [windows-, KERNEL, ""] HeapFree (hHeap, dwFlags, lpMem: INTEGER);
|
|
|
|
PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2019-03-11 09:59:55 +01:00
|
|
|
MessageBoxA(0, lpText, lpCaption, 16)
|
2016-10-24 01:30:27 +02:00
|
|
|
END DebugMsg;
|
|
|
|
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
PROCEDURE _NEW* (size: INTEGER): INTEGER;
|
2019-09-26 22:23:06 +02:00
|
|
|
RETURN HeapAlloc(heap, 8, size)
|
2016-10-24 01:30:27 +02:00
|
|
|
END _NEW;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
|
|
|
|
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
|
2019-09-26 22:23:06 +02:00
|
|
|
BEGIN
|
|
|
|
HeapFree(heap, 0, p)
|
|
|
|
RETURN 0
|
2016-10-24 01:30:27 +02:00
|
|
|
END _DISPOSE;
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
|
|
|
|
PROCEDURE init* (reserved, code: INTEGER);
|
2016-10-24 01:30:27 +02:00
|
|
|
BEGIN
|
2020-05-25 22:48:33 +02:00
|
|
|
process_detach := NIL;
|
|
|
|
thread_detach := NIL;
|
|
|
|
thread_attach := NIL;
|
2019-10-06 19:55:12 +02:00
|
|
|
base := code - SectionAlignment;
|
2019-09-26 22:23:06 +02:00
|
|
|
heap := GetProcessHeap()
|
2019-03-11 09:59:55 +01:00
|
|
|
END init;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
|
2019-03-11 09:59:55 +01:00
|
|
|
PROCEDURE exit* (code: INTEGER);
|
|
|
|
BEGIN
|
|
|
|
ExitProcess(code)
|
|
|
|
END exit;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE exit_thread* (code: INTEGER);
|
|
|
|
BEGIN
|
|
|
|
ExitThread(code)
|
|
|
|
END exit_thread;
|
2016-10-24 01:30:27 +02:00
|
|
|
|
|
|
|
|
2020-05-25 22:48:33 +02:00
|
|
|
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
|
|
|
|
VAR
|
|
|
|
res: INTEGER;
|
|
|
|
|
|
|
|
BEGIN
|
|
|
|
res := 0;
|
|
|
|
|
|
|
|
CASE fdwReason OF
|
|
|
|
|DLL_PROCESS_ATTACH:
|
|
|
|
res := 1
|
|
|
|
|DLL_THREAD_ATTACH:
|
|
|
|
IF thread_attach # NIL THEN
|
|
|
|
thread_attach(hinstDLL, fdwReason, lpvReserved)
|
|
|
|
END
|
|
|
|
|DLL_THREAD_DETACH:
|
|
|
|
IF thread_detach # NIL THEN
|
|
|
|
thread_detach(hinstDLL, fdwReason, lpvReserved)
|
|
|
|
END
|
|
|
|
|DLL_PROCESS_DETACH:
|
|
|
|
IF process_detach # NIL THEN
|
|
|
|
process_detach(hinstDLL, fdwReason, lpvReserved)
|
|
|
|
END
|
|
|
|
ELSE
|
|
|
|
END
|
|
|
|
|
|
|
|
RETURN res
|
|
|
|
END dllentry;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE sofinit*;
|
|
|
|
END sofinit;
|
|
|
|
|
|
|
|
|
|
|
|
PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY);
|
|
|
|
BEGIN
|
|
|
|
process_detach := _process_detach;
|
|
|
|
thread_detach := _thread_detach;
|
|
|
|
thread_attach := _thread_attach
|
|
|
|
END SetDll;
|
|
|
|
|
|
|
|
|
|
|
|
END API.
|