Subversion Repositories Kolibri OS

Rev

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;