sysutils.pp 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301
  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. {$modeswitch typehelpers}
  23. {$modeswitch advancedrecords}
  24. {$DEFINE HAS_SLEEP}
  25. {$DEFINE HAS_OSERROR}
  26. { used OS file system APIs use ansistring }
  27. {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
  28. { OS has an ansistring/single byte environment variable API }
  29. {$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
  30. { Include platform independent interface part }
  31. {$i sysutilh.inc}
  32. implementation
  33. uses
  34. dos, sysconst;
  35. { Include platform independent implementation part }
  36. {$i sysutils.inc}
  37. {****************************************************************************
  38. File Functions
  39. ****************************************************************************}
  40. function FileOpen(const FileName: rawbytestring; Mode: Integer): LongInt;
  41. begin
  42. result := -1;
  43. end;
  44. function FileGetDate(Handle: LongInt) : LongInt;
  45. begin
  46. result := -1;
  47. end;
  48. function FileSetDate(Handle, Age: LongInt) : LongInt;
  49. begin
  50. result := -1;
  51. end;
  52. function FileCreate(const FileName: RawByteString) : LongInt;
  53. begin
  54. result := -1;
  55. end;
  56. function FileCreate(const FileName: RawByteString; Rights: integer): LongInt;
  57. begin
  58. result := -1;
  59. end;
  60. function FileCreate(const FileName: RawByteString; ShareMode: integer; rights : integer): LongInt;
  61. begin
  62. result := -1;
  63. end;
  64. function FileRead(Handle: LongInt; Out Buffer; Count: LongInt): LongInt;
  65. begin
  66. result := -1;
  67. end;
  68. function FileWrite(Handle: LongInt; const Buffer; Count: LongInt): LongInt;
  69. begin
  70. result := -1;
  71. end;
  72. function FileSeek(Handle, FOffset, Origin: LongInt) : LongInt;
  73. begin
  74. result := -1;
  75. end;
  76. function FileSeek(Handle: LongInt; FOffset: Int64; Origin: Longint): Int64;
  77. begin
  78. result := -1;
  79. end;
  80. procedure FileClose(Handle: LongInt);
  81. begin
  82. end;
  83. function FileTruncate(Handle: THandle; Size: Int64): Boolean;
  84. begin
  85. result := false;
  86. end;
  87. function DeleteFile(const FileName: RawByteString) : Boolean;
  88. begin
  89. result := false;
  90. end;
  91. function RenameFile(const OldName, NewName: RawByteString): Boolean;
  92. begin
  93. result := false;
  94. end;
  95. (****** end of non portable routines ******)
  96. Function FileAge (Const FileName : RawByteString): Longint;
  97. begin
  98. result := -1;
  99. end;
  100. Function FileExists (Const FileName : RawByteString) : Boolean;
  101. Begin
  102. result := false;
  103. end;
  104. Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
  105. begin
  106. result := -1;
  107. end;
  108. Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
  109. begin
  110. result := -1;
  111. end;
  112. Procedure InternalFindClose(var Handle: THandle);
  113. begin
  114. end;
  115. Function FileGetAttr (Const FileName : RawByteString) : Longint;
  116. begin
  117. result := -1;
  118. end;
  119. Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
  120. begin
  121. result := -1;
  122. end;
  123. {****************************************************************************
  124. Disk Functions
  125. ****************************************************************************}
  126. Procedure AddDisk(const path:string);
  127. begin
  128. end;
  129. Function DiskFree(Drive: Byte): int64;
  130. Begin
  131. result := -1;
  132. End;
  133. Function DiskSize(Drive: Byte): int64;
  134. Begin
  135. result := -1;
  136. End;
  137. function DirectoryExists(const Directory: RawByteString): Boolean;
  138. begin
  139. result := false;
  140. end;
  141. {****************************************************************************
  142. Misc Functions
  143. ****************************************************************************}
  144. procedure sysBeep;
  145. begin
  146. end;
  147. Procedure Sleep(Milliseconds : Cardinal);
  148. var
  149. i,j : Cardinal;
  150. calib : Cardinal;
  151. begin
  152. {$warning no idea if this calibration value is correct (FK) }
  153. { I estimated it roughly on the CPU clock of 16 MHz and 1+3 clock cycles for the loop }
  154. calib:=4000000;
  155. for i:=1 to Milliseconds do
  156. asm
  157. ldr r0,calib
  158. .L1:
  159. sub r0,r0,#1
  160. bne .L1
  161. end;
  162. end;
  163. Function GetLastOSError : Integer;
  164. begin
  165. Result:=-1;
  166. end;
  167. {****************************************************************************
  168. Locale Functions
  169. ****************************************************************************}
  170. Procedure GetLocalTime(var SystemTime: TSystemTime);
  171. begin
  172. end ;
  173. function SysErrorMessage(ErrorCode: Integer): String;
  174. begin
  175. { Result:=StrError(ErrorCode);}
  176. result := '';
  177. end;
  178. {****************************************************************************
  179. OS utility functions
  180. ****************************************************************************}
  181. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  182. begin
  183. result := '';
  184. end;
  185. Function GetEnvironmentVariableCount : Integer;
  186. begin
  187. result := -1;
  188. end;
  189. Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
  190. begin
  191. result := '';
  192. end;
  193. function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString;Flags:TExecuteFlags=[]): integer;
  194. begin
  195. result := -1;
  196. end;
  197. function ExecuteProcess (const Path: AnsiString;
  198. const ComLine: array of AnsiString;Flags:TExecuteFlags=[]): integer;
  199. begin
  200. result := -1;
  201. end;
  202. {****************************************************************************
  203. Initialization code
  204. ****************************************************************************}
  205. Initialization
  206. InitExceptions;
  207. Finalization
  208. DoneExceptions;
  209. end.