/components/lazutils/fileutil.pas

https://github.com/maillen/lazarus · Pascal · 265 lines · 171 code · 36 blank · 58 comment · 0 complexity · 588fef4713d1a907b0728ae13efa39f7 MD5 · raw file

  1. { $Id: fileutil.pas 32656 2011-10-03 15:09:04Z sekelsenmat $ }
  2. {
  3. /***************************************************************************
  4. fileutil.pas
  5. -----------
  6. ***************************************************************************/
  7. *****************************************************************************
  8. * *
  9. * This file is part of the Lazarus Component Library (LCL) *
  10. * *
  11. * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
  12. * for details about the copyright. *
  13. * *
  14. * This program is distributed in the hope that it will be useful, *
  15. * but WITHOUT ANY WARRANTY; without even the implied warranty of *
  16. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
  17. * *
  18. *****************************************************************************
  19. }
  20. unit FileUtil;
  21. {$mode objfpc}{$H+}
  22. interface
  23. uses
  24. SysConst, Classes, SysUtils, Masks, LazUtilsStrConsts, lazutf8;
  25. {$if defined(Windows) or defined(darwin)}
  26. {$define CaseInsensitiveFilenames}
  27. {$endif}
  28. {$IF defined(CaseInsensitiveFilenames) or defined(darwin)}
  29. {$DEFINE NotLiteralFilenames}
  30. {$ENDIF}
  31. const
  32. UTF8FileHeader = #$ef#$bb#$bf;
  33. FilenamesCaseSensitive = {$IFDEF CaseInsensitiveFilenames}false{$ELSE}true{$ENDIF};// lower and upper letters are treated the same
  34. FilenamesLiteral = {$IFDEF NotLiteralFilenames}false{$ELSE}true{$ENDIF};// file names can be compared using = string operator
  35. // file attributes and states
  36. function CompareFilenames(const Filename1, Filename2: string): integer;
  37. function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer;
  38. function CompareFilenames(const Filename1, Filename2: string;
  39. ResolveLinks: boolean): integer;
  40. function CompareFilenames(Filename1: PChar; Len1: integer;
  41. Filename2: PChar; Len2: integer; ResolveLinks: boolean): integer;
  42. function FilenameIsAbsolute(const TheFilename: string):boolean;
  43. function FilenameIsWinAbsolute(const TheFilename: string):boolean;
  44. function FilenameIsUnixAbsolute(const TheFilename: string):boolean;
  45. procedure CheckIfFileIsExecutable(const AFilename: string);
  46. procedure CheckIfFileIsSymlink(const AFilename: string);
  47. function FileIsReadable(const AFilename: string): boolean;
  48. function FileIsWritable(const AFilename: string): boolean;
  49. function FileIsText(const AFilename: string): boolean;
  50. function FileIsText(const AFilename: string; out FileReadable: boolean): boolean;
  51. function FileIsExecutable(const AFilename: string): boolean;
  52. function FileIsSymlink(const AFilename: string): boolean;
  53. function FileIsHardLink(const AFilename: string): boolean;
  54. function FileSize(const Filename: string): int64;
  55. function GetFileDescription(const AFilename: string): string;
  56. function ReadAllLinks(const Filename: string;
  57. ExceptionOnError: boolean): string; // if a link is broken returns ''
  58. function TryReadAllLinks(const Filename: string): string; // if a link is broken returns Filename
  59. // directories
  60. function DirPathExists(const FileName: String): Boolean;
  61. function ForceDirectory(DirectoryName: string): boolean;
  62. function DeleteDirectory(const DirectoryName: string; OnlyChildren: boolean): boolean;
  63. function ProgramDirectory: string;
  64. function DirectoryIsWritable(const DirectoryName: string): boolean;
  65. // filename parts
  66. const
  67. PascalFileExt: array[1..3] of string = ('.pas','.pp','.p');
  68. function ExtractFileNameOnly(const AFilename: string): string;
  69. function ExtractFileNameWithoutExt(const AFilename: string): string;
  70. function CompareFileExt(const Filename, Ext: string; CaseSensitive: boolean): integer; overload;
  71. function CompareFileExt(const Filename, Ext: string): integer; overload;
  72. function FilenameIsPascalUnit(const Filename: string): boolean;
  73. function AppendPathDelim(const Path: string): string;
  74. function ChompPathDelim(const Path: string): string;
  75. function TrimFilename(const AFilename: string): string;
  76. function CleanAndExpandFilename(const Filename: string): string;
  77. function CleanAndExpandDirectory(const Filename: string): string;
  78. function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string;
  79. function CreateRelativePath(const Filename, BaseDirectory: string;
  80. UsePointDirectory: boolean = false): string;
  81. function CreateAbsolutePath(const Filename, BaseDirectory: string): string;
  82. function FileIsInPath(const Filename, Path: string): boolean;
  83. function FileIsInDirectory(const Filename, Directory: string): boolean;
  84. // file search
  85. type
  86. TSearchFileInPathFlag = (
  87. sffDontSearchInBasePath,
  88. sffSearchLoUpCase
  89. );
  90. TSearchFileInPathFlags = set of TSearchFileInPathFlag;
  91. const
  92. AllDirectoryEntriesMask = '*';
  93. function GetAllFilesMask: string;
  94. function GetExeExt: string;
  95. function SearchFileInPath(const Filename, BasePath, SearchPath,
  96. Delimiter: string; Flags: TSearchFileInPathFlags): string;
  97. function SearchAllFilesInPath(const Filename, BasePath, SearchPath,
  98. Delimiter: string; Flags: TSearchFileInPathFlags): TStrings;
  99. function FindDiskFilename(const Filename: string): string;
  100. function FindDiskFileCaseInsensitive(const Filename: string): string;
  101. function FindDefaultExecutablePath(const Executable: string): string;
  102. {$IFDEF darwin}
  103. function GetDarwinSystemFilename(Filename: string): string;
  104. {$ENDIF}
  105. type
  106. { TFileIterator }
  107. TFileIterator = class
  108. private
  109. FPath: String;
  110. FLevel: Integer;
  111. FFileInfo: TSearchRec;
  112. FSearching: Boolean;
  113. function GetFileName: String;
  114. public
  115. procedure Stop;
  116. function IsDirectory: Boolean;
  117. public
  118. property FileName: String read GetFileName;
  119. property FileInfo: TSearchRec read FFileInfo;
  120. property Level: Integer read FLevel;
  121. property Path: String read FPath;
  122. property Searching: Boolean read FSearching;
  123. end;
  124. TFileFoundEvent = procedure (FileIterator: TFileIterator) of object;
  125. TDirectoryFoundEvent = procedure (FileIterator: TFileIterator) of object;
  126. { TFileSearcher }
  127. TFileSearcher = class(TFileIterator)
  128. private
  129. FOnFileFound: TFileFoundEvent;
  130. FOnDirectoryFound: TDirectoryFoundEvent;
  131. procedure RaiseSearchingError;
  132. protected
  133. procedure DoDirectoryEnter; virtual;
  134. procedure DoDirectoryFound; virtual;
  135. procedure DoFileFound; virtual;
  136. public
  137. constructor Create;
  138. procedure Search(const ASearchPath: String; ASearchMask: String = '';
  139. ASearchSubDirs: Boolean = True; AMaskSeparator: char = ';');
  140. public
  141. property OnDirectoryFound: TDirectoryFoundEvent read FOnDirectoryFound write FOnDirectoryFound;
  142. property OnFileFound: TFileFoundEvent read FOnFileFound write FOnFileFound;
  143. end;
  144. function FindAllFiles(const SearchPath: String; SearchMask: String = '';
  145. SearchSubDirs: Boolean = True): TStringList;
  146. function FindAllDirectories(const SearchPath: string;
  147. SearchSubDirs: Boolean = True): TStringList;
  148. // flags for copy
  149. type
  150. TCopyFileFlag = (
  151. cffOverwriteFile,
  152. cffCreateDestDirectory,
  153. cffPreserveTime
  154. );
  155. TCopyFileFlags = set of TCopyFileFlag;
  156. // Copy a file and a whole directory tree
  157. function CopyFile(const SrcFilename, DestFilename: string;
  158. Flags: TCopyFileFlags=[cffOverwriteFile]): boolean;
  159. function CopyFile(const SrcFilename, DestFilename: string; PreserveTime: boolean): boolean;
  160. function CopyDirTree(const SourceDir, TargetDir: string; Flags: TCopyFileFlags=[]): Boolean;
  161. // file actions
  162. function ReadFileToString(const Filename: string): string;
  163. function GetTempFilename(const Directory, Prefix: string): string;
  164. // basic functions similar to the RTL but working with UTF-8 instead of the
  165. // system encoding
  166. // AnsiToUTF8 and UTF8ToAnsi need a widestring manager under Linux, BSD, MacOSX
  167. // but normally these OS use UTF-8 as system encoding so the widestringmanager
  168. // is not needed.
  169. function NeedRTLAnsi: boolean;// true if system encoding is not UTF-8
  170. procedure SetNeedRTLAnsi(NewValue: boolean);
  171. function UTF8ToSys(const s: string): string;// as UTF8ToAnsi but more independent of widestringmanager
  172. function SysToUTF8(const s: string): string;// as AnsiToUTF8 but more independent of widestringmanager
  173. function ConsoleToUTF8(const s: string): string;// converts OEM encoded string to UTF8 (used with some Windows specific functions)
  174. function UTF8ToConsole(const s: string): string;// converts UTF8 string to console encoding (used by Write, WriteLn)
  175. // file operations
  176. function FileExistsUTF8(const Filename: string): boolean;
  177. function FileAgeUTF8(const FileName: string): Longint;
  178. function DirectoryExistsUTF8(const Directory: string): Boolean;
  179. function ExpandFileNameUTF8(const FileName: string): string;
  180. function ExpandUNCFileNameUTF8(const FileName: string): string;
  181. function ExtractShortPathNameUTF8(Const FileName : String) : String;
  182. function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
  183. function FindNextUTF8(var Rslt: TSearchRec): Longint;
  184. procedure FindCloseUTF8(var F: TSearchrec);
  185. function FileSetDateUTF8(const FileName: String; Age: Longint): Longint;
  186. function FileGetAttrUTF8(const FileName: String): Longint;
  187. function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint;
  188. function DeleteFileUTF8(const FileName: String): Boolean;
  189. function RenameFileUTF8(const OldName, NewName: String): Boolean;
  190. function FileSearchUTF8(const Name, DirList : String; ImplicitCurrentDir : Boolean = True): String;
  191. function FileIsReadOnlyUTF8(const FileName: String): Boolean;
  192. function GetCurrentDirUTF8: String;
  193. function SetCurrentDirUTF8(const NewDir: String): Boolean;
  194. function CreateDirUTF8(const NewDir: String): Boolean;
  195. function RemoveDirUTF8(const Dir: String): Boolean;
  196. function ForceDirectoriesUTF8(const Dir: string): Boolean;
  197. function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle;
  198. function FileCreateUTF8(Const FileName : string) : THandle; overload;
  199. function FileCreateUTF8(Const FileName : string; Rights: Cardinal) : THandle; overload;
  200. // environment
  201. function ParamStrUTF8(Param: Integer): string;
  202. function GetEnvironmentStringUTF8(Index: Integer): string;
  203. function GetEnvironmentVariableUTF8(const EnvVar: string): String;
  204. function GetAppConfigDirUTF8(Global: Boolean; Create: boolean = false): string;
  205. function GetAppConfigFileUTF8(Global: Boolean; SubDir: boolean = false;
  206. CreateDir: boolean = false): string;
  207. // other
  208. function SysErrorMessageUTF8(ErrorCode: Integer): String;
  209. implementation
  210. uses
  211. {$IFDEF windows}
  212. Windows;
  213. {$ELSE}
  214. {$IFDEF darwin}
  215. MacOSAll,
  216. {$ENDIF}
  217. Unix, BaseUnix;
  218. {$ENDIF}
  219. {$I fileutil.inc}
  220. {$IFDEF windows}
  221. {$i winfileutil.inc}
  222. {$ELSE}
  223. {$i unixfileutil.inc}
  224. {$ENDIF}
  225. initialization
  226. InitFileUtils;
  227. end.