{ $Id$ Unit to access the file system All file operations except those on open files (see FileCtrl for that) Copyright by Marco Schmidt This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ****************************************************************************} unit FileSys; interface {$I platform.inc} { Conditional directives : compiler, operating system } uses ApiComm { Error handling } {$IFDEF PPC_FPC} , Strings {$ENDIF} {$IFDEF OS_DOS} , DOS { GetFAttr, GetFTime, FindFirst, FindNext, ... } {$else not OS_DOS} {$ifdef PPC_FPC} {$ifdef OS_WINDOWS} {$define OS_DOS} , DOS {$endif OS_WIN32} {$endif PPC_FPC} {$ENDIF} {$IFDEF OS_LINUX} , linux {$ENDIF} ; const { Maximum length of a file name (must be <= 255, for we use standard Pascal strings) } MaxNameLength = {$IFDEF PPC_BP} 79; {$ELSE} 255; {$ENDIF} { Character to separate directories in a path } PathSeparator = {$IFDEF OS_Linux} '/'; {$ELSE} '\'; {$ENDIF} { Defines if a character is inserted into a number string every three digits; true : returns "3,555,234" false : returns "3555234" } SeparateThousands : Boolean = true; { Character to be used to separate three digits in FileIntToString } ThousandsSeparator : Char = ','; { "CheckName" function return values } cnUnknown = 0; cnFile = 1; cnDirectory = 2; { File attribute bit masks } faReadOnly = $0001; faSystem = $0002; faHidden = $0004; faVolumeID = $0008; faDirectory = $0010; faArchive = $0020; faAnyFile = faReadOnly or faSystem or faHidden or faVolumeID or faDirectory or faArchive; { = $003f } { Wildcard characters for use with "ContainsWildcards" } NumWildcardChars = 2; WildcardChars : Array[0..NumWildcardChars-1] of Char = ('*', '?'); type { file attribute type } TFileAttr = {$IFDEF PPC_BP} Word; { DOS: RSHVAD } {$ELSE} Longint; { Any other OS } {$ENDIF} { Stores date and time in a system-independent way } TDateTime = packed record DOW : Byte; { 0=Sunday, 1=Monday, ... } Day : Byte; { 1..31 } Month : Byte; { 1..12 } Year : Word; { 1601..3999 } IsLeap : Boolean; { is "Year" a leap year ? } Hour : Byte; { 0..23 } Minute : Byte; { 0..59 } Second : Byte; { 0..59 } Valid : Boolean; { set by "CheckDateTime" } end; { Stores file size & offset values; may have to be changed for other environments } TFileInt = Longint; { 32 bit signed, as we have no unsigned 32 bit type } { directory / file name } TFileName = String[MaxNameLength]; { record to describe a file or directory entry; used in combination with a file search } TFileDescriptor = packed record { fields available for all platforms } Attr : TFileAttr; IsDirectory : Boolean; LastModification : TDateTime; Name : TFileName; Size : TFileInt; { platform-specific fields } {$IFDEF OS_LINUX} Created : TDateTime; LastAccessed : TDateTime; {$ENDIF OS_LINUX} end; { Search record declaration for FPC for DOS (we're not using the DOS unit that provides SearchRec) } {$IFDEF PPC_FPC} {$IFDEF OS_DOS} type TDOSSearchRec = packed record Fill: Array[1..21] of Byte; Attr: Byte; Time: Longint; Reserved: Word; { requires the DOS extender (DJ GNU-C) } Size: Longint; Name: String[15]; { the same size as declared by (DJ GNU C) } end; {$ENDIF OS_DOS} {$ENDIF PPC_FPC} { File search record to be used with StartSearch, ContinueSearch and TerminateSearch } TFileSearch = packed record { Input fields for all platforms } Specs : TFileName; { OS-specific input fields } {$IFDEF OS_DOS} Attr : TFileAttr; {$ENDIF} { Output fields for all platforms } FD : TFileDescriptor; Success : Boolean; { OS-specific output fields } {$IFDEF OS_Linux} GL : PGlob; {$ELSE OS_Linux} SR : DOS.SearchRec; {$ENDIF OS_Linux} end; procedure CheckDateTime(var DT: TDateTime); function CheckName(AName: TFileName): Byte; function ContainsWildcards(AName: TFileName): Boolean; procedure ContinueSearch(var FS: TFileSearch); procedure CreateDir(AName: TFileName); function DateToString(const DT: TDateTime): String; procedure DeleteDir(AName: TFileName); procedure DeleteFile(AName: TFileName); function EqualNames(Name1, Name2: TFileName): Boolean; function Exists(AName: TFileName): Boolean; function ExpandName(AName: TFileName): TFileName; function FileAttrToString(AFileAttr: TFileAttr): String; function FileIntToString(FI: TFileInt): String; function GetCurrentDir: TFileName; procedure GetFAttr(AName: TFileName; var Attr: TFileAttr); procedure GetFTime(AName: TFileName; var DT: TDateTime); function IsValidName(AName: TFileName) : Boolean; procedure RenameDir(OldName, NewName: TFileName); procedure RenameFile(OldName, NewName: TFileName); procedure SetCurrentDir(AName: TFileName); procedure SetFAttr(AName: TFileName; AFileAttr: TFileAttr); procedure SetFTime(AName: TFileName; DT: TDateTime); procedure SplitName(AName: TFileName; var Path, RawName, Extension: TFileName); procedure StartSearch(var FS: TFileSearch); procedure TerminateSearch(var FS: TFileSearch); function TimeToString(DT: TDateTime): String; implementation { Structure of the implementation section --------------------------------------- - proc. & functions that do not appear in the interface section and are the same for all platforms - proc. & functions that do appear in the interface section and are the same for all platforms - proc. & functions that do not appear in the interface section and are DOS-specific - proc. & functions that do appear in the interface section and are not the same for all platforms } { procedures and functions that do not appear in the interface section and are the same for all platforms } function weekday(y,m,d : longint) : longint; { Calculates th day of the week. Florian provided this. returns -1 on error } var century_offset : integer; temp : longint; _is_leap_year : boolean; const month_table : array[1..12] of longint = (1,4,4,0,2,5,0,3,6,1,4,6); function is_leap_year(y : longint) : boolean; begin if (y mod 100)=0 then is_leap_year:=((y mod 400)=0) else is_leap_year:=(y mod 4)=0; end; { Beginning of weekday } begin if (m<1) or (m>12) then begin weekday:=-1; exit; end; case y of 1700..1799 : century_offset:=4; 1800..1899 : century_offset:=2; 1900..1999 : century_offset:=0; 2000..2099 : century_offset:=-1; else begin if (y>=2100) then begin end; weekday:=-1; exit; end; end; _is_leap_year:=is_leap_year(y); y:=y mod 100; temp:=(y div 12)+(y mod 12)+((y mod 12) div 4); temp:=temp mod 7; temp:=(temp+month_table[m]+d) mod 7; { do some corrections for special years } { other century ? } inc(temp,century_offset); { leap year correction } if _is_leap_year and (m<3) then dec(temp); { now is sonday 1, but should be for example 0 } dec(temp); { the result could be less than zero } while temp<0 do inc(temp,7); weekday:=temp mod 7; end; { Returns Longint value as String } function LongToStr(L: Longint): String; var S: String[20]; begin System.Str(L, S); LongToStr := S; end; { Returns Longint value as String, adding a leading '0' character if value is >= 0 and <= 9 (LZ = leading zero) } function LongToStrLZ(L: Longint): String; var Z: String[1]; begin if (L >= 0) and (L <= 9) then Z := '0' else Z := ''; LongToStrLZ := Z + LongToStr(L); end; { Procedures and functions that do appear in the interface section and are the same for all platforms } { Checks if date and time in "dt" is valid; also determines the day of the week } procedure CheckDateTime(var DT: TDateTime); const MonthLength : array[1..12] of Byte = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); begin DT.Valid := false; { check data that is within a fixed range } with DT do if (Hour < 0) or (Hour > 23) or (Minute < 0) or (Minute > 59) or (Second < 0) or (Second > 59) or (Month < 1) or (Month > 12) or (Day < 1) or (Year < 1600) or (Year > 3999) then exit; { determine if year is leap year } DT.IsLeap := ((dt.Year mod 4) = 0) and (not (((dt.Year mod 100) = 0) and ((dt.Year mod 400) <> 0))); { check if day is within limits } if ( DT.IsLeap and (dt.Month = 2) and (dt.Day > 29)) or ((not dt.IsLeap) and (dt.Day > MonthLength[dt.Month])) then exit; { date seems to be alright, compute day of the week (formula taken from DDJ 06/95 [#231], p.11) } if weekday (dt.year,dt.month,dt.day)<0 then dt.dow:=0 else dt.dow:=weekday(dt.year,dt.month,dt.day); { Removed - caused segfault in linux. Michael. dt.DOW := (((( 3 * (dt.Year) - ( 7 * ((dt.Year) + ((dt.Month)+9) div 12)) div 4 + (23 * (dt.Month)) div 9 + (dt.Day) + 2 + (((dt.Year) - Ord ((dt.Month) < 3)) div 100 + 1) * 3 div 4 - 16 ) + 1 ) mod 7)); } dt.Valid := true; end; { Returns if AName contains at least one of the characters from global constant WildcardChars } function ContainsWildcards(AName: TFileName): Boolean; var I, J: Longint; begin ContainsWildcards := false; if (Length(AName) = 0) then exit; { compare each character in AName with each character in WildCards } for I := 1 to Length (AName) do for J := 0 to NumWildcardChars-1 do if (AName[I] = WildcardChars[J]) then begin ContainsWildcards := true; exit; end; end; { Returns date part of TDateTime as String : "Tue 29 Jul 1997" } function DateToString(const DT: TDateTime): String; const DOWNames : array[0..6] of String[3] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); MonthNames : array[1..12] of String[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); begin if DT.Valid then DateToString := DOWNames [dt.DOW] + ' ' + LongToStrLZ (dt.Day) + ' ' + MonthNames [dt.Month] + ' ' + LongToStr (dt.Year) else DateToString := ''; end; { Returns if two names are considered equal for the file system } function EqualNames(Name1, Name2: TFileName): Boolean; {$IFDEF OS_DOS} var I: Byte; begin { case-insensitive comparision of strings } EqualNames := false; if (Length(Name1) <> Length(Name2)) or (Length(Name1) = 0) then exit; for I := 1 to Length(Name1) do if (Upcase(Name1[I]) <> Upcase(Name2[I])) then exit; EqualNames := true; end; {$ELSE} begin { case-sensitive comparision of strings } EqualNames := (Name1 = Name2); end; {$ENDIF} { Returns if name "AName" is in use (as file or directory) } function Exists(AName: TFileName): Boolean; begin Exists := (CheckName (AName) <> cnUnknown); end; { Splits AName into its path, raw name and extension; example: "c:\pp\fv\archive.zip" will be split into path "c:\pp\fv\", raw name "archive" and extension "zip" } procedure SplitName(AName: TFileName; var Path, RawName, Extension: TFileName); var HasDot, HasSeparator: Boolean; I, NameLength, DotOffset, SeparatorOffset: Longint; begin NameLength := Length(AName); Path := ''; RawName := ''; Extension := ''; { search for last separator in name } SeparatorOffset := -1; HasSeparator := false; I := NameLength; while (I > 0) and (not HasSeparator) do begin if (AName[i] = PathSeparator) then begin HasSeparator := true; SeparatorOffset := I; end; Dec(I); end; if HasSeparator then begin Path := System.Copy(AName, 1, SeparatorOffset); SeparatorOffset := SeparatorOffset + 1; end else SeparatorOffset := 1; I := SeparatorOffset; { search for last dot in name (not in path / think of 'dir/files.old/filename') } HasDot := false; while (I <= NameLength) do begin if (AName[I] = '.') then begin HasDot := true; DotOffset := I; end; Inc(I); end; if HasDot then begin RawName := System.Copy (AName, SeparatorOffset, DotOffset-SeparatorOffset); Extension := System.Copy (AName, DotOffset + 1, NameLength - DotOffset); end else begin { no extension } RawName := System.Copy (AName, SeparatorOffset, NameLength - SeparatorOffset); end; end; { Returns time part of "DT" as "23:04:38" } function TimeToString(DT: TDateTime): String; begin if DT.Valid then TimeToString := LongToStrLZ(DT.Hour) + ':' + LongToStrLZ(DT.Minute) + ':' + LongToStrLZ(DT.Second) else TimeToString := ''; end; {$IFDEF OS_DOS} { procedures & functions for the DOS platform } { Functions and procedures not declared in the interface section } { Returns date part of dt in DOS format, as unsigned 16 bit integer } procedure GetDOSDate(DT: TDateTime; var W: Word); begin W := (DT.Day and $1f) or ((DT.Month and $f) shl 5) or (((DT.Year - 1980) and $7f) shl 9); end; { Returns time part of DT in DOS format, as unsigned 16 bit integer } procedure GetDOSTime(DT: TDateTime; var W: Word); begin W := ((DT.Second shr 1) and $1f) or ((DT.Minute and $3f) shl 5) or ((DT.Hour and $1f) shl 11); end; { Returns date and time as 32 bit integer value (DOS time format) } procedure GetDOSDateTime(DT : TDateTime; var L: Longint); var W: Word; begin GetDOSTime(DT, W); L := W; GetDOSDate(DT, W); L := L + (W * 65536); { shifting by 16 doesn't work everywhere ... } end; { Sets date part of DT to W } procedure SetDOSDate(W: Word; var DT: TDateTime); begin DT.Day := W and $1f; DT.Month := (W shr 5) and $f; DT.Year := 1980 + (W shr 9) and $7f; end; { Sets time part of DT to W } procedure SetDOSTime(W: Word; var DT: TDateTime); begin DT.Second := (W and $1f) shl 1; DT.Minute := (W shr 5) and $3f; DT.Hour := (W shr 11) and $1f; end; { Sets DT to data from L } procedure SetDOSDateTime(L: Longint; var DT: TDateTime); begin SetDOSTime(L mod 65536, DT); SetDOSDate(L div 65536, DT); end; { Converts DOS.SearchRec to TFileDesciptor } procedure SearchRecToFileDescriptor ( SR: DOS.SearchRec; var FD: TFileDescriptor); begin FD.Name := SR.Name; FD.Attr := SR.Attr; FD.Size := SR.Size; FD.IsDirectory := ((SR.Attr and faDirectory) <> 0); SetDOSDateTime(SR.Time, FD.LastModification); CheckDateTime(FD.LastModification); end; {$ENDIF} { OS_DOS } {$IFDEF OS_LINUX} { Functions and procedures not decalred in interface section, Linux operating system } Procedure EpochToDateTime (Epoch : Longint; var DT : TDateTime); { Returns a Checked datetime, starting from a Unix epoch-style time } var y,m,d,h,mi,s : integer; { needed because of call by var } begin Linux.EpochToLocal(Epoch,Y,M,D,h,mi,s); DT.Year :=y; DT.Month :=m; DT.Day :=d; DT.Hour :=h; DT.Minute :=mi; DT.Second :=s; CheckDateTime (DT); end; Procedure StatToFileDescriptor (Info : Stat; Var Fd : TFileDescriptor); {Starting from a stat record, returns a TFileDescriptor record. Name is not filled in !} begin Fd.Attr:=Info.Mode; Fd.IsDirectory:=S_ISDIR(Info.mode); EpochToDateTime(Info.Mtime,Fd.LastModification); EpochToDateTime(Info.Atime,Fd.LastAccessed); EpochToDateTime(Info.Ctime,Fd.Created); Fd.Size:=Info.size; end; {$ENDIF} {OS_LINUX} { Functions and procedures declared in the interface section } { Returns type of name as cnXXXX constant (unknown, file, directory) } function CheckName(AName: TFileName): Byte; var FS: TFileSearch; begin FS.Specs := AName; {$IFDEF OS_DOS} FS.Attr := faAnyFile; {$ENDIF} StartSearch(fs); if FS.Success then begin if FS.FD.IsDirectory then CheckName := cnDirectory else CheckName := cnFile; end else CheckName := cnUnknown; TerminateSearch(FS); end; { Continues a file search started by StartSearch } procedure ContinueSearch(var FS: TFileSearch); {$IFDEF OS_Linux} Var g : PGLob; info : stat; begin if Not FS.Success then exit; FS.Success:=False; if FS.GL=nil then exit; { Paranoia setting } g:=FS.GL; FS.GL:=FS.GL^.NEXT; strdispose(g^.name); dispose (g); If FS.GL=Nil then exit; linux.fstat(strpas(FS.GL^.Name),info); if linuxerror<>0 then begin StatToFileDescriptor (info,FS.FD); FS.FD.Name:=strpas(FS.GL^.Name); FS.Success:=True; end; end; {$ELSE OS_Linux} begin if fs.Success then begin DOS.FindNext(FS.SR); FS.Success := (DOS.DOSError = 0); if FS.Success then SearchRecToFileDescriptor(fs.sr, fs.fd); end; end; {$ENDIF OS_Linux} { Create a new subdirectory AName } procedure CreateDir(AName : TFileName); begin {$I-} System.MkDir(AName); {$I+} ErrorCode := System.IOResult; end; { Deletes the directory AName } procedure DeleteDir(AName : TFileName); begin {$I-} System.RmDir(AName); {$I+} ErrorCode := System.IOResult; end; { Deletes the file AName } procedure DeleteFile(AName: TFileName); var F: file; begin Assign(F, AName); {$I-} System.Erase(F); {$I+} ErrorCode := System.IOResult; end; { Returns the full version of AName } function ExpandName(AName : TFileName): TFileName; begin {$IFDEF OS_LINUX} ExpandName := Linux.FExpand(AName); {$ELSE} ExpandName := DOS.FExpand(AName); {$ENDIF} end; { Returns a string version of AFileAttr; OS-dependent } function FileAttrToString(AFileAttr: TFileAttr): String; {$IFDEF OS_DOS} { Volume Label and Directory are not regarded } const NumChars = 4; AttrChars: String[NumChars] = 'RSHA'; AttrMasks: Array[0..NumChars-1] of Word = (1, 2, 4, 32); var I: Word; S: String[NumChars]; begin s[0] := Chr(NumChars); for I := 1 to NumChars do begin if ((AFileAttr and AttrMasks[i-1]) = 0) then S[I] := '.' else S[I] := AttrChars[i]; end; FileAttrToString := S; end; {$ELSE OS_DOS} {$IFDEF OS_LINUX} var temp : string[9]; i : longint; const full = 'rwxrwxrwx'; begin temp:='---------'; for i:=0 to 8 do if (AFileAttr and (1 shl i))=(1 shl I) then temp[9-i]:=full[9-i]; FileAttrToString := Temp; end; {$ELSE OS_LINUX} begin FileAttrToString:=''; end; {$ENDIF OS_LINUX} {$ENDIF OS_DOS} { Returns a string version of the file integer value fi } function FileIntToString(fi: TFileInt): String; var S: String[14]; { maximum is "-2,147,483,648" } I: Integer; { must be signed ! } begin Str(fi, S); if SeparateThousands then begin I := System.Length(S) - 2; while (I > 1) and (not (I = 2) and (s[1] = '-')) do begin System.Insert (ThousandsSeparator, S, I); Dec(I, 3); end; end; FileIntToString := S; end; { Returns the currently set directory } function GetCurrentDir: TFileName; {$IFDEF PPC_BP} var I: Byte; R: DOS.Registers; S: TFileName; begin { to get a full name, we have to get the drive letter ourselves } { get current drive letter first } R.AH := $19; DOS.MsDos(R); S[1] := Chr(Ord('A') + R.AL); S[2] := ':'; S[3] := '\'; { get current directory } R.AH := $47; R.DL := $00; R.DS := Seg(S[4]); R.SI := Ofs(S[4]); DOS.MsDos (r); if ((R.Flags and FCarry) <> 0) then begin { error } end; { determine length of current directory } I := 4; while (S[I] <> #0) and (I < MaxNameLength) do Inc(I); S[0] := Chr(I - 1); GetCurrentDir := S; end; {$ELSE} var S: TFileName; begin System.GetDir(0, S); GetCurrentDir := S; end; {$ENDIF} { Gets attribute of AName } procedure GetFAttr(AName: TFileName; var Attr: TFileAttr); {$IFDEF OS_DOS} var F: file; W: word; begin Assign(F, AName); {$I-} DOS.GetFAttr(F, W); Attr:=W; {$I+} ErrorCode := DOS.DOSError; end; {$ELSE} {$IFDEF OS_LINUX} var info : stat; begin Linux.FStat (AName,Info); ErrorCode:=LinuxError; if ErrorCode<>0 then exit; Attr:=Info.Mode; end; {$ELSE} begin end; {$ENDIF} {$ENDIF} { Gets date and time of last modification of AName } procedure GetFTime(AName: TFileName; var DT: TDateTime); {$IFDEF OS_DOS} var F: file; L: Longint; begin DT.Valid := false; { open file } Assign(F, AName); {$I-} Reset(F); {$I+} ErrorCode := System.IOResult; if (ErrorCode <> errOK) then exit; { get date/time of last modification in DOS format } {$I-} DOS.GetFTime(F, L); {$I+} ErrorCode := DOS.DOSError; if (ErrorCode <> errOK) then exit; { close file } {$I-} Close(F); {$I+} ErrorCode := System.IOResult; { convert date/time L to TDateTime format } GetDOSDateTime(DT, L); CheckDateTime(DT); end; {$ELSE} {$IFDEF OS_LINUX} var info : Stat; begin Linux.FStat (AName,Info); ErrorCode:=LinuxError; if ErrorCode<>0 then exit; EpochToDateTime (info.mtime,DT); end; {$ELSE} begin end; {$ENDIF} {$ENDIF} { Returns if AName is a valid file name (not if it actually exists) } function IsValidName(AName: TFileName): Boolean; {$IFDEF OS_DOS} { isn't ready yet } { Returns if a name (without a path) is valid } function ValidName(S: TFileName): Boolean; var I: Byte; begin ValidName := false; if (Length(S) > 12) then exit; I := Pos('.', S); ValidName := true; end; const InvalidChars: String[2] = '*?'; var I, J: Longint; P, R, E: TFileName; begin IsValidName := false; { check for invalid characters } for I := 1 to Length(AName) do for J := 1 to Length(InvalidChars) do if (AName[I] = InvalidChars[J]) then exit; SplitName(AName, P, R, E); if (Length(R) > 0) or (Length(E) > 0) then begin if (not ValidName(R + E)) then exit; end; IsValidName := true; end; {$ELSE} {$IFDEF OS_LINUX} begin IsVAlidName:=((pos('?',AName)=0) and (pos('*',AName)=0)) end; {$ELSE} begin IsValidName:=True; end; {$ENDIF} {$ENDIF} { Renames directory from OldName to NewName } procedure RenameDir(OldName, NewName : TFileName); begin { for DOS, renaming files and directories should be the same ... } RenameFile(OldName, NewName); end; { Renames file from OldName to NewName } procedure RenameFile(OldName, NewName : TFileName); var F: file; begin Assign(F, OldName); {$I-} System.Rename(F, NewName); {$I+} ErrorCode := IOResult; end; { Sets current directory to AName } procedure SetCurrentDir(AName : TFileName); begin {$I-} System.ChDir(AName); {$I+} ErrorCode := IOResult; end; { Sets attribute of file AName to AFileAttr } procedure SetFAttr(AName: TFileName; AFileAttr: TFileAttr); {$IFDEF OS_DOS} var F: file; begin Assign(F, AName); {$I-} DOS.SetFAttr(F, AFileAttr); {$I+} ErrorCode := DOS.DOSError; end; {$ELSE} {$IFDEF OS_LINUX} begin Linux.Chmod (Aname,AFileAttr); ErrorCode:=LinuxError; end; {$ELSE} begin end; {$ENDIF} {$ENDIF} { Sets date and time of last modification of file AName to dt } procedure SetFTime(AName: TFileName; DT: TDateTime); {$IFDEF OS_DOS} var F: file; L: Longint; begin GetDOSDateTime(DT, L); Assign(f, AName); {$I-} DOS.SetFTime(F, L); {$I+} ErrorCode := DOS.DOSError; end; {$ELSE} {$IFDEF OS_LINUX} var utim : utimebuf; begin utim.actime:=LocalToEpoch(DT.Year,DT.Month,DT.Day,DT.Hour,DT.Minute,DT.second); utim.modtime:=utim.actime; utime (AName,utim); ErrorCode:=linuxerror end; {$ELSE} begin end; {$ENDIF} {$ENDIF} { Starts a file search, using input data from fs } procedure StartSearch(var FS: TFileSearch); {$IFDEF OS_Linux} var info : stat; begin FS.Success:=False; FS.GL:=Linux.Glob(FS.Specs); if FS.GL=nil then exit; linux.fstat(strpas(FS.GL^.Name),info); if linuxerror=0 then begin StatToFileDescriptor (info,FS.FD); FS.FD.Name:=strpas(FS.GL^.Name); FS.Success:=True; end; end; {$ELSE OS_Linux} { this version works for every platform/os/bits combination that has a working DOS unit : BP/FPC/Virtual Pascal } begin DOS.FindFirst(fs.Specs, fs.Attr, fs.sr); fs.Success := (DOS.DOSError = 0); if fs.Success then SearchRecToFileDescriptor(FS.SR, FS.FD); end; {$ENDIF OS_Linux} { Terminates a file search } procedure TerminateSearch (var FS: TFileSearch); begin {$IFDEF OS_LINUX} GlobFree (FS.GL); {$ELSE} {$IFNDEF PPC_BP} DOS.FindClose(fs.sr); {$ENDIF} {$ENDIF} end; { Unit initialization } begin { Empty, though we could retrieve the thousands separator and date/time formats here (in case the OS supports that) } end. { $Log$ Revision 1.2 2000-02-29 11:43:16 pierre Common renamed APIComm to avoid problems with free vision Revision 1.1 2000/01/06 01:20:31 peter * moved out of packages/ back to topdir Revision 1.1 1999/12/23 19:36:47 peter * place unitfiles in target dirs Revision 1.1 1999/11/24 23:36:37 peter * moved to packages dir Revision 1.4 1999/05/17 13:55:18 pierre * FPC win32 also need dos unit Revision 1.3 1999/04/13 09:25:47 daniel * Reverted a terrible mistake Revision 1.1 1998/12/04 12:48:24 peter * moved some dirs Revision 1.5 1998/10/26 11:22:50 peter * updates ? 0.1 marco Initial implementation ? Several fixes ... 08/29/1997 0.4 marco Some platform adjustments 09/16/1997 0.4.1 marco Added "EqualNames" 09/17/1997 0.5 michael Implemented linux part. 09/20/1997 0.5.1 marco Added LastAccessed/Created to Linux part of file descriptor 04/15/1998 0.5.2 michael Updated linux part. }