sysutils.pp 7.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329
  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 FileGetSymLinkTarget(const FileName: RawByteString; out SymLinkRec: TRawbyteSymLinkRec): Boolean;
  101. begin
  102. Result := False;
  103. end;
  104. Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
  105. Begin
  106. result := false;
  107. end;
  108. Function InternalFindFirst (Const Path : RawByteString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name: RawByteString) : Longint;
  109. begin
  110. result := -1;
  111. end;
  112. Function InternalFindNext (var Rslt : TAbstractSearchRec; var Name : RawByteString) : Longint;
  113. begin
  114. result := -1;
  115. end;
  116. Procedure InternalFindClose(var Handle: THandle);
  117. begin
  118. end;
  119. Function FileGetAttr (Const FileName : RawByteString) : Longint;
  120. begin
  121. result := -1;
  122. end;
  123. Function FileSetAttr (Const Filename : RawByteString; Attr: longint) : Longint;
  124. begin
  125. result := -1;
  126. end;
  127. {****************************************************************************
  128. Disk Functions
  129. ****************************************************************************}
  130. Procedure AddDisk(const path:string);
  131. begin
  132. end;
  133. Function DiskFree(Drive: Byte): int64;
  134. Begin
  135. result := -1;
  136. End;
  137. Function DiskSize(Drive: Byte): int64;
  138. Begin
  139. result := -1;
  140. End;
  141. function DirectoryExists(const Directory: RawByteString; FollowLink : Boolean): Boolean;
  142. begin
  143. result := false;
  144. end;
  145. {****************************************************************************
  146. Misc Functions
  147. ****************************************************************************}
  148. procedure sysBeep;
  149. begin
  150. end;
  151. Procedure Sleep(Milliseconds : Cardinal);
  152. var
  153. i,j : Cardinal;
  154. calib : Cardinal;
  155. begin
  156. {$warning no idea if this calibration value is correct (FK) }
  157. { I estimated it roughly on the CPU clock of 16 MHz and 1+3 clock cycles for the loop }
  158. calib:=4000000;
  159. for i:=1 to Milliseconds do
  160. asm
  161. ldr r0,calib
  162. .L1:
  163. sub r0,r0,#1
  164. bne .L1
  165. end;
  166. end;
  167. Function GetLastOSError : Integer;
  168. begin
  169. Result:=-1;
  170. end;
  171. {****************************************************************************
  172. Locale Functions
  173. ****************************************************************************}
  174. Procedure GetLocalTime(var SystemTime: TSystemTime);
  175. begin
  176. end ;
  177. function SysErrorMessage(ErrorCode: Integer): String;
  178. begin
  179. { Result:=StrError(ErrorCode);}
  180. result := '';
  181. end;
  182. {****************************************************************************
  183. OS utility functions
  184. ****************************************************************************}
  185. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  186. begin
  187. result := '';
  188. end;
  189. Function GetEnvironmentVariableCount : Integer;
  190. begin
  191. result := -1;
  192. end;
  193. Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
  194. begin
  195. result := '';
  196. end;
  197. function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]): integer;
  198. begin
  199. result := -1;
  200. end;
  201. function ExecuteProcess (const Path: RawByteString;
  202. const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
  203. begin
  204. result := -1;
  205. end;
  206. function ExecuteProcess(const Path: UnicodeString; const ComLine: UnicodeString;
  207. Flags: TExecuteFlags = []): Integer;
  208. begin
  209. { TODO : implement }
  210. result := -1;
  211. end;
  212. function ExecuteProcess(const Path: UnicodeString;
  213. const ComLine: Array of UnicodeString; Flags:TExecuteFlags = []): Integer;
  214. var
  215. CommandLine: UnicodeString;
  216. I: integer;
  217. begin
  218. Commandline := '';
  219. for I := 0 to High (ComLine) do
  220. if Pos (' ', ComLine [I]) <> 0 then
  221. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  222. else
  223. CommandLine := CommandLine + ' ' + Comline [I];
  224. ExecuteProcess := ExecuteProcess (Path, CommandLine,Flags);
  225. end;
  226. {****************************************************************************
  227. Initialization code
  228. ****************************************************************************}
  229. Initialization
  230. InitExceptions;
  231. Finalization
  232. DoneExceptions;
  233. end.