filutil.inc 6.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. File utility calls
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
  13. Var LinuxFlags : longint;
  14. BEGIN
  15. LinuxFlags:=0;
  16. Case (Mode and 3) of
  17. 0 : LinuxFlags:=LinuxFlags or Open_RdOnly;
  18. 1 : LinuxFlags:=LinuxFlags or Open_WrOnly;
  19. 2 : LinuxFlags:=LinuxFlags or Open_RdWr;
  20. end;
  21. FileOpen:=fdOpen (FileName,LinuxFlags);
  22. //!! We need to set locking based on Mode !!
  23. end;
  24. Function FileCreate (Const FileName : String) : Longint;
  25. begin
  26. FileCreate:=fdOpen(FileName,Open_RdWr or Open_Creat or Open_Trunc);
  27. end;
  28. Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
  29. begin
  30. FileRead:=fdRead (Handle,Buffer,Count);
  31. end;
  32. Function FileWrite (Handle : Longint; Var Buffer; Count : Longint) : Longint;
  33. begin
  34. FileWrite:=fdWrite (Handle,Buffer,Count);
  35. end;
  36. Function FileSeek (Handle,Offset,Origin : Longint) : Longint;
  37. begin
  38. FileSeek:=fdSeek (Handle,Offset,Origin);
  39. end;
  40. Procedure FileClose (Handle : Longint);
  41. begin
  42. fdclose(Handle);
  43. end;
  44. Function FileTruncate (Handle,Size: Longint) : boolean;
  45. begin
  46. FileTruncate:=fdtruncate(Handle,Size);
  47. end;
  48. Function FileAge (Const FileName : String): Longint;
  49. Var Info : Stat;
  50. Y,M,D,hh,mm,ss : word;
  51. begin
  52. If not fstat (FileName,Info) then
  53. exit(-1)
  54. else
  55. begin
  56. EpochToLocal(info.mtime,y,m,d,hh,mm,ss);
  57. Result:=DateTimeToFileDate(EncodeDate(y,m,d)+EncodeTime(hh,mm,ss,0));
  58. end;
  59. end;
  60. Function FileExists (Const FileName : String) : Boolean;
  61. Var Info : Stat;
  62. begin
  63. FileExists:=fstat(filename,Info);
  64. end;
  65. Function LinuxToWinAttr (FN : Char; Const Info : Stat) : Longint;
  66. begin
  67. Result:=faArchive;
  68. If FN='.' then
  69. Result:=Result or faHidden;
  70. If (Info.Mode and STAT_IFDIR)=STAT_IFDIR then
  71. Result:=Result or faDirectory;
  72. If (Info.Mode and STAT_IWUSR)=0 Then
  73. Result:=Result or faReadOnly;
  74. If (Info.Mode and
  75. (STAT_IFSOCK or STAT_IFBLK or STAT_IFCHR or STAT_IFIFO))<>0 then
  76. Result:=Result or faSysFile;
  77. end;
  78. {
  79. GlobToSearch takes a glob entry, stats the file.
  80. The glob entry is removed.
  81. If FileAttributes match, the entry is reused
  82. }
  83. Function GlobToTSearchRec (Var Info : TSearchRec) : Boolean;
  84. Var SInfo : Stat;
  85. p : Pglob;
  86. TAttr : Longint;
  87. begin
  88. TAttr:=$ffffffff;
  89. P:=pglob(Info.FindHandle);
  90. Result:=P<>Nil;
  91. If Result then
  92. begin
  93. Info.FindHandle:=Longint(P^.Next);
  94. Result:=Fstat(p^.name,SInfo);
  95. If Result then
  96. begin
  97. Info.Attr:=LinuxToWinAttr(p^.name[0],SInfo);
  98. Result:=(Info.ExcludeAttr and TAttr)<>0;
  99. If Result Then
  100. With Info do
  101. begin
  102. Attr:=Info.Attr;
  103. If P^.Name<>Nil then
  104. Name:=strpas(p^.name);
  105. Time:=Sinfo.mtime;
  106. Size:=Sinfo.Size;
  107. end;
  108. end;
  109. P^.Next:=Nil;
  110. GlobFree(P);
  111. end;
  112. end;
  113. Function DoFind(Var Rslt : TSearchRec) : Longint;
  114. begin
  115. Result:=-1;
  116. If Rslt.FindHandle<>0 then
  117. While (Rslt.FindHandle<>0) and not (Result=0) do
  118. If GlobToTSearchRec(Rslt) Then Result:=0;
  119. end;
  120. Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
  121. begin
  122. Rslt.ExcludeAttr:=Attr; //!! Not correct !!
  123. Rslt.FindHandle:=Longint(Glob(Path));
  124. Result:=DoFind (Rslt);
  125. end;
  126. Function FindNext (Var Rslt : TSearchRec) : Longint;
  127. begin
  128. Result:=DoFind (Rslt);
  129. end;
  130. Procedure FindClose (Var F : TSearchrec);
  131. begin
  132. GlobFree (PGlob(F.FindHandle));
  133. end;
  134. Function FileGetDate (Handle : Longint) : Longint;
  135. Var Info : Stat;
  136. begin
  137. If Not(FStat(Handle,Info)) then
  138. Result:=-1
  139. else
  140. Result:=Info.Mtime;
  141. end;
  142. Function FileSetDate (Handle,Age : Longint) : Longint;
  143. begin
  144. // Impossible under Linux from FileHandle !!
  145. FileSetDate:=-1;
  146. end;
  147. Function FileGetAttr (Const FileName : String) : Longint;
  148. Var Info : Stat;
  149. begin
  150. If Not FStat (FileName,Info) then
  151. Result:=-1
  152. Else
  153. Result:=LinuxToWinAttr(FileName[1],Info);
  154. end;
  155. Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
  156. begin
  157. Result:=-1;
  158. end;
  159. Function DeleteFile (Const FileName : String) : Boolean;
  160. begin
  161. Result:=UnLink (FileName);
  162. end;
  163. Function RenameFile (Const OldName, NewName : String) : Boolean;
  164. begin
  165. RenameFile:=Linux.FRename(OldNAme,NewName);
  166. end;
  167. Function FileSearch (Const Name, DirList : String) : String;
  168. begin
  169. FileSearch:=Linux.FSearch(Name,Dirlist);
  170. end;
  171. Procedure GetLocalTime(var SystemTime: TSystemTime);
  172. begin
  173. linux.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second);
  174. linux.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
  175. SystemTime.MilliSecond := 0;
  176. end ;
  177. Procedure InitAnsi;
  178. Var i : longint;
  179. begin
  180. { Fill table entries 0 to 127 }
  181. for i := 0 to 96 do
  182. UpperCaseTable[i] := chr(i);
  183. for i := 97 to 122 do
  184. UpperCaseTable[i] := chr(i - 32);
  185. for i := 123 to 191 do
  186. UpperCaseTable[i] := chr(i);
  187. Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  188. for i := 0 to 64 do
  189. LowerCaseTable[i] := chr(i);
  190. for i := 65 to 90 do
  191. LowerCaseTable[i] := chr(i + 32);
  192. for i := 91 to 191 do
  193. LowerCaseTable[i] := chr(i);
  194. Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
  195. end;
  196. Procedure InitInternational;
  197. begin
  198. InitAnsi;
  199. end;
  200. {
  201. $Log$
  202. Revision 1.12 2000-01-07 16:41:40 daniel
  203. * copyright 2000
  204. Revision 1.11 1999/05/14 22:19:34 michael
  205. * Some more fixes.
  206. Revision 1.10 1999/05/13 21:54:09 michael
  207. * Fixed FileAge and corrected FileGetAttr
  208. Revision 1.9 1999/04/08 11:31:01 peter
  209. * removed warnings
  210. Revision 1.8 1999/02/28 13:18:10 michael
  211. + Added internationalization support
  212. Revision 1.7 1999/02/24 15:57:29 michael
  213. + Moved getlocaltime to system-dependent files
  214. Revision 1.6 1999/02/04 21:43:08 michael
  215. FileCreate must truncate the file
  216. Revision 1.5 1999/02/02 21:20:34 michael
  217. + Added filetruncate, corrected FileCreate
  218. Revision 1.4 1998/12/15 22:43:07 peter
  219. * removed temp symbols
  220. Revision 1.3 1998/11/10 14:57:55 peter
  221. * renamed rename -> FRename
  222. Revision 1.2 1998/10/13 10:20:07 peter
  223. * fix for 0.99.8 which has no auto pchar-string ;)
  224. Revision 1.1 1998/10/11 12:21:01 michael
  225. Added file calls. Implemented for linux only
  226. }