| 1 |
(* |
1 |
(* |
| 2 |
Copyright 2016, 2017 Anton Krotov |
2 |
BSD 2-Clause License |
| 3 |
|
- |
|
| 4 |
This program is free software: you can redistribute it and/or modify |
- |
|
| 5 |
it under the terms of the GNU Lesser General Public License as published by |
3 |
|
| 6 |
the Free Software Foundation, either version 3 of the License, or |
4 |
Copyright (c) 2018, 2019, Anton Krotov |
| 7 |
(at your option) any later version. |
- |
|
| 8 |
|
- |
|
| 9 |
This program is distributed in the hope that it will be useful, |
- |
|
| 10 |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
- |
|
| 11 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
- |
|
| 12 |
GNU Lesser General Public License for more details. |
- |
|
| 13 |
|
- |
|
| 14 |
You should have received a copy of the GNU Lesser General Public License |
- |
|
| 15 |
along with this program. If not, see . |
5 |
All rights reserved. |
| 16 |
*) |
6 |
*) |
| 17 |
|
7 |
|
| 18 |
MODULE API; |
8 |
MODULE API; |
| 19 |
|
9 |
|
| 20 |
IMPORT sys := SYSTEM; |
10 |
IMPORT SYSTEM; |
| 21 |
|
11 |
|
| 22 |
VAR |
12 |
VAR |
| 23 |
|
13 |
|
| 24 |
Alloc*: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER; |
14 |
eol*: ARRAY 3 OF CHAR; |
| - |
|
15 |
base*: INTEGER; |
| - |
|
16 |
|
| 25 |
Free*: PROCEDURE [winapi] (hMem: INTEGER): INTEGER; |
17 |
|
| 26 |
MessageBoxA*: PROCEDURE [winapi] (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
- |
|
| 27 |
ExitProcess*: PROCEDURE [winapi] (code: INTEGER); |
18 |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); |
| 28 |
ExitThread*: PROCEDURE [winapi] (code: INTEGER); |
19 |
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); |
| 29 |
GetCurrentThreadId*: PROCEDURE [winapi] (): INTEGER; |
20 |
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER; |
| 30 |
strncmp*: PROCEDURE [cdecl] (a, b, n: INTEGER): INTEGER; |
21 |
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: INTEGER): INTEGER; |
| 31 |
|
- |
|
| 32 |
GetProcAddress*: PROCEDURE [winapi] (hModule, name: INTEGER): INTEGER; |
- |
|
| 33 |
LoadLibraryA*: PROCEDURE [winapi] (name: INTEGER): INTEGER; |
- |
|
| 34 |
|
22 |
|
| 35 |
PROCEDURE zeromem*(size, adr: INTEGER); |
23 |
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| 36 |
END zeromem; |
24 |
|
| 37 |
|
25 |
|
| 38 |
PROCEDURE DebugMsg*(lpText, lpCaption: INTEGER); |
- |
|
| 39 |
BEGIN |
- |
|
| 40 |
MessageBoxA(0, lpText, lpCaption, 16) |
- |
|
| 41 |
END DebugMsg; |
- |
|
| 42 |
|
- |
|
| 43 |
PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER); |
- |
|
| 44 |
VAR H: INTEGER; |
- |
|
| 45 |
BEGIN |
26 |
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
| 46 |
H := GetProcAddress(hMOD, sys.ADR(name[0])); |
27 |
BEGIN |
| 47 |
ASSERT(H # 0); |
28 |
MessageBoxA(0, lpText, lpCaption, 16) |
| - |
|
29 |
END DebugMsg; |
| 48 |
sys.PUT(adr, H); |
30 |
|
| 49 |
END GetProc; |
31 |
|
| 50 |
|
32 |
PROCEDURE _NEW* (size: INTEGER): INTEGER; |
| - |
|
33 |
RETURN Alloc(64, size) |
| 51 |
PROCEDURE _NEW*(size: INTEGER): INTEGER; |
34 |
END _NEW; |
| 52 |
RETURN Alloc(64, size) |
- |
|
| 53 |
END _NEW; |
35 |
|
| 54 |
|
36 |
|
| 55 |
PROCEDURE _DISPOSE*(p: INTEGER): INTEGER; |
37 |
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; |
| - |
|
38 |
RETURN Free(p) |
| 56 |
RETURN Free(p) |
- |
|
| 57 |
END _DISPOSE; |
- |
|
| 58 |
|
- |
|
| 59 |
PROCEDURE init* (esp: INTEGER); |
- |
|
| 60 |
VAR lib: INTEGER; |
- |
|
| 61 |
BEGIN |
- |
|
| - |
|
39 |
END _DISPOSE; |
| - |
|
40 |
|
| 62 |
sys.GET(esp, GetProcAddress); |
41 |
|
| - |
|
42 |
PROCEDURE init* (reserved, code: INTEGER); |
| - |
|
43 |
BEGIN |
| - |
|
44 |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| 63 |
sys.GET(esp + 4, LoadLibraryA); |
45 |
base := code - 4096 |
| - |
|
46 |
END init; |
| - |
|
47 |
|
| - |
|
48 |
|
| 64 |
|
- |
|
| 65 |
lib := LoadLibraryA(sys.ADR("kernel32.dll")); |
- |
|
| 66 |
GetProc("ExitProcess", lib, sys.ADR(ExitProcess)); |
- |
|
| 67 |
GetProc("ExitThread", lib, sys.ADR(ExitThread)); |
- |
|
| 68 |
GetProc("GetCurrentThreadId", lib, sys.ADR(GetCurrentThreadId)); |
49 |
PROCEDURE exit* (code: INTEGER); |
| - |
|
50 |
BEGIN |
| 69 |
GetProc("GlobalAlloc", lib, sys.ADR(Alloc)); |
51 |
ExitProcess(code) |
| 70 |
GetProc("GlobalFree", lib, sys.ADR(Free)); |
52 |
END exit; |
| 71 |
|
53 |
|
| 72 |
lib := LoadLibraryA(sys.ADR("msvcrt.dll")); |
54 |
|
| 73 |
GetProc("strncmp", lib, sys.ADR(strncmp)); |
55 |
PROCEDURE exit_thread* (code: INTEGER); |
| 74 |
|
56 |
BEGIN |
| 75 |
lib := LoadLibraryA(sys.ADR("user32.dll")); |
57 |
ExitThread(code) |
| 76 |
GetProc("MessageBoxA", lib, sys.ADR(MessageBoxA)); |
58 |
END exit_thread; |
| 77 |
END init; |
59 |
|
| 78 |
|
60 |
|
| 79 |
END API. |
61 |
END API. |