sysutils.pp 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2004 by Karoly Balogh
  4. Sysutils unit for Gameboy Advance.
  5. This unit is based on the MorphOS one and is adapted for Gameboy Advance
  6. simply by stripping out all stuff inside funcs and procs.
  7. Copyright (c) 2006 by Francesco Lombardi
  8. Based on Amiga version by Carl Eric Codere, and other
  9. parts of the RTL
  10. See the file COPYING.FPC, included in this distribution,
  11. for details about the copyright.
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15. **********************************************************************}
  16. unit sysutils;
  17. interface
  18. {$MODE objfpc}
  19. {$MODESWITCH OUT}
  20. { force ansistrings }
  21. {$H+}
  22. {$DEFINE HAS_SLEEP}
  23. {$DEFINE HAS_OSERROR}
  24. { used OS file system APIs use ansistring }
  25. {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
  26. { OS has an ansistring/single byte environment variable API }
  27. {$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
  28. { Include platform independent interface part }
  29. {$i sysutilh.inc}
  30. implementation
  31. uses
  32. dos, sysconst;
  33. { Include platform independent implementation part }
  34. {$i sysutils.inc}
  35. {****************************************************************************
  36. File Functions
  37. ****************************************************************************}
  38. function FileOpen(const FileName: rawbytestring; Mode: Integer): LongInt;
  39. begin
  40. result := -1;
  41. end;
  42. function FileGetDate(Handle: LongInt) : LongInt;
  43. begin
  44. result := -1;
  45. end;
  46. function FileSetDate(Handle, Age: LongInt) : LongInt;
  47. begin
  48. result := -1;
  49. end;
  50. function FileCreate(const FileName: RawByteString) : LongInt;
  51. begin
  52. result := -1;
  53. end;
  54. function FileCreate(const FileName: RawByteString; Rights: integer): LongInt;
  55. begin
  56. result := -1;
  57. end;
  58. function FileCreate(const FileName: RawByteString; ShareMode: integer; rights : integer): LongInt;
  59. begin
  60. result := -1;
  61. end;
  62. function FileRead(Handle: LongInt; Out Buffer; Count: LongInt): LongInt;
  63. begin
  64. result := -1;
  65. end;
  66. function FileWrite(Handle: LongInt; const Buffer; Count: LongInt): LongInt;
  67. begin
  68. result := -1;
  69. end;
  70. function FileSeek(Handle, FOffset, Origin: LongInt) : LongInt;
  71. begin
  72. result := -1;
  73. end;
  74. function FileSeek(Handle: LongInt; FOffset: Int64; Origin: Longint): Int64;
  75. begin
  76. result := -1;
  77. end;
  78. procedure FileClose(Handle: LongInt);
  79. begin
  80. end;
  81. function FileTruncate(Handle: THandle; Size: Int64): Boolean;
  82. begin
  83. result := false;
  84. end;
  85. function DeleteFile(const FileName: RawByteString) : Boolean;
  86. begin
  87. result := false;
  88. end;
  89. function RenameFile(const OldName, NewName: RawByteString): Boolean;
  90. begin
  91. result := false;
  92. end;
  93. (****** end of non portable routines ******)
  94. Function FileAge (Const FileName : RawByteString): Longint;
  95. begin
  96. result := -1;
  97. end;
  98. Function FileExists (Const FileName : RawByteString) : Boolean;
  99. Begin
  100. result := false;
  101. end;
  102. Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
  103. begin
  104. result := -1;
  105. end;
  106. Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
  107. begin
  108. result := -1;
  109. end;
  110. Procedure InternalFindClose(var Handle: THandle);
  111. begin
  112. end;
  113. Function FileGetAttr (Const FileName : RawByteString) : Longint;
  114. begin
  115. result := -1;
  116. end;
  117. Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
  118. begin
  119. result := -1;
  120. end;
  121. {****************************************************************************
  122. Disk Functions
  123. ****************************************************************************}
  124. Procedure AddDisk(const path:string);
  125. begin
  126. end;
  127. Function DiskFree(Drive: Byte): int64;
  128. Begin
  129. result := -1;
  130. End;
  131. Function DiskSize(Drive: Byte): int64;
  132. Begin
  133. result := -1;
  134. End;
  135. function DirectoryExists(const Directory: RawByteString): Boolean;
  136. begin
  137. result := false;
  138. end;
  139. {****************************************************************************
  140. Misc Functions
  141. ****************************************************************************}
  142. procedure sysBeep;
  143. begin
  144. end;
  145. Procedure Sleep(Milliseconds : Cardinal);
  146. var
  147. i,j : Cardinal;
  148. calib : Cardinal;
  149. begin
  150. {$warning no idea if this calibration value is correct (FK) }
  151. { I estimated it roughly on the CPU clock of 16 MHz and 1+3 clock cycles for the loop }
  152. calib:=4000000;
  153. for i:=1 to Milliseconds do
  154. asm
  155. ldr r0,calib
  156. .L1:
  157. sub r0,r0,#1
  158. bne .L1
  159. end;
  160. end;
  161. Function GetLastOSError : Integer;
  162. begin
  163. Result:=-1;
  164. end;
  165. {****************************************************************************
  166. Locale Functions
  167. ****************************************************************************}
  168. Procedure GetLocalTime(var SystemTime: TSystemTime);
  169. begin
  170. end ;
  171. function SysErrorMessage(ErrorCode: Integer): String;
  172. begin
  173. { Result:=StrError(ErrorCode);}
  174. result := '';
  175. end;
  176. {****************************************************************************
  177. OS utility functions
  178. ****************************************************************************}
  179. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  180. begin
  181. result := '';
  182. end;
  183. Function GetEnvironmentVariableCount : Integer;
  184. begin
  185. result := -1;
  186. end;
  187. Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
  188. begin
  189. result := '';
  190. end;
  191. function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString;Flags:TExecuteFlags=[]): integer;
  192. begin
  193. result := -1;
  194. end;
  195. function ExecuteProcess (const Path: AnsiString;
  196. const ComLine: array of AnsiString;Flags:TExecuteFlags=[]): integer;
  197. begin
  198. result := -1;
  199. end;
  200. {****************************************************************************
  201. Initialization code
  202. ****************************************************************************}
  203. Initialization
  204. InitExceptions;
  205. Finalization
  206. DoneExceptions;
  207. end.