WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Lib/Windows32/API.ob07


﻿(*
    Copyright 2016, 2017 Anton Krotov
 
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Lesser General Public License for more details.
 
    You should have received a copy of the GNU Lesser General Public License
    along with this program.  If not, see .
*)
 
MODULE API;
 
IMPORT sys := SYSTEM;
 
VAR
 
  Alloc*: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER;
  Free*: PROCEDURE [winapi] (hMem: INTEGER): INTEGER;
  MessageBoxA*: PROCEDURE [winapi] (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
  ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
  ExitThread*: PROCEDURE [winapi] (code: INTEGER);
  GetCurrentThreadId*: PROCEDURE [winapi] (): INTEGER;
  strncmp*: PROCEDURE [cdecl] (a, b, n: INTEGER): INTEGER;
 
  GetProcAddress*: PROCEDURE [winapi] (hModule, name: INTEGER): INTEGER;
  LoadLibraryA*: PROCEDURE [winapi] (name: INTEGER): INTEGER;
 
PROCEDURE zeromem*(size, adr: INTEGER);
END zeromem;
 
PROCEDURE DebugMsg*(lpText, lpCaption: INTEGER);
BEGIN
  MessageBoxA(0, lpText, lpCaption, 16)
END DebugMsg;
 
PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER);
VAR H: INTEGER;
BEGIN
  H := GetProcAddress(hMOD, sys.ADR(name[0]));
  ASSERT(H # 0);
  sys.PUT(adr, H);
END GetProc;
 
PROCEDURE _NEW*(size: INTEGER): INTEGER;
  RETURN Alloc(64, size)
END _NEW;
 
PROCEDURE _DISPOSE*(p: INTEGER): INTEGER;
  RETURN Free(p)
END _DISPOSE;
 
PROCEDURE init* (esp: INTEGER);
VAR lib: INTEGER;
BEGIN
  sys.GET(esp, GetProcAddress);
  sys.GET(esp + 4, LoadLibraryA);
 
  lib := LoadLibraryA(sys.ADR("kernel32.dll"));
  GetProc("ExitProcess", lib, sys.ADR(ExitProcess));
  GetProc("ExitThread", lib, sys.ADR(ExitThread));
  GetProc("GetCurrentThreadId", lib, sys.ADR(GetCurrentThreadId));
  GetProc("GlobalAlloc", lib, sys.ADR(Alloc));
  GetProc("GlobalFree", lib, sys.ADR(Free));
 
  lib := LoadLibraryA(sys.ADR("msvcrt.dll"));
  GetProc("strncmp", lib, sys.ADR(strncmp));
 
  lib := LoadLibraryA(sys.ADR("user32.dll"));
  GetProc("MessageBoxA", lib, sys.ADR(MessageBoxA));
END init;
 
END API.

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

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/Windows32/API.ob07 @ 7597 – Rev 6613 → 7107