Subversion Repositories Kolibri OS

Rev

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

  1. (*
  2.     Copyright 2016 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.   Alloc: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER;
  53.   ExitProcess*: PROCEDURE [winapi] (code: INTEGER);
  54.   SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
  55.  
  56. PROCEDURE FileRW*(hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER;
  57. VAR res: INTEGER;
  58. BEGIN
  59.   IF write THEN
  60.     WriteFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0)
  61.   ELSE
  62.     ReadFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0)
  63.   END
  64.   RETURN res
  65. END FileRW;
  66.  
  67. PROCEDURE OutString* (str: ARRAY OF CHAR);
  68. VAR res: INTEGER;
  69. BEGIN
  70.   res := FileRW(hConsoleOutput, sys.ADR(str[0]), LENGTH(str), TRUE)
  71. END OutString;
  72.  
  73. PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER;
  74. VAR res: INTEGER;
  75. BEGIN
  76.   res := _CreateFile(sys.ADR(FName[0]), 0C0000000H, 0, 0, 2, 80H, 0);
  77.   IF res = -1 THEN
  78.     res := 0
  79.   END
  80.   RETURN res
  81. END CreateFile;
  82.  
  83. PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER;
  84. VAR res: INTEGER; ofstr: OFSTRUCT;
  85. BEGIN
  86.   res := _OpenFile(sys.ADR(FName[0]), ofstr, 0);
  87.   IF res = -1 THEN
  88.     res := 0
  89.   END
  90.   RETURN res
  91. END OpenFile;
  92.  
  93. PROCEDURE FileSize*(F: INTEGER): INTEGER;
  94. VAR res: INTEGER;
  95. BEGIN
  96.   res := SetFilePointer(F, 0, 0, 2);
  97.   SetFilePointer(F, 0, 0, 0)
  98.   RETURN res
  99. END FileSize;
  100.  
  101. PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER);
  102. BEGIN
  103.   sys.PUT(adr, API.GetProcAddress(hMOD, sys.ADR(name[0])))
  104. END GetProc;
  105.  
  106. PROCEDURE Time*(VAR sec, dsec: INTEGER);
  107. VAR t: INTEGER;
  108. BEGIN
  109.   t := GetTickCount() DIV 10;
  110.   sec := t DIV 100;
  111.   dsec := t MOD 100
  112. END Time;
  113.  
  114. PROCEDURE malloc*(size: INTEGER): INTEGER;
  115.   RETURN Alloc(64, size)
  116. END malloc;
  117.  
  118. PROCEDURE init*;
  119. VAR lib: INTEGER;
  120. BEGIN  
  121.   lib := API.LoadLibraryA(sys.ADR("kernel32.dll"));
  122.   GetProc("GetTickCount", lib, sys.ADR(GetTickCount));
  123.   Time(sec, dsec);
  124.   GetProc("GetStdHandle", lib, sys.ADR(GetStdHandle));
  125.   GetProc("CreateFileA", lib, sys.ADR(_CreateFile));
  126.   GetProc("CloseHandle", lib, sys.ADR(CloseFile));
  127.   GetProc("OpenFile", lib, sys.ADR(_OpenFile));
  128.   GetProc("ReadFile", lib, sys.ADR(ReadFile));
  129.   GetProc("WriteFile", lib, sys.ADR(WriteFile));
  130.   GetProc("GetCommandLineA", lib, sys.ADR(GetCommandLine));
  131.   GetProc("ExitProcess", lib, sys.ADR(ExitProcess));
  132.   GetProc("GlobalAlloc", lib, sys.ADR(Alloc));
  133.   GetProc("SetFilePointer", lib, sys.ADR(SetFilePointer));
  134.   hConsoleOutput := GetStdHandle(-11)
  135. END init;
  136.  
  137. PROCEDURE GetName*(): INTEGER;
  138.   RETURN 0
  139. END GetName;
  140.  
  141. END HOST.