Rev 7597 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7696 | akron1 | 1 | (* |
7597 | akron1 | 2 | BSD 2-Clause License |
6613 | leency | 3 | |
7696 | akron1 | 4 | Copyright (c) 2018-2019, Anton Krotov |
7597 | akron1 | 5 | All rights reserved. |
6613 | leency | 6 | *) |
7 | |||
8 | MODULE HOST; |
||
9 | |||
7597 | akron1 | 10 | IMPORT SYSTEM, RTL; |
6613 | leency | 11 | |
7597 | akron1 | 12 | |
6613 | leency | 13 | CONST |
14 | |||
7597 | akron1 | 15 | slash* = "\"; |
16 | OS* = "WINDOWS"; |
||
6613 | leency | 17 | |
7597 | akron1 | 18 | bit_depth* = RTL.bit_depth; |
19 | maxint* = RTL.maxint; |
||
20 | minint* = RTL.minint; |
||
6613 | leency | 21 | |
7597 | akron1 | 22 | MAX_PARAM = 1024; |
23 | |||
24 | OFS_MAXPATHNAME = 128; |
||
25 | |||
26 | |||
6613 | leency | 27 | TYPE |
28 | |||
7597 | akron1 | 29 | POverlapped = POINTER TO OVERLAPPED; |
6613 | leency | 30 | |
7597 | akron1 | 31 | OVERLAPPED = RECORD |
32 | |||
33 | Internal: INTEGER; |
||
34 | InternalHigh: INTEGER; |
||
35 | Offset: INTEGER; |
||
36 | OffsetHigh: INTEGER; |
||
37 | hEvent: INTEGER |
||
38 | |||
39 | END; |
||
40 | |||
41 | OFSTRUCT = RECORD |
||
42 | |||
43 | cBytes: CHAR; |
||
44 | fFixedDisk: CHAR; |
||
7696 | akron1 | 45 | nErrCode: WCHAR; |
46 | Reserved1: WCHAR; |
||
47 | Reserved2: WCHAR; |
||
7597 | akron1 | 48 | szPathName: ARRAY OFS_MAXPATHNAME OF CHAR |
49 | |||
50 | END; |
||
51 | |||
52 | PSecurityAttributes = POINTER TO TSecurityAttributes; |
||
53 | |||
54 | TSecurityAttributes = RECORD |
||
55 | |||
56 | nLength: INTEGER; |
||
57 | lpSecurityDescriptor: INTEGER; |
||
58 | bInheritHandle: INTEGER |
||
59 | |||
60 | END; |
||
61 | |||
62 | TSystemTime = RECORD |
||
63 | |||
64 | Year, |
||
65 | Month, |
||
66 | DayOfWeek, |
||
67 | Day, |
||
68 | Hour, |
||
69 | Min, |
||
70 | Sec, |
||
71 | MSec: WCHAR |
||
72 | |||
73 | END; |
||
74 | |||
75 | |||
6613 | leency | 76 | VAR |
77 | |||
7597 | akron1 | 78 | hConsoleOutput: INTEGER; |
6613 | leency | 79 | |
7597 | akron1 | 80 | Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
81 | argc: INTEGER; |
||
6613 | leency | 82 | |
7597 | akron1 | 83 | eol*: ARRAY 3 OF CHAR; |
84 | |||
85 | |||
86 | PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
||
87 | _GetTickCount (): INTEGER; |
||
88 | |||
89 | PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
||
90 | _GetStdHandle (nStdHandle: INTEGER): INTEGER; |
||
91 | |||
92 | PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] |
||
93 | _GetCommandLine (): INTEGER; |
||
94 | |||
95 | PROCEDURE [windows-, "kernel32.dll", "ReadFile"] |
||
96 | _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; |
||
97 | |||
98 | PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
||
99 | _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; |
||
100 | |||
101 | PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] |
||
102 | _CloseHandle (hObject: INTEGER): INTEGER; |
||
103 | |||
104 | PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] |
||
105 | _CreateFile ( |
||
106 | lpFileName, dwDesiredAccess, dwShareMode: INTEGER; |
||
107 | lpSecurityAttributes: PSecurityAttributes; |
||
108 | dwCreationDisposition, dwFlagsAndAttributes, |
||
109 | hTemplateFile: INTEGER): INTEGER; |
||
110 | |||
111 | PROCEDURE [windows-, "kernel32.dll", "OpenFile"] |
||
112 | _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; |
||
113 | |||
114 | PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"] |
||
115 | _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER; |
||
116 | |||
117 | PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"] |
||
118 | _GetSystemTime (T: TSystemTime); |
||
119 | |||
120 | PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
||
121 | _ExitProcess (code: INTEGER); |
||
122 | |||
123 | |||
124 | PROCEDURE ExitProcess* (code: INTEGER); |
||
6613 | leency | 125 | BEGIN |
7597 | akron1 | 126 | _ExitProcess(code) |
127 | END ExitProcess; |
||
6613 | leency | 128 | |
7597 | akron1 | 129 | |
130 | PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); |
||
131 | VAR |
||
132 | n: INTEGER; |
||
133 | |||
6613 | leency | 134 | BEGIN |
7597 | akron1 | 135 | n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0])); |
136 | path[n] := slash; |
||
137 | path[n + 1] := 0X |
||
138 | END GetCurrentDirectory; |
||
6613 | leency | 139 | |
7597 | akron1 | 140 | |
141 | PROCEDURE GetChar (adr: INTEGER): CHAR; |
||
142 | VAR |
||
143 | res: CHAR; |
||
144 | |||
6613 | leency | 145 | BEGIN |
7597 | akron1 | 146 | SYSTEM.GET(adr, res) |
147 | RETURN res |
||
148 | END GetChar; |
||
6613 | leency | 149 | |
7597 | akron1 | 150 | |
151 | PROCEDURE ParamParse; |
||
152 | VAR |
||
153 | p, count, cond: INTEGER; |
||
154 | c: CHAR; |
||
155 | |||
156 | |||
157 | PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR); |
||
158 | BEGIN |
||
159 | IF (c <= 20X) & (c # 0X) THEN |
||
160 | cond := A |
||
161 | ELSIF c = 22X THEN |
||
162 | cond := B |
||
163 | ELSIF c = 0X THEN |
||
164 | cond := 6 |
||
165 | ELSE |
||
166 | cond := C |
||
167 | END |
||
168 | END ChangeCond; |
||
169 | |||
170 | |||
6613 | leency | 171 | BEGIN |
7597 | akron1 | 172 | p := _GetCommandLine(); |
173 | cond := 0; |
||
174 | count := 0; |
||
175 | WHILE (count < MAX_PARAM) & (cond # 6) DO |
||
176 | c := GetChar(p); |
||
177 | CASE cond OF |
||
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 |
||
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 |
||
182 | |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
||
183 | |6: |
||
184 | END; |
||
185 | INC(p) |
||
186 | END; |
||
187 | argc := count |
||
188 | END ParamParse; |
||
6613 | leency | 189 | |
7597 | akron1 | 190 | |
191 | PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
||
192 | VAR |
||
193 | i, j, len: INTEGER; |
||
194 | c: CHAR; |
||
195 | |||
6613 | leency | 196 | BEGIN |
7597 | akron1 | 197 | j := 0; |
198 | IF n < argc THEN |
||
199 | len := LEN(s) - 1; |
||
200 | i := Params[n, 0]; |
||
201 | WHILE (j < len) & (i <= Params[n, 1]) DO |
||
202 | c := GetChar(i); |
||
203 | IF c # 22X THEN |
||
204 | s[j] := c; |
||
205 | INC(j) |
||
206 | END; |
||
207 | INC(i) |
||
208 | END |
||
209 | END; |
||
210 | s[j] := 0X |
||
211 | END GetArg; |
||
6613 | leency | 212 | |
7597 | akron1 | 213 | |
7696 | akron1 | 214 | PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
7597 | akron1 | 215 | VAR |
216 | res, n: INTEGER; |
||
217 | |||
6613 | leency | 218 | BEGIN |
7597 | akron1 | 219 | IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
220 | res := -1 |
||
221 | ELSE |
||
222 | res := n |
||
223 | END |
||
6613 | leency | 224 | |
7597 | akron1 | 225 | RETURN res |
226 | END FileRead; |
||