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


(*
    BSD 2-Clause License
 
    Copyright (c) 2018-2019, Anton Krotov
    All rights reserved.
*)
 
MODULE HOST;
 
IMPORT SYSTEM, RTL;
 
 
CONST
 
    slash* = "\";
    OS* = "WINDOWS";
 
    bit_depth* = RTL.bit_depth;
    maxint* = RTL.maxint;
    minint* = RTL.minint;
 
    MAX_PARAM = 1024;
 
    OFS_MAXPATHNAME = 128;
 
 
TYPE
 
    POverlapped = POINTER TO OVERLAPPED;
 
    OVERLAPPED = RECORD
 
        Internal:       INTEGER;
        InternalHigh:   INTEGER;
        Offset:         INTEGER;
        OffsetHigh:     INTEGER;
        hEvent:         INTEGER
 
    END;
 
    OFSTRUCT = RECORD
 
        cBytes:         CHAR;
        fFixedDisk:     CHAR;
        nErrCode:       WCHAR;
        Reserved1:      WCHAR;
        Reserved2:      WCHAR;
        szPathName:     ARRAY OFS_MAXPATHNAME OF CHAR
 
    END;
 
    PSecurityAttributes = POINTER TO TSecurityAttributes;
 
    TSecurityAttributes = RECORD
 
        nLength:               INTEGER;
        lpSecurityDescriptor:  INTEGER;
        bInheritHandle:        INTEGER
 
    END;
 
    TSystemTime = RECORD
 
        Year,
        Month,
        DayOfWeek,
        Day,
        Hour,
        Min,
        Sec,
        MSec:  WCHAR
 
    END;
 
 
VAR
 
    hConsoleOutput: INTEGER;
 
    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
    argc: INTEGER;
 
    eol*: ARRAY 3 OF CHAR;
 
 
PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]
    _GetTickCount (): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]
    _GetStdHandle (nStdHandle: INTEGER): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]
    _GetCommandLine (): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "ReadFile"]
    _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "WriteFile"]
    _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]
    _CloseHandle (hObject: INTEGER): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]
    _CreateFile (
        lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
        lpSecurityAttributes: PSecurityAttributes;
        dwCreationDisposition, dwFlagsAndAttributes,
        hTemplateFile: INTEGER): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "OpenFile"]
    _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]
    _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;
 
PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"]
    _GetSystemTime (T: TSystemTime);
 
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"]
    _ExitProcess (code: INTEGER);
 
 
PROCEDURE ExitProcess* (code: INTEGER);
BEGIN
    _ExitProcess(code)
END ExitProcess;
 
 
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
VAR
    n: INTEGER;
 
BEGIN
    n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));
    path[n] := slash;
    path[n + 1] := 0X
END GetCurrentDirectory;
 
 
PROCEDURE GetChar (adr: INTEGER): CHAR;
VAR
    res: CHAR;
 
BEGIN
    SYSTEM.GET(adr, res)
    RETURN res
END GetChar;
 
 
PROCEDURE ParamParse;
VAR
    p, count, cond: INTEGER;
    c: CHAR;
 
 
    PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);
    BEGIN
        IF (c <= 20X) & (c # 0X) THEN
            cond := A
        ELSIF c = 22X THEN
            cond := B
        ELSIF c = 0X THEN
            cond := 6
        ELSE
            cond := C
        END
    END ChangeCond;
 
 
BEGIN
    p := _GetCommandLine();
    cond := 0;
    count := 0;
    WHILE (count < MAX_PARAM) & (cond # 6) DO
        c := GetChar(p);
        CASE cond OF
        |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END
        |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
        |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
        |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END
        |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
        |6:
        END;
        INC(p)
    END;
    argc := count
END ParamParse;
 
 
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
VAR
    i, j, len: INTEGER;
    c: CHAR;
 
BEGIN
    j := 0;
    IF n < argc THEN
        len := LEN(s) - 1;
        i := Params[n, 0];
        WHILE (j < len) & (i <= Params[n, 1]) DO
            c := GetChar(i);
            IF c # 22X THEN
                s[j] := c;
                INC(j)
            END;
            INC(i)
        END
    END;
    s[j] := 0X
END GetArg;
 
 
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
    res, n: INTEGER;
 
BEGIN
    IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN
        res := -1
    ELSE
        res := n
    END
 
    RETURN res
END FileRead;
 
 
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
VAR
    res, n: INTEGER;
 
BEGIN
    IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN
        res := -1
    ELSE
        res := n
    END
 
    RETURN res
END FileWrite;
 
 
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
    RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
END FileCreate;
 
 
PROCEDURE FileClose* (F: INTEGER);
BEGIN
    _CloseHandle(F)
END FileClose;
 
 
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
VAR
    ofstr: OFSTRUCT;
    res:   INTEGER;
 
BEGIN
    res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);
    IF res = 0FFFFFFFFH THEN
        res := -1
    END
 
    RETURN res
END FileOpen;
 
 
PROCEDURE OutChar* (c: CHAR);
VAR
    count: INTEGER;
BEGIN
    _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)
END OutChar;
 
 
PROCEDURE GetTickCount* (): INTEGER;
    RETURN _GetTickCount() DIV 10
END GetTickCount;
 
 
PROCEDURE letter (c: CHAR): BOOLEAN;
    RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")
END letter;
 
 
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
    RETURN ~(letter(path[0]) & (path[1] = ":"))
END isRelative;
 
 
PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER);
VAR
    T: TSystemTime;
 
BEGIN
    _GetSystemTime(T);
    year  := ORD(T.Year);
    month := ORD(T.Month);
    day   := ORD(T.Day);
    hour  := ORD(T.Hour);
    min   := ORD(T.Min);
    sec   := ORD(T.Sec)
END now;
 
 
PROCEDURE UnixTime* (): INTEGER;
    RETURN 0
END UnixTime;
 
 
PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
VAR
    res: INTEGER;
 
BEGIN
    a := 0;
    b := 0;
    SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4);
    SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4);
    SYSTEM.GET(SYSTEM.ADR(x), res)
    RETURN res
END splitf;
 
 
BEGIN
    eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
    hConsoleOutput := _GetStdHandle(-11);
    ParamParse
END HOST.

Rev 7597	Rev 7696
1	(*	1	(*
2	BSD 2-Clause License	2	BSD 2-Clause License
3		3
4	Copyright (c) 2018, 2019, Anton Krotov	4	Copyright (c) 2018-2019, Anton Krotov
5	All rights reserved.	5	All rights reserved.
6	*)	6	*)
7		7
8	MODULE HOST;	8	MODULE HOST;
9		9
10	IMPORT SYSTEM, RTL;	10	IMPORT SYSTEM, RTL;
11		11
12		12
13	CONST	13	CONST
14		14
15	slash* = "\";	15	slash* = "\";
16	OS* = "WINDOWS";	16	OS* = "WINDOWS";
17		17
18	bit_depth* = RTL.bit_depth;	18	bit_depth* = RTL.bit_depth;
19	maxint* = RTL.maxint;	19	maxint* = RTL.maxint;
20	minint* = RTL.minint;	20	minint* = RTL.minint;
21		21
22	MAX_PARAM = 1024;	22	MAX_PARAM = 1024;
23		23
24	OFS_MAXPATHNAME = 128;	24	OFS_MAXPATHNAME = 128;
25		25
26		26
27	TYPE	27	TYPE
28		28
29	POverlapped = POINTER TO OVERLAPPED;	29	POverlapped = POINTER TO OVERLAPPED;
30		30
31	OVERLAPPED = RECORD	31	OVERLAPPED = RECORD
32		32
33	Internal: INTEGER;	33	Internal: INTEGER;
34	InternalHigh: INTEGER;	34	InternalHigh: INTEGER;
35	Offset: INTEGER;	35	Offset: INTEGER;
36	OffsetHigh: INTEGER;	36	OffsetHigh: INTEGER;
37	hEvent: INTEGER	37	hEvent: INTEGER
38		38
39	END;	39	END;
40		40
41	OFSTRUCT = RECORD	41	OFSTRUCT = RECORD
42		42
43	cBytes: CHAR;	43	cBytes: CHAR;
44	fFixedDisk: CHAR;	44	fFixedDisk: CHAR;
45	nErrCode: SYSTEM.CARD16;	45	nErrCode: WCHAR;
46	Reserved1: SYSTEM.CARD16;	46	Reserved1: WCHAR;
47	Reserved2: SYSTEM.CARD16;	47	Reserved2: WCHAR;
48	szPathName: ARRAY OFS_MAXPATHNAME OF CHAR	48	szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
49		49
50	END;	50	END;
51		51
52	PSecurityAttributes = POINTER TO TSecurityAttributes;	52	PSecurityAttributes = POINTER TO TSecurityAttributes;
53		53
54	TSecurityAttributes = RECORD	54	TSecurityAttributes = RECORD
55		55
56	nLength: INTEGER;	56	nLength: INTEGER;
57	lpSecurityDescriptor: INTEGER;	57	lpSecurityDescriptor: INTEGER;
58	bInheritHandle: INTEGER	58	bInheritHandle: INTEGER
59		59
60	END;	60	END;
61		61
62	TSystemTime = RECORD	62	TSystemTime = RECORD
63		63
64	Year,	64	Year,
65	Month,	65	Month,
66	DayOfWeek,	66	DayOfWeek,
67	Day,	67	Day,
68	Hour,	68	Hour,
69	Min,	69	Min,
70	Sec,	70	Sec,
71	MSec: WCHAR	71	MSec: WCHAR
72		72
73	END;	73	END;
74		74
75		75
76	VAR	76	VAR
77		77
78	hConsoleOutput: INTEGER;	78	hConsoleOutput: INTEGER;
79		79
80	Params: ARRAY MAX_PARAM, 2 OF INTEGER;	80	Params: ARRAY MAX_PARAM, 2 OF INTEGER;
81	argc: INTEGER;	81	argc: INTEGER;
82		82
83	eol*: ARRAY 3 OF CHAR;	83	eol*: ARRAY 3 OF CHAR;
84		84
85		85
86	PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]	86	PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]
87	_GetTickCount (): INTEGER;	87	_GetTickCount (): INTEGER;
88		88
89	PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]	89	PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]
90	_GetStdHandle (nStdHandle: INTEGER): INTEGER;	90	_GetStdHandle (nStdHandle: INTEGER): INTEGER;
91		91
92	PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]	92	PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]
93	_GetCommandLine (): INTEGER;	93	_GetCommandLine (): INTEGER;
94		94
95	PROCEDURE [windows-, "kernel32.dll", "ReadFile"]	95	PROCEDURE [windows-, "kernel32.dll", "ReadFile"]
96	_ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;	96	_ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
97		97
98	PROCEDURE [windows-, "kernel32.dll", "WriteFile"]	98	PROCEDURE [windows-, "kernel32.dll", "WriteFile"]
99	_WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;	99	_WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
100		100
101	PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]	101	PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]
102	_CloseHandle (hObject: INTEGER): INTEGER;	102	_CloseHandle (hObject: INTEGER): INTEGER;
103		103
104	PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]	104	PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]
105	_CreateFile (	105	_CreateFile (
106	lpFileName, dwDesiredAccess, dwShareMode: INTEGER;	106	lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
107	lpSecurityAttributes: PSecurityAttributes;	107	lpSecurityAttributes: PSecurityAttributes;
108	dwCreationDisposition, dwFlagsAndAttributes,	108	dwCreationDisposition, dwFlagsAndAttributes,
109	hTemplateFile: INTEGER): INTEGER;	109	hTemplateFile: INTEGER): INTEGER;
110		110
111	PROCEDURE [windows-, "kernel32.dll", "OpenFile"]	111	PROCEDURE [windows-, "kernel32.dll", "OpenFile"]
112	_OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;	112	_OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
113		113
114	PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]	114	PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]
115	_GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;	115	_GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;
116		116
117	PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"]	117	PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"]
118	_GetSystemTime (T: TSystemTime);	118	_GetSystemTime (T: TSystemTime);
119		119
120	PROCEDURE [windows-, "kernel32.dll", "ExitProcess"]	120	PROCEDURE [windows-, "kernel32.dll", "ExitProcess"]
121	_ExitProcess (code: INTEGER);	121	_ExitProcess (code: INTEGER);
122		122
123		123
124	PROCEDURE ExitProcess* (code: INTEGER);	124	PROCEDURE ExitProcess* (code: INTEGER);
125	BEGIN	125	BEGIN
126	_ExitProcess(code)	126	_ExitProcess(code)
127	END ExitProcess;	127	END ExitProcess;
128		128
129		129
130	PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);	130	PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
131	VAR	131	VAR
132	n: INTEGER;	132	n: INTEGER;
133		133
134	BEGIN	134	BEGIN
135	n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));	135	n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));
136	path[n] := slash;	136	path[n] := slash;
137	path[n + 1] := 0X	137	path[n + 1] := 0X
138	END GetCurrentDirectory;	138	END GetCurrentDirectory;
139		139
140		140
141	PROCEDURE GetChar (adr: INTEGER): CHAR;	141	PROCEDURE GetChar (adr: INTEGER): CHAR;
142	VAR	142	VAR
143	res: CHAR;	143	res: CHAR;
144		144
145	BEGIN	145	BEGIN
146	SYSTEM.GET(adr, res)	146	SYSTEM.GET(adr, res)
147	RETURN res	147	RETURN res
148	END GetChar;	148	END GetChar;
149		149
150		150
151	PROCEDURE ParamParse;	151	PROCEDURE ParamParse;
152	VAR	152	VAR
153	p, count, cond: INTEGER;	153	p, count, cond: INTEGER;
154	c: CHAR;	154	c: CHAR;
155		155
156		156
157	PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);	157	PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);
158	BEGIN	158	BEGIN
159	IF (c <= 20X) & (c # 0X) THEN	159	IF (c <= 20X) & (c # 0X) THEN
160	cond := A	160	cond := A
161	ELSIF c = 22X THEN	161	ELSIF c = 22X THEN
162	cond := B	162	cond := B
163	ELSIF c = 0X THEN	163	ELSIF c = 0X THEN
164	cond := 6	164	cond := 6
165	ELSE	165	ELSE
166	cond := C	166	cond := C
167	END	167	END
168	END ChangeCond;	168	END ChangeCond;
169		169
170		170
171	BEGIN	171	BEGIN
172	p := _GetCommandLine();	172	p := _GetCommandLine();
173	cond := 0;	173	cond := 0;
174	count := 0;	174	count := 0;
175	WHILE (count < MAX_PARAM) & (cond # 6) DO	175	WHILE (count < MAX_PARAM) & (cond # 6) DO
176	c := GetChar(p);	176	c := GetChar(p);
177	CASE cond OF	177	CASE cond OF
178	\|0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END	178	\|0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END
179	\|1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END	179	\|1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
180	\|3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END	180	\|3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
181	\|4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END	181	\|4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END
182	\|5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END	182	\|5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
183	\|6:	183	\|6:
184	END;	184	END;
185	INC(p)	185	INC(p)
186	END;	186	END;
187	argc := count	187	argc := count
188	END ParamParse;	188	END ParamParse;
189		189
190		190
191	PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);	191	PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
192	VAR	192	VAR
193	i, j, len: INTEGER;	193	i, j, len: INTEGER;
194	c: CHAR;	194	c: CHAR;
195		195
196	BEGIN	196	BEGIN
197	j := 0;	197	j := 0;
198	IF n < argc THEN	198	IF n < argc THEN
199	len := LEN(s) - 1;	199	len := LEN(s) - 1;
200	i := Params[n, 0];	200	i := Params[n, 0];
201	WHILE (j < len) & (i <= Params[n, 1]) DO	201	WHILE (j < len) & (i <= Params[n, 1]) DO
202	c := GetChar(i);	202	c := GetChar(i);
203	IF c # 22X THEN	203	IF c # 22X THEN
204	s[j] := c;	204	s[j] := c;
205	INC(j)	205	INC(j)
206	END;	206	END;
207	INC(i)	207	INC(i)
208	END	208	END
209	END;	209	END;
210	s[j] := 0X	210	s[j] := 0X
211	END GetArg;	211	END GetArg;
212		212
213		213
214	PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;	214	PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
215	VAR	215	VAR
216	res, n: INTEGER;	216	res, n: INTEGER;
217		217
218	BEGIN	218	BEGIN
219	IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN	219	IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN
220	res := -1	220	res := -1
221	ELSE	221	ELSE
222	res := n	222	res := n
223	END	223	END
224		224
225	RETURN res	225	RETURN res
226	END FileRead;	226	END FileRead;
227		227
228		228
229	PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;	229	PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
230	VAR	230	VAR
231	res, n: INTEGER;	231	res, n: INTEGER;
232		232
233	BEGIN	233	BEGIN
234	IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN	234	IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN
235	res := -1	235	res := -1
236	ELSE	236	ELSE
237	res := n	237	res := n
238	END	238	END
239		239
240	RETURN res	240	RETURN res
241	END FileWrite;	241	END FileWrite;
242		242
243		243
244	PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;	244	PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
245	RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)	245	RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
246	END FileCreate;	246	END FileCreate;
247		247
248		248
249	PROCEDURE FileClose* (F: INTEGER);	249	PROCEDURE FileClose* (F: INTEGER);
250	BEGIN	250	BEGIN
251	_CloseHandle(F)	251	_CloseHandle(F)
252	END FileClose;	252	END FileClose;
253		253
254		254
255	PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;	255	PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
256	VAR	256	VAR
257	ofstr: OFSTRUCT;	257	ofstr: OFSTRUCT;
258	res: INTEGER;	258	res: INTEGER;
259		259
260	BEGIN	260	BEGIN
261	res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);	261	res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);
262	IF res = 0FFFFFFFFH THEN	262	IF res = 0FFFFFFFFH THEN
263	res := -1	263	res := -1
264	END	264	END
265		265
266	RETURN res	266	RETURN res
267	END FileOpen;	267	END FileOpen;
268		268
269		269
270	PROCEDURE OutChar* (c: CHAR);	270	PROCEDURE OutChar* (c: CHAR);
271	VAR	271	VAR
272	count: INTEGER;	272	count: INTEGER;
273	BEGIN	273	BEGIN
274	_WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)	274	_WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)
275	END OutChar;	275	END OutChar;
276		276
277		277
278	PROCEDURE GetTickCount* (): INTEGER;	278	PROCEDURE GetTickCount* (): INTEGER;
279	RETURN _GetTickCount() DIV 10	279	RETURN _GetTickCount() DIV 10
280	END GetTickCount;	280	END GetTickCount;
281		281
282		282
283	PROCEDURE letter (c: CHAR): BOOLEAN;	283	PROCEDURE letter (c: CHAR): BOOLEAN;
284	RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")	284	RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")
285	END letter;	285	END letter;
286		286
287		287
288	PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;	288	PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
289	RETURN ~(letter(path[0]) & (path[1] = ":"))	289	RETURN ~(letter(path[0]) & (path[1] = ":"))
290	END isRelative;	290	END isRelative;
291		291
292		292
293	PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER);	293	PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER);
294	VAR	294	VAR
295	T: TSystemTime;	295	T: TSystemTime;
296		296
297	BEGIN	297	BEGIN
298	_GetSystemTime(T);	298	_GetSystemTime(T);
299	year := ORD(T.Year);	299	year := ORD(T.Year);
300	month := ORD(T.Month);	300	month := ORD(T.Month);
301	day := ORD(T.Day);	301	day := ORD(T.Day);
302	hour := ORD(T.Hour);	302	hour := ORD(T.Hour);
303	min := ORD(T.Min);	303	min := ORD(T.Min);
304	sec := ORD(T.Sec)	304	sec := ORD(T.Sec)
305	END now;	305	END now;
306		306
307		307
308	PROCEDURE UnixTime* (): INTEGER;	308	PROCEDURE UnixTime* (): INTEGER;
309	RETURN 0	309	RETURN 0
310	END UnixTime;	310	END UnixTime;
311		311
312		312
313	PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;	313	PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
314	VAR	314	VAR
315	res: INTEGER;	315	res: INTEGER;
316		316
317	BEGIN	317	BEGIN
318	a := 0;	318	a := 0;
319	b := 0;	319	b := 0;
320	SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4);	320	SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4);
321	SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4);	321	SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4);
322	SYSTEM.GET(SYSTEM.ADR(x), res)	322	SYSTEM.GET(SYSTEM.ADR(x), res)
323	RETURN res	323	RETURN res
324	END splitf;	324	END splitf;
325		325
326		326
327	BEGIN	327	BEGIN
328	eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;	328	eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
329	hConsoleOutput := _GetStdHandle(-11);	329	hConsoleOutput := _GetStdHandle(-11);
330	ParamParse	330	ParamParse
331	END HOST.	331	END HOST.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/Windows32/HOST.ob07 – Rev 7597 → 7696