|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- S Y S T E M . W I N 3 2 --
|
|
|
6 -- --
|
|
|
7 -- S p e c --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2008-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 -- This package plus its child provide the low level interface to the Win32
|
|
|
33 -- API. The core part of the Win32 API (common to RTX and Win32) is in this
|
|
|
34 -- package, and an additional part of the Win32 API which is not supported by
|
|
|
35 -- RTX is in package System.Win32.Ext.
|
|
|
36
|
|
|
37 with Interfaces.C;
|
|
|
38
|
|
|
39 package System.Win32 is
|
|
|
40 pragma Pure;
|
|
|
41
|
|
|
42 -------------------
|
|
|
43 -- General Types --
|
|
|
44 -------------------
|
|
|
45
|
|
|
46 -- The LARGE_INTEGER type is actually a fixed point type
|
|
|
47 -- that only can represent integers. The reason for this is
|
|
|
48 -- easier conversion to Duration or other fixed point types.
|
|
|
49 -- (See System.OS_Primitives.Clock, mingw and rtx versions.)
|
|
|
50
|
|
|
51 type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0;
|
|
|
52
|
|
|
53 subtype PVOID is Address;
|
|
|
54
|
|
|
55 type HANDLE is new Interfaces.C.ptrdiff_t;
|
|
|
56
|
|
|
57 INVALID_HANDLE_VALUE : constant HANDLE := -1;
|
|
|
58 INVALID_FILE_SIZE : constant := 16#FFFFFFFF#;
|
|
|
59
|
|
|
60 type DWORD is new Interfaces.C.unsigned_long;
|
|
|
61 type WORD is new Interfaces.C.unsigned_short;
|
|
|
62 type BYTE is new Interfaces.C.unsigned_char;
|
|
|
63 type LONG is new Interfaces.C.long;
|
|
|
64 type CHAR is new Interfaces.C.char;
|
|
|
65
|
|
|
66 type BOOL is new Interfaces.C.int;
|
|
|
67 for BOOL'Size use Interfaces.C.int'Size;
|
|
|
68
|
|
|
69 type Bits1 is range 0 .. 2 ** 1 - 1;
|
|
|
70 type Bits2 is range 0 .. 2 ** 2 - 1;
|
|
|
71 type Bits17 is range 0 .. 2 ** 17 - 1;
|
|
|
72 for Bits1'Size use 1;
|
|
|
73 for Bits2'Size use 2;
|
|
|
74 for Bits17'Size use 17;
|
|
|
75
|
|
|
76 -- Note that the following clashes with standard names are to stay
|
|
|
77 -- compatible with the historical choice of following the C names.
|
|
|
78
|
|
|
79 pragma Warnings (Off);
|
|
|
80 FALSE : constant := 0;
|
|
|
81 TRUE : constant := 1;
|
|
|
82 pragma Warnings (On);
|
|
|
83
|
|
|
84 function GetLastError return DWORD;
|
|
|
85 pragma Import (Stdcall, GetLastError, "GetLastError");
|
|
|
86
|
|
|
87 -----------
|
|
|
88 -- Files --
|
|
|
89 -----------
|
|
|
90
|
|
|
91 CP_UTF8 : constant := 65001;
|
|
|
92 CP_ACP : constant := 0;
|
|
|
93
|
|
|
94 GENERIC_READ : constant := 16#80000000#;
|
|
|
95 GENERIC_WRITE : constant := 16#40000000#;
|
|
|
96
|
|
|
97 CREATE_NEW : constant := 1;
|
|
|
98 CREATE_ALWAYS : constant := 2;
|
|
|
99 OPEN_EXISTING : constant := 3;
|
|
|
100 OPEN_ALWAYS : constant := 4;
|
|
|
101 TRUNCATE_EXISTING : constant := 5;
|
|
|
102
|
|
|
103 FILE_SHARE_DELETE : constant := 16#00000004#;
|
|
|
104 FILE_SHARE_READ : constant := 16#00000001#;
|
|
|
105 FILE_SHARE_WRITE : constant := 16#00000002#;
|
|
|
106
|
|
|
107 FILE_BEGIN : constant := 0;
|
|
|
108 FILE_CURRENT : constant := 1;
|
|
|
109 FILE_END : constant := 2;
|
|
|
110
|
|
|
111 PAGE_NOACCESS : constant := 16#0001#;
|
|
|
112 PAGE_READONLY : constant := 16#0002#;
|
|
|
113 PAGE_READWRITE : constant := 16#0004#;
|
|
|
114 PAGE_WRITECOPY : constant := 16#0008#;
|
|
|
115 PAGE_EXECUTE : constant := 16#0010#;
|
|
|
116
|
|
|
117 FILE_MAP_ALL_ACCESS : constant := 16#F001f#;
|
|
|
118 FILE_MAP_READ : constant := 4;
|
|
|
119 FILE_MAP_WRITE : constant := 2;
|
|
|
120 FILE_MAP_COPY : constant := 1;
|
|
|
121
|
|
|
122 FILE_ADD_FILE : constant := 16#0002#;
|
|
|
123 FILE_ADD_SUBDIRECTORY : constant := 16#0004#;
|
|
|
124 FILE_APPEND_DATA : constant := 16#0004#;
|
|
|
125 FILE_CREATE_PIPE_INSTANCE : constant := 16#0004#;
|
|
|
126 FILE_DELETE_CHILD : constant := 16#0040#;
|
|
|
127 FILE_EXECUTE : constant := 16#0020#;
|
|
|
128 FILE_LIST_DIRECTORY : constant := 16#0001#;
|
|
|
129 FILE_READ_ATTRIBUTES : constant := 16#0080#;
|
|
|
130 FILE_READ_DATA : constant := 16#0001#;
|
|
|
131 FILE_READ_EA : constant := 16#0008#;
|
|
|
132 FILE_TRAVERSE : constant := 16#0020#;
|
|
|
133 FILE_WRITE_ATTRIBUTES : constant := 16#0100#;
|
|
|
134 FILE_WRITE_DATA : constant := 16#0002#;
|
|
|
135 FILE_WRITE_EA : constant := 16#0010#;
|
|
|
136 STANDARD_RIGHTS_READ : constant := 16#20000#;
|
|
|
137 STANDARD_RIGHTS_WRITE : constant := 16#20000#;
|
|
|
138 SYNCHRONIZE : constant := 16#100000#;
|
|
|
139
|
|
|
140 FILE_ATTRIBUTE_READONLY : constant := 16#00000001#;
|
|
|
141 FILE_ATTRIBUTE_HIDDEN : constant := 16#00000002#;
|
|
|
142 FILE_ATTRIBUTE_SYSTEM : constant := 16#00000004#;
|
|
|
143 FILE_ATTRIBUTE_DIRECTORY : constant := 16#00000010#;
|
|
|
144 FILE_ATTRIBUTE_ARCHIVE : constant := 16#00000020#;
|
|
|
145 FILE_ATTRIBUTE_DEVICE : constant := 16#00000040#;
|
|
|
146 FILE_ATTRIBUTE_NORMAL : constant := 16#00000080#;
|
|
|
147 FILE_ATTRIBUTE_TEMPORARY : constant := 16#00000100#;
|
|
|
148 FILE_ATTRIBUTE_SPARSE_FILE : constant := 16#00000200#;
|
|
|
149 FILE_ATTRIBUTE_REPARSE_POINT : constant := 16#00000400#;
|
|
|
150 FILE_ATTRIBUTE_COMPRESSED : constant := 16#00000800#;
|
|
|
151 FILE_ATTRIBUTE_OFFLINE : constant := 16#00001000#;
|
|
|
152 FILE_ATTRIBUTE_NOT_CONTENT_INDEXED : constant := 16#00002000#;
|
|
|
153 FILE_ATTRIBUTE_ENCRYPTED : constant := 16#00004000#;
|
|
|
154 FILE_ATTRIBUTE_VALID_FLAGS : constant := 16#00007fb7#;
|
|
|
155 FILE_ATTRIBUTE_VALID_SET_FLAGS : constant := 16#000031a7#;
|
|
|
156
|
|
|
157 GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS : constant := 16#00000004#;
|
|
|
158
|
|
|
159 type OVERLAPPED is record
|
|
|
160 Internal : DWORD;
|
|
|
161 InternalHigh : DWORD;
|
|
|
162 Offset : DWORD;
|
|
|
163 OffsetHigh : DWORD;
|
|
|
164 hEvent : HANDLE;
|
|
|
165 end record;
|
|
|
166
|
|
|
167 type SECURITY_ATTRIBUTES is record
|
|
|
168 nLength : DWORD;
|
|
|
169 pSecurityDescriptor : PVOID;
|
|
|
170 bInheritHandle : BOOL;
|
|
|
171 end record;
|
|
|
172
|
|
|
173 function CreateFileA
|
|
|
174 (lpFileName : Address;
|
|
|
175 dwDesiredAccess : DWORD;
|
|
|
176 dwShareMode : DWORD;
|
|
|
177 lpSecurityAttributes : access SECURITY_ATTRIBUTES;
|
|
|
178 dwCreationDisposition : DWORD;
|
|
|
179 dwFlagsAndAttributes : DWORD;
|
|
|
180 hTemplateFile : HANDLE) return HANDLE;
|
|
|
181 pragma Import (Stdcall, CreateFileA, "CreateFileA");
|
|
|
182
|
|
|
183 function CreateFile
|
|
|
184 (lpFileName : Address;
|
|
|
185 dwDesiredAccess : DWORD;
|
|
|
186 dwShareMode : DWORD;
|
|
|
187 lpSecurityAttributes : access SECURITY_ATTRIBUTES;
|
|
|
188 dwCreationDisposition : DWORD;
|
|
|
189 dwFlagsAndAttributes : DWORD;
|
|
|
190 hTemplateFile : HANDLE) return HANDLE;
|
|
|
191 pragma Import (Stdcall, CreateFile, "CreateFileW");
|
|
|
192
|
|
|
193 function GetFileSize
|
|
|
194 (hFile : HANDLE;
|
|
|
195 lpFileSizeHigh : access DWORD) return BOOL;
|
|
|
196 pragma Import (Stdcall, GetFileSize, "GetFileSize");
|
|
|
197
|
|
|
198 function SetFilePointer
|
|
|
199 (hFile : HANDLE;
|
|
|
200 lDistanceToMove : LONG;
|
|
|
201 lpDistanceToMoveHigh : access LONG;
|
|
|
202 dwMoveMethod : DWORD) return DWORD;
|
|
|
203 pragma Import (Stdcall, SetFilePointer, "SetFilePointer");
|
|
|
204
|
|
|
205 function WriteFile
|
|
|
206 (hFile : HANDLE;
|
|
|
207 lpBuffer : Address;
|
|
|
208 nNumberOfBytesToWrite : DWORD;
|
|
|
209 lpNumberOfBytesWritten : access DWORD;
|
|
|
210 lpOverlapped : access OVERLAPPED) return BOOL;
|
|
|
211 pragma Import (Stdcall, WriteFile, "WriteFile");
|
|
|
212
|
|
|
213 function ReadFile
|
|
|
214 (hFile : HANDLE;
|
|
|
215 lpBuffer : Address;
|
|
|
216 nNumberOfBytesToRead : DWORD;
|
|
|
217 lpNumberOfBytesRead : access DWORD;
|
|
|
218 lpOverlapped : access OVERLAPPED) return BOOL;
|
|
|
219 pragma Import (Stdcall, ReadFile, "ReadFile");
|
|
|
220
|
|
|
221 function CloseHandle (hObject : HANDLE) return BOOL;
|
|
|
222 pragma Import (Stdcall, CloseHandle, "CloseHandle");
|
|
|
223
|
|
|
224 function CreateFileMapping
|
|
|
225 (hFile : HANDLE;
|
|
|
226 lpSecurityAttributes : access SECURITY_ATTRIBUTES;
|
|
|
227 flProtect : DWORD;
|
|
|
228 dwMaximumSizeHigh : DWORD;
|
|
|
229 dwMaximumSizeLow : DWORD;
|
|
|
230 lpName : Address) return HANDLE;
|
|
|
231 pragma Import (Stdcall, CreateFileMapping, "CreateFileMappingA");
|
|
|
232
|
|
|
233 function MapViewOfFile
|
|
|
234 (hFileMappingObject : HANDLE;
|
|
|
235 dwDesiredAccess : DWORD;
|
|
|
236 dwFileOffsetHigh : DWORD;
|
|
|
237 dwFileOffsetLow : DWORD;
|
|
|
238 dwNumberOfBytesToMap : DWORD) return System.Address;
|
|
|
239 pragma Import (Stdcall, MapViewOfFile, "MapViewOfFile");
|
|
|
240
|
|
|
241 function UnmapViewOfFile (lpBaseAddress : System.Address) return BOOL;
|
|
|
242 pragma Import (Stdcall, UnmapViewOfFile, "UnmapViewOfFile");
|
|
|
243
|
|
|
244 function MultiByteToWideChar
|
|
|
245 (CodePage : WORD;
|
|
|
246 dwFlags : DWORD;
|
|
|
247 lpMultiByteStr : System.Address;
|
|
|
248 cchMultiByte : WORD;
|
|
|
249 lpWideCharStr : System.Address;
|
|
|
250 cchWideChar : WORD) return WORD;
|
|
|
251 pragma Import (Stdcall, MultiByteToWideChar, "MultiByteToWideChar");
|
|
|
252
|
|
|
253 ------------------------
|
|
|
254 -- System Information --
|
|
|
255 ------------------------
|
|
|
256
|
|
|
257 subtype ProcessorId is DWORD;
|
|
|
258
|
|
|
259 type SYSTEM_INFO is record
|
|
|
260 dwOemId : DWORD;
|
|
|
261 dwPageSize : DWORD;
|
|
|
262 lpMinimumApplicationAddress : PVOID;
|
|
|
263 lpMaximumApplicationAddress : PVOID;
|
|
|
264 dwActiveProcessorMask : DWORD;
|
|
|
265 dwNumberOfProcessors : DWORD;
|
|
|
266 dwProcessorType : DWORD;
|
|
|
267 dwAllocationGranularity : DWORD;
|
|
|
268 dwReserved : DWORD;
|
|
|
269 end record;
|
|
|
270
|
|
|
271 procedure GetSystemInfo (SI : access SYSTEM_INFO);
|
|
|
272 pragma Import (Stdcall, GetSystemInfo, "GetSystemInfo");
|
|
|
273
|
|
|
274 ---------------------
|
|
|
275 -- Time Management --
|
|
|
276 ---------------------
|
|
|
277
|
|
|
278 type SYSTEMTIME is record
|
|
|
279 wYear : WORD;
|
|
|
280 wMonth : WORD;
|
|
|
281 wDayOfWeek : WORD;
|
|
|
282 wDay : WORD;
|
|
|
283 wHour : WORD;
|
|
|
284 wMinute : WORD;
|
|
|
285 wSecond : WORD;
|
|
|
286 wMilliseconds : WORD;
|
|
|
287 end record;
|
|
|
288
|
|
|
289 procedure GetSystemTime (pSystemTime : access SYSTEMTIME);
|
|
|
290 pragma Import (Stdcall, GetSystemTime, "GetSystemTime");
|
|
|
291
|
|
|
292 procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
|
|
|
293 pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
|
|
|
294
|
|
|
295 function FileTimeToSystemTime
|
|
|
296 (lpFileTime : access Long_Long_Integer;
|
|
|
297 lpSystemTime : access SYSTEMTIME) return BOOL;
|
|
|
298 pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime");
|
|
|
299
|
|
|
300 function SystemTimeToFileTime
|
|
|
301 (lpSystemTime : access SYSTEMTIME;
|
|
|
302 lpFileTime : access Long_Long_Integer) return BOOL;
|
|
|
303 pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime");
|
|
|
304
|
|
|
305 function FileTimeToLocalFileTime
|
|
|
306 (lpFileTime : access Long_Long_Integer;
|
|
|
307 lpLocalFileTime : access Long_Long_Integer) return BOOL;
|
|
|
308 pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime");
|
|
|
309
|
|
|
310 function LocalFileTimeToFileTime
|
|
|
311 (lpFileTime : access Long_Long_Integer;
|
|
|
312 lpLocalFileTime : access Long_Long_Integer) return BOOL;
|
|
|
313 pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime");
|
|
|
314
|
|
|
315 procedure Sleep (dwMilliseconds : DWORD);
|
|
|
316 pragma Import (Stdcall, Sleep, External_Name => "Sleep");
|
|
|
317
|
|
|
318 function QueryPerformanceCounter
|
|
|
319 (lpPerformanceCount : access LARGE_INTEGER) return BOOL;
|
|
|
320 pragma Import
|
|
|
321 (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
|
|
|
322
|
|
|
323 ------------
|
|
|
324 -- Module --
|
|
|
325 ------------
|
|
|
326
|
|
|
327 function GetModuleHandleEx
|
|
|
328 (dwFlags : DWORD;
|
|
|
329 lpModuleName : Address;
|
|
|
330 phModule : access HANDLE) return BOOL;
|
|
|
331 pragma Import (Stdcall, GetModuleHandleEx, "GetModuleHandleExA");
|
|
|
332
|
|
|
333 function GetModuleFileName
|
|
|
334 (hModule : HANDLE;
|
|
|
335 lpFilename : Address;
|
|
|
336 nSize : DWORD) return DWORD;
|
|
|
337 pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA");
|
|
|
338
|
|
|
339 function FreeLibrary (hModule : HANDLE) return BOOL;
|
|
|
340 pragma Import (Stdcall, FreeLibrary, "FreeLibrary");
|
|
|
341
|
|
|
342 end System.Win32;
|
