sysutils.pp 7.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Sysutils unit for BeOS
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  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.
  12. **********************************************************************}
  13. unit sysutils;
  14. interface
  15. {$MODE objfpc}
  16. { force ansistrings }
  17. {$H+}
  18. uses
  19. beos,
  20. dos;
  21. { Include platform independent interface part }
  22. {$i sysutilh.inc}
  23. implementation
  24. uses
  25. sysconst;
  26. { Include platform independent implementation part }
  27. {$i sysutils.inc}
  28. {****************************************************************************
  29. File Functions
  30. ****************************************************************************}
  31. Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
  32. BEGIN
  33. end;
  34. Function FileCreate (Const FileName : String) : longint;
  35. begin
  36. end;
  37. Function FileCreate (Const FileName : String;Mode:longint) : longint;
  38. begin
  39. end;
  40. Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
  41. begin
  42. end;
  43. Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
  44. begin
  45. end;
  46. Function FileSeek (Handle,FOffset,Origin : longint) : longint;
  47. begin
  48. end;
  49. Function FileSeek (Handle:longint;FOffset,Origin : int64) : int64;
  50. begin
  51. end;
  52. Procedure FileClose (Handle : Longint);
  53. begin
  54. end;
  55. Function FileTruncate (Handle,Size: Longint) : boolean;
  56. begin
  57. end;
  58. Function FileAge (Const FileName : String): Longint;
  59. begin
  60. end;
  61. Function FileExists (Const FileName : String) : Boolean;
  62. begin
  63. end;
  64. Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
  65. begin
  66. end;
  67. Function FindNext (Var Rslt : TSearchRec) : Longint;
  68. begin
  69. end;
  70. Procedure FindClose (Var F : TSearchrec);
  71. begin
  72. end;
  73. Function FileGetDate (Handle : Longint) : Longint;
  74. begin
  75. end;
  76. Function FileSetDate (Handle,Age : Longint) : Longint;
  77. begin
  78. end;
  79. Function FileGetAttr (Const FileName : String) : Longint;
  80. begin
  81. end;
  82. Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
  83. begin
  84. end;
  85. Function DeleteFile (Const FileName : String) : Boolean;
  86. begin
  87. end;
  88. Function RenameFile (Const OldName, NewName : String) : Boolean;
  89. begin
  90. end;
  91. {****************************************************************************
  92. Disk Functions
  93. ****************************************************************************}
  94. Function DiskFree(Drive: Byte): int64;
  95. Begin
  96. End;
  97. Function DiskSize(Drive: Byte): int64;
  98. Begin
  99. End;
  100. Function GetCurrentDir : String;
  101. begin
  102. GetDir(0,Result);
  103. end;
  104. Function SetCurrentDir (Const NewDir : String) : Boolean;
  105. begin
  106. {$I-}
  107. ChDir(NewDir);
  108. {$I+}
  109. result := (IOResult = 0);
  110. end;
  111. Function CreateDir (Const NewDir : String) : Boolean;
  112. begin
  113. {$I-}
  114. MkDir(NewDir);
  115. {$I+}
  116. result := (IOResult = 0);
  117. end;
  118. Function RemoveDir (Const Dir : String) : Boolean;
  119. begin
  120. {$I-}
  121. RmDir(Dir);
  122. {$I+}
  123. result := (IOResult = 0);
  124. end;
  125. function DirectoryExists (const Directory: string): boolean;
  126. begin
  127. end;
  128. {****************************************************************************
  129. Misc Functions
  130. ****************************************************************************}
  131. procedure Beep;
  132. begin
  133. end;
  134. {****************************************************************************
  135. Locale Functions
  136. ****************************************************************************}
  137. Procedure GetLocalTime(var SystemTime: TSystemTime);
  138. begin
  139. end ;
  140. Procedure InitAnsi;
  141. Var
  142. i : longint;
  143. begin
  144. { Fill table entries 0 to 127 }
  145. for i := 0 to 96 do
  146. UpperCaseTable[i] := chr(i);
  147. for i := 97 to 122 do
  148. UpperCaseTable[i] := chr(i - 32);
  149. for i := 123 to 191 do
  150. UpperCaseTable[i] := chr(i);
  151. Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  152. for i := 0 to 64 do
  153. LowerCaseTable[i] := chr(i);
  154. for i := 65 to 90 do
  155. LowerCaseTable[i] := chr(i + 32);
  156. for i := 91 to 191 do
  157. LowerCaseTable[i] := chr(i);
  158. Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  159. end;
  160. Procedure InitInternational;
  161. begin
  162. InitAnsi;
  163. end;
  164. function SysErrorMessage(ErrorCode: Integer): String;
  165. begin
  166. Str(Errorcode,Result);
  167. Result:='Error '+Result;
  168. end;
  169. {****************************************************************************
  170. OS utility functions
  171. ****************************************************************************}
  172. Function GetEnvironmentVariable(Const EnvVar : String) : String;
  173. begin
  174. Result:=StrPas(beos.Getenv(PChar(EnvVar)));
  175. end;
  176. Function GetEnvironmentVariableCount : Integer;
  177. begin
  178. // Result:=FPCCountEnvVar(EnvP);
  179. Result:=0;
  180. end;
  181. Function GetEnvironmentString(Index : Integer) : String;
  182. begin
  183. // Result:=FPCGetEnvStrFromP(Envp,Index);
  184. Result:='';
  185. end;
  186. function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
  187. integer;
  188. var
  189. CommandLine: AnsiString;
  190. begin
  191. { always surround the name of the application by quotes
  192. so that long filenames will always be accepted. But don't
  193. do it if there are already double quotes!
  194. }
  195. if pos('"',path)=0 then
  196. CommandLine:='"'+path+'"'
  197. else
  198. CommandLine:=path;
  199. if ComLine <> '' then
  200. CommandLine := Commandline + ' ' + ComLine;
  201. ExecuteProcess := beos.shell (CommandLine);
  202. end;
  203. function ExecuteProcess (const Path: AnsiString;
  204. const ComLine: array of AnsiString): integer;
  205. {$WARNING Should be probably changed according to the Unix version}
  206. var
  207. CommandLine: AnsiString;
  208. I: integer;
  209. begin
  210. Commandline := '';
  211. for I := 0 to High (ComLine) do
  212. if Pos (' ', ComLine [I]) <> 0 then
  213. CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
  214. else
  215. CommandLine := CommandLine + ' ' + Comline [I];
  216. ExecuteProcess := ExecuteProcess (Path, CommandLine);
  217. end;
  218. {****************************************************************************
  219. Initialization code
  220. ****************************************************************************}
  221. Initialization
  222. InitExceptions; { Initialize exceptions. OS independent }
  223. InitInternational; { Initialize internationalization settings }
  224. Finalization
  225. DoneExceptions;
  226. end.
  227. {
  228. $Log$
  229. Revision 1.10 2004-12-11 11:32:44 michael
  230. + Added GetEnvironmentVariableCount and GetEnvironmentString calls
  231. Revision 1.9 2004/02/15 21:26:37 hajny
  232. * overloaded ExecuteProcess added, EnvStr param changed to longint
  233. Revision 1.8 2004/01/20 23:09:14 hajny
  234. * ExecuteProcess fixes, ProcessID and ThreadID added
  235. Revision 1.7 2003/11/26 20:00:19 florian
  236. * error handling for Variants improved
  237. Revision 1.5 2003/03/29 15:16:26 hajny
  238. * dummy DirectoryExists added
  239. Revision 1.4 2003/01/08 21:56:54 marco
  240. * small fixes to prototypes to compile it
  241. Revision 1.3 2002/09/07 16:01:17 peter
  242. * old logs removed and tabs fixed
  243. }