Subversion Repositories Kolibri OS

Rev

Rev 6613 | Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. (*
  2.     Copyright 2016, 2017 Anton Krotov
  3.  
  4.     This program is free software: you can redistribute it and/or modify
  5.     it under the terms of the GNU Lesser General Public License as published by
  6.     the Free Software Foundation, either version 3 of the License, or
  7.     (at your option) any later version.
  8.  
  9.     This program is distributed in the hope that it will be useful,
  10.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  11.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12.     GNU Lesser General Public License for more details.
  13.  
  14.     You should have received a copy of the GNU Lesser General Public License
  15.     along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16. *)
  17.  
  18. MODULE HOST;
  19.  
  20. IMPORT sys := SYSTEM, API;
  21.  
  22. CONST
  23.  
  24.   OS* = "WIN";
  25.   Slash* = "\";
  26.  
  27.   OFS_MAXPATHNAME = 128;
  28.  
  29. TYPE
  30.  
  31.   OFSTRUCT = RECORD
  32.     cBytes: CHAR;
  33.     fFixedDisk: CHAR;
  34.     nErrCode: sys.CARD16;
  35.     Reserved1: sys.CARD16;
  36.     Reserved2: sys.CARD16;
  37.     szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
  38.   END;
  39.  
  40. VAR
  41.  
  42.   sec*, dsec*, hConsoleOutput: INTEGER;
  43.  
  44.   GetStdHandle: PROCEDURE [winapi] (nStdHandle: INTEGER): INTEGER;
  45.   CloseFile*: PROCEDURE [winapi] (hObject: INTEGER): INTEGER;
  46.   _CreateFile*: PROCEDURE [winapi] (lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes,
  47.     dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER;
  48.   _OpenFile*: PROCEDURE [winapi] (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
  49.   ReadFile, WriteFile: PROCEDURE [winapi] (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped: INTEGER): INTEGER;
  50.   GetCommandLine*: PROCEDURE [winapi] (): INTEGER;
  51.   GetTickCount: PROCEDURE [winapi] (): INTEGER;
  52.   ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
  53.   SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
  54.  
  55. PROCEDURE FileRW*(hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER;
  56. VAR res: INTEGER;
  57. BEGIN
  58.   IF write THEN
  59.     WriteFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0)
  60.   ELSE
  61.     ReadFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0)
  62.   END
  63.   RETURN res
  64. END FileRW;
  65.  
  66. PROCEDURE OutString* (str: ARRAY OF CHAR);
  67. VAR res: INTEGER;
  68. BEGIN
  69.   res := FileRW(hConsoleOutput, sys.ADR(str[0]), LENGTH(str), TRUE)
  70. END OutString;
  71.  
  72. PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER;
  73. VAR res: INTEGER;
  74. BEGIN
  75.   res := _CreateFile(sys.ADR(FName[0]), 0C0000000H, 0, 0, 2, 80H, 0);
  76.   IF res = -1 THEN
  77.     res := 0
  78.   END
  79.   RETURN res
  80. END CreateFile;
  81.  
  82. PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER;
  83. VAR res: INTEGER; ofstr: OFSTRUCT;
  84. BEGIN
  85.   res := _OpenFile(sys.ADR(FName[0]), ofstr, 0);
  86.   IF res = -1 THEN
  87.     res := 0
  88.   END
  89.   RETURN res
  90. END OpenFile;
  91.  
  92. PROCEDURE FileSize*(F: INTEGER): INTEGER;
  93. VAR res: INTEGER;
  94. BEGIN
  95.   res := SetFilePointer(F, 0, 0, 2);
  96.   SetFilePointer(F, 0, 0, 0)
  97.   RETURN res
  98. END FileSize;
  99.  
  100. PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER);
  101. BEGIN
  102.   sys.PUT(adr, API.GetProcAddress(hMOD, sys.ADR(name[0])))
  103. END GetProc;
  104.  
  105. PROCEDURE Time*(VAR sec, dsec: INTEGER);
  106. VAR t: INTEGER;
  107. BEGIN
  108.   t := GetTickCount() DIV 10;
  109.   sec := t DIV 100;
  110.   dsec := t MOD 100
  111. END Time;
  112.  
  113. PROCEDURE malloc*(size: INTEGER): INTEGER;
  114.   RETURN API.Alloc(64, size)
  115. END malloc;
  116.  
  117. PROCEDURE init*;
  118. VAR lib: INTEGER;
  119. BEGIN
  120.   lib := API.LoadLibraryA(sys.ADR("kernel32.dll"));
  121.   GetProc("GetTickCount", lib, sys.ADR(GetTickCount));
  122.   Time(sec, dsec);
  123.   GetProc("GetStdHandle", lib, sys.ADR(GetStdHandle));
  124.   GetProc("CreateFileA", lib, sys.ADR(_CreateFile));
  125.   GetProc("CloseHandle", lib, sys.ADR(CloseFile));
  126.   GetProc("OpenFile", lib, sys.ADR(_OpenFile));
  127.   GetProc("ReadFile", lib, sys.ADR(ReadFile));
  128.   GetProc("WriteFile", lib, sys.ADR(WriteFile));
  129.   GetProc("GetCommandLineA", lib, sys.ADR(GetCommandLine));
  130.   GetProc("SetFilePointer", lib, sys.ADR(SetFilePointer));
  131.   ExitProcess := API.ExitProcess;
  132.   hConsoleOutput := GetStdHandle(-11)
  133. END init;
  134.  
  135. PROCEDURE GetName*(): INTEGER;
  136.   RETURN 0
  137. END GetName;
  138.  
  139. END HOST.