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

 (*
-    Copyright 2016, 2017 Anton Krotov
+    BSD 2-Clause License
-    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
+    Copyright (c) 2018, 2019, Anton Krotov
-    (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 .
+    All rights reserved.
 *)
+MODULE HOST;
 MODULE HOST;
+IMPORT SYSTEM, RTL;
+CONST
+    slash* = "\";
+    OS* = "WINDOWS";
-IMPORT sys := SYSTEM, API;
     bit_depth* = RTL.bit_depth;
+    maxint* = RTL.maxint;
-CONST
+    minint* = RTL.minint;
+    MAX_PARAM = 1024;
+    OFS_MAXPATHNAME = 128;
+TYPE
+    POverlapped = POINTER TO OVERLAPPED;
+    OVERLAPPED = RECORD
         Internal:       INTEGER;
+        InternalHigh:   INTEGER;
-  OS* = "WIN";
+        Offset:         INTEGER;
-  Slash* = "\";
+        OffsetHigh:     INTEGER;
+        hEvent:         INTEGER
-  OFS_MAXPATHNAME = 128;
+    END;
 TYPE
+    OFSTRUCT = RECORD
+        cBytes:         CHAR;
+        fFixedDisk:     CHAR;
+        nErrCode:       SYSTEM.CARD16;
+        Reserved1:      SYSTEM.CARD16;
+        Reserved2:      SYSTEM.CARD16;
+        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,
-  OFSTRUCT = RECORD
+        Day,
-    cBytes: CHAR;
+        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;
-    fFixedDisk: CHAR;
-    nErrCode: sys.CARD16;
-    Reserved1: sys.CARD16;
-    Reserved2: sys.CARD16;
-    szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
-  END;
-VAR
-  sec*, dsec*, hConsoleOutput: INTEGER;
+BEGIN
-  GetStdHandle: PROCEDURE [winapi] (nStdHandle: INTEGER): INTEGER;
-  CloseFile*: PROCEDURE [winapi] (hObject: INTEGER): INTEGER;
+    SYSTEM.GET(adr, res)
+    RETURN res
+END GetChar;
-  _CreateFile*: PROCEDURE [winapi] (lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes,
-    dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER;
+PROCEDURE ParamParse;
+VAR
-  _OpenFile*: PROCEDURE [winapi] (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
+    p, count, cond: INTEGER;
-  ReadFile, WriteFile: PROCEDURE [winapi] (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped: INTEGER): INTEGER;
+    c: CHAR;
   GetCommandLine*: PROCEDURE [winapi] (): INTEGER;
-  GetTickCount: PROCEDURE [winapi] (): INTEGER;
-  ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
+    PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);
-  SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
-PROCEDURE FileRW*(hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER;
+    BEGIN
+        IF (c <= 20X) & (c # 0X) THEN
+            cond := A
+        ELSIF c = 22X THEN
+            cond := B
+        ELSIF c = 0X THEN
+            cond := 6
-VAR res: INTEGER;
+        ELSE
+            cond := C
+        END
+    END ChangeCond;
+BEGIN
+    p := _GetCommandLine();
+    cond := 0;
+    count := 0;
-BEGIN
+    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
-  IF write THEN
-    WriteFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0)
-  ELSE
+        |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |6:
+        END;
+        INC(p)
+    END;
-    ReadFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0)
+    argc := count
+END ParamParse;
-  END
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-  RETURN res
+VAR
+    i, j, len: INTEGER;
-END FileRW;
+    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 OutString* (str: ARRAY OF CHAR);
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+VAR
+    res, n: INTEGER;
-VAR res: INTEGER;
-BEGIN
-  res := FileRW(hConsoleOutput, sys.ADR(str[0]), LENGTH(str), TRUE)
+BEGIN
-END OutString;
+    IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN
+        res := -1
+    ELSE
-PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER;
+        res := n
-VAR res: INTEGER;
+    END
-BEGIN
+    RETURN res
-  res := _CreateFile(sys.ADR(FName[0]), 0C0000000H, 0, 0, 2, 80H, 0);
+END FileRead;
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+VAR
+    res, n: INTEGER;
-  IF res = -1 THEN
+BEGIN
-    res := 0
-  END
+    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 res
+    RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
-END CreateFile;
+END FileCreate;
+PROCEDURE FileClose* (F: INTEGER);
 BEGIN
-PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER;
+    _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
-VAR res: INTEGER; ofstr: OFSTRUCT;
-BEGIN
+END GetTickCount;
-  res := _OpenFile(sys.ADR(FName[0]), ofstr, 0);
+PROCEDURE letter (c: CHAR): BOOLEAN;
+    RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")
+END letter;
-  IF res = -1 THEN
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
-    res := 0
-  END
-  RETURN res
-END OpenFile;
-PROCEDURE FileSize*(F: INTEGER): INTEGER;
-VAR res: INTEGER;
-BEGIN
-  res := SetFilePointer(F, 0, 0, 2);
-  SetFilePointer(F, 0, 0, 0)
-  RETURN res
-END FileSize;
-PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER);
-BEGIN
-  sys.PUT(adr, API.GetProcAddress(hMOD, sys.ADR(name[0])))
-END GetProc;
-PROCEDURE Time*(VAR sec, dsec: INTEGER);
-VAR t: INTEGER;
-BEGIN
-  t := GetTickCount() DIV 10;
-  sec := t DIV 100;
-  dsec := t MOD 100
-END Time;
-PROCEDURE malloc*(size: INTEGER): INTEGER;
-  RETURN API.Alloc(64, size)
-END malloc;
+    RETURN ~(letter(path[0]) & (path[1] = ":"))
-PROCEDURE init*;
+END isRelative;
-VAR lib: INTEGER;
+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;
 BEGIN
   lib := API.LoadLibraryA(sys.ADR("kernel32.dll"));

Subversion Repositories Kolibri OS

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