/components/codetools/fileprocs.pas
Pascal | 2547 lines | 2137 code | 176 blank | 234 comment | 175 complexity | 7ecf9f316da6673ef722294bbe45aa2a MD5 | raw file
Large files files are truncated, but you can click here to view the full file
1{ 2 *************************************************************************** 3 * * 4 * This source is free software; you can redistribute it and/or modify * 5 * it under the terms of the GNU General Public License as published by * 6 * the Free Software Foundation; either version 2 of the License, or * 7 * (at your option) any later version. * 8 * * 9 * This code is distributed in the hope that it will be useful, but * 10 * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 * General Public License for more details. * 13 * * 14 * A copy of the GNU General Public License is available on the World * 15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 * obtain it by writing to the Free Software Foundation, * 17 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * 18 * * 19 *************************************************************************** 20 21 Author: Mattias Gaertner 22 23 Abstract: 24 - simple file functions and fpc additions 25 - all functions are thread safe unless explicitely stated 26} 27unit FileProcs; 28 29{$mode objfpc}{$H+} 30 31interface 32 33{$I codetools.inc} 34 35uses 36 {$IFDEF MEM_CHECK} 37 MemCheck, 38 {$ENDIF} 39 {$IFDEF Windows} 40 Windows, 41 {$ENDIF} 42 // RTL + FCL 43 Classes, SysUtils, AVL_Tree, 44 // CodeTools 45 CodeToolsStrConsts, 46 // LazUtils 47 LazUtilities, 48 {$IFDEF EnableWrapperFunctions} 49 LazDbgLog, 50 {$ENDIF} 51 LazLogger, LazUTF8, LazFileCache, 52 LazFileUtils, LazUTF8Classes; 53 54type 55 TFPCStreamSeekType = int64; 56 TFPCMemStreamSeekType = integer; 57 PCharZ = Pointer; 58 59{$if defined(Windows) or defined(darwin)} 60{$define CaseInsensitiveFilenames} 61{$endif} 62{$IF defined(CaseInsensitiveFilenames) or defined(darwin)} 63{$DEFINE NotLiteralFilenames} 64{$ENDIF} 65 66const 67 FilenamesCaseSensitive = {$IFDEF CaseInsensitiveFilenames}false{$ELSE}true{$ENDIF};// lower and upper letters are treated the same 68 FilenamesLiteral = {$IFDEF NotLiteralFilenames}false{$ELSE}true{$ENDIF};// file names can be compared using = string operator 69 70 SpecialChar = '#'; // used to use PathDelim, e.g. #\ 71 FileMask = AllFilesMask; 72 {$IFDEF Windows} 73 ExeExt = '.exe'; 74 {$ELSE} 75 {$IFDEF NetWare} 76 ExeExt = '.nlm'; 77 {$ELSE} 78 ExeExt = ''; 79 {$ENDIF} 80 {$ENDIF} 81 82type 83 TCTSearchFileCase = ( 84 ctsfcDefault, // e.g. case insensitive on windows 85 ctsfcLoUpCase, // also search for lower and upper case 86 ctsfcAllCase // search case insensitive 87 ); 88 TCTFileAgeTime = longint; 89 PCTFileAgeTime = ^TCTFileAgeTime; 90 91{$IFDEF EnableWrapperFunctions} 92// *** Wrappers for LazUTF8 *** 93function UTF8ToSys(const s: string): string; inline; deprecated 'Use the function in LazUTF8 unit'; 94function SysToUTF8(const s: string): string; inline; deprecated 'Use the function in LazUTF8 unit'; 95function UTF8CharacterLength(p: PChar): integer; inline; deprecated 'Use the function in LazUTF8 unit'; 96// environment 97function ParamStrUTF8(Param: Integer): string; inline; deprecated 'Use the function in LazUTF8 unit'; 98function GetEnvironmentStringUTF8(Index : Integer): String; inline; deprecated 'Use the function in LazUTF8 unit'; 99function GetEnvironmentVariableUTF8(const EnvVar: String): String; inline; deprecated 'Use the function in LazUTF8 unit'; 100 101// *** Wrappers for LazFileUtils *** 102function CompareFilenames(const Filename1, Filename2: string): integer; inline; deprecated 'Use the function in LazFileUtils unit'; 103function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer; inline; deprecated 'Use the function in LazFileUtils unit'; 104//function CompareFileExt(const Filename, Ext: string; CaseSensitive: boolean): integer; inline; deprecated 'Use the function in LazFileUtils unit'; 105function CompareFilenameStarts(const Filename1, Filename2: string): integer; inline; deprecated 'Use the function in LazFileUtils unit'; 106function CompareFilenames(Filename1: PChar; Len1: integer; 107 Filename2: PChar; Len2: integer): integer; inline; deprecated 'Use the function in LazFileUtils unit'; 108function DirPathExists(DirectoryName: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 109function DirectoryIsWritable(const DirectoryName: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 110function ExtractFileNameOnly(const AFilename: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 111function FilenameIsAbsolute(const TheFilename: string):boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 112function FilenameIsWinAbsolute(const TheFilename: string):boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 113function FilenameIsUnixAbsolute(const TheFilename: string):boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 114function ForceDirectory(DirectoryName: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 115procedure CheckIfFileIsExecutable(const AFilename: string); inline; deprecated 'Use the function in LazFileUtils unit'; 116function FileIsExecutable(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 117function FileIsReadable(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 118function FileIsWritable(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 119function FileIsText(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 120function FileIsText(const AFilename: string; out FileReadable: boolean): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 121function FilenameIsTrimmed(const TheFilename: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 122function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 123function TrimFilename(const AFilename: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 124function CleanAndExpandFilename(const Filename: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 125function CleanAndExpandDirectory(const Filename: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 126function TrimAndExpandFilename(const Filename: string; const BaseDir: string = ''): string; inline; deprecated 'Use the function in LazFileUtils unit'; 127function TrimAndExpandDirectory(const Filename: string; const BaseDir: string = ''): string; inline; deprecated 'Use the function in LazFileUtils unit'; 128function CreateRelativePath(const Filename, BaseDirectory: string; 129 UsePointDirectory: boolean = false): string; inline; deprecated 'Use the function in LazFileUtils unit'; 130function FileIsInPath(const Filename, Path: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 131function AppendPathDelim(const Path: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 132function ChompPathDelim(const Path: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 133// file operations 134function FileExistsUTF8(const Filename: string): boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 135function FileAgeUTF8(const FileName: string): Longint; inline; deprecated 'Use the function in LazFileUtils unit'; 136function DirectoryExistsUTF8(const Directory: string): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 137function ExpandFileNameUTF8(const FileName: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 138function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint; inline; deprecated 'Use the function in LazFileUtils unit'; 139function FindNextUTF8(var Rslt: TSearchRec): Longint; inline; deprecated 'Use the function in LazFileUtils unit'; 140procedure FindCloseUTF8(var F: TSearchrec); inline; deprecated 'Use the function in LazFileUtils unit'; 141function FileSetDateUTF8(const FileName: String; Age: Longint): Longint; inline; deprecated 'Use the function in LazFileUtils unit'; 142function FileGetAttrUTF8(const FileName: String): Longint; inline; deprecated 'Use the function in LazFileUtils unit'; 143function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint; inline; deprecated 'Use the function in LazFileUtils unit'; 144function DeleteFileUTF8(const FileName: String): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 145function RenameFileUTF8(const OldName, NewName: String): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 146function FileSearchUTF8(const Name, DirList : String): String; inline; deprecated 'Use the function in LazFileUtils unit'; 147function FileIsReadOnlyUTF8(const FileName: String): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 148function GetCurrentDirUTF8: String; inline; deprecated 'Use the function in LazFileUtils unit'; 149function SetCurrentDirUTF8(const NewDir: String): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 150function CreateDirUTF8(const NewDir: String): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 151function RemoveDirUTF8(const Dir: String): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 152function ForceDirectoriesUTF8(const Dir: string): Boolean; inline; deprecated 'Use the function in LazFileUtils unit'; 153// search paths 154function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 155function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 156function MinimizeSearchPath(const SearchPath: string): string; inline; deprecated 'Use the function in LazFileUtils unit'; 157// Can lead to "wrong number of parameters" error, LazFileUtils has more versions of the func. 158//function FindPathInSearchPath(APath: PChar; APathLen: integer; 159// SearchPath: PChar; SearchPathLen: integer): PChar; inline; 160 161// *** Wrappers for LazFileCache *** 162function FileExistsCached(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 163function DirPathExistsCached(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 164function DirectoryIsWritableCached(const ADirectoryName: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 165function FileIsExecutableCached(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 166function FileIsReadableCached(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 167function FileIsWritableCached(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 168function FileIsTextCached(const AFilename: string): boolean; inline; deprecated 'Use the function in LazFileCache unit'; 169function FileAgeCached(const AFileName: string): Longint; inline; deprecated 'Use the function in LazFileCache unit'; 170procedure InvalidateFileStateCache(const Filename: string = ''); inline; deprecated 'Use the function in LazFileCache unit'; 171 172// *** Wrappers for LazUtilities *** 173function ComparePointers(p1, p2: Pointer): integer; inline; deprecated 'Use the function in LazUtilities unit'; 174procedure MergeSort(List: PPointer; ListLength: PtrInt; 175 const Compare: TListSortCompare); inline; deprecated 'Use the function in LazUtilities unit'; 176function GetNextDelimitedItem(const List: string; Delimiter: char; 177 var Position: integer): string; inline; deprecated 'Use the function in LazUtilities unit'; 178function HasDelimitedItem(const List: string; Delimiter: char; FindItem: string): boolean; inline; deprecated 'Use the function in LazUtilities unit'; 179function FindNextDelimitedItem(const List: string; Delimiter: char; 180 var Position: integer; FindItem: string): string; inline; deprecated 'Use the function in LazUtilities unit'; 181 182// *** Wrappers for LazDbgLog *** 183function MemSizeString(const s: string): PtrUInt; inline; deprecated 'Use the function in LazDbgLog unit'; 184function MemSizeFPList(const List: TFPList): PtrUInt; inline; deprecated 'Use the function in LazDbgLog unit'; 185function GetStringRefCount(const s: string): PtrInt; inline; deprecated 'Use the function in LazDbgLog unit'; 186 187{$ENDIF EnableWrapperFunctions} 188 189// file operations 190function FileDateToDateTimeDef(aFileDate: TCTFileAgeTime; const Default: TDateTime = 0): TDateTime; 191function FilenameIsMatching(const Mask, Filename: string; MatchExactly: boolean): boolean; 192function FindNextDirectoryInFilename(const Filename: string; var Position: integer): string; 193 194function ClearFile(const Filename: string; RaiseOnError: boolean): boolean; 195function GetTempFilename(const Path, Prefix: string): string; 196function SearchFileInDir(const Filename, BaseDirectory: string; 197 SearchCase: TCTSearchFileCase): string; // not thread-safe 198function SearchFileInPath(const Filename, BasePath, SearchPath, Delimiter: string; 199 SearchCase: TCTSearchFileCase): string; overload; // not thread-safe 200function FindDiskFilename(const Filename: string): string; 201{$IFDEF darwin} 202function GetDarwinSystemFilename(Filename: string): string; 203{$ENDIF} 204function ReadAllLinks(const Filename: string; 205 ExceptionOnError: boolean): string; inline; // if a link is broken returns '' 206function TryReadAllLinks(const Filename: string): string; inline; // if a link is broken returns Filename 207 208const 209 CTInvalidChangeStamp = LUInvalidChangeStamp; 210 CTInvalidChangeStamp64 = LUInvalidChangeStamp64; // using a value outside integer to spot wrong types early 211 212function GetFilenameOnDisk(const AFilename: string): string; inline; deprecated; // use FindDiskFilename 213 214function CompareAnsiStringFilenames(Data1, Data2: Pointer): integer; 215function CompareFilenameOnly(Filename: PChar; FilenameLen: integer; 216 NameOnly: PChar; NameOnlyLen: integer; CaseSensitive: boolean): integer; 217 218// searching .pas, .pp, .p 219function FilenameIsPascalUnit(const Filename: string; 220 CaseSensitive: boolean = false): boolean; 221function FilenameIsPascalUnit(Filename: PChar; FilenameLen: integer; 222 CaseSensitive: boolean = false): boolean; 223function ExtractFileUnitname(Filename: string; WithNameSpace: boolean): string; 224function IsPascalUnitExt(FileExt: PChar; CaseSensitive: boolean = false): boolean; 225function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string; 226 SearchCase: TCTSearchFileCase): string; 227function SearchPascalUnitInPath(const AnUnitName, BasePath, SearchPath, 228 Delimiter: string; SearchCase: TCTSearchFileCase): string; 229 230// searching .ppu 231function SearchPascalFileInDir(const ShortFilename, BaseDirectory: string; 232 SearchCase: TCTSearchFileCase): string; 233function SearchPascalFileInPath(const ShortFilename, BasePath, SearchPath, 234 Delimiter: string; SearchCase: TCTSearchFileCase): string; 235 236// FPC 237function ReadNextFPCParameter(const CmdLine: string; var Position: integer; 238 out StartPos: integer): boolean; 239function ExtractFPCParameter(const CmdLine: string; StartPos: integer): string; 240function FindNextFPCParameter(const CmdLine, BeginsWith: string; var Position: integer): integer; 241function GetLastFPCParameter(const CmdLine, BeginsWith: string; CutBegins: boolean = true): string; 242function GetFPCParameterSrcFile(const CmdLine: string): string; 243 244type 245 TCTPascalExtType = (petNone, petPAS, petPP, petP); 246 247const 248 CTPascalExtension: array[TCTPascalExtType] of string = 249 ('', '.pas', '.pp', '.p'); 250 251function FileAgeToStr(aFileAge: longint): string; 252 253function AVLTreeHasDoubles(Tree: TAVLTree): TAVLTreeNode; 254 255// store date locale independent, thread safe 256const DateAsCfgStrFormat='YYYYMMDD'; 257const DateTimeAsCfgStrFormat='YYYY/MM/DD HH:NN:SS'; 258function DateToCfgStr(const Date: TDateTime; const aFormat: string = DateAsCfgStrFormat): string; 259function CfgStrToDate(const s: string; out Date: TDateTime; const aFormat: string = DateAsCfgStrFormat): boolean; 260 261procedure CTIncreaseChangeStamp(var ChangeStamp: integer); inline; 262procedure CTIncreaseChangeStamp64(var ChangeStamp: int64); inline; 263function SimpleFormat(const Fmt: String; const Args: Array of const): String; 264 265// debugging 266var 267 CTConsoleVerbosity: integer = {$IFDEF VerboseCodetools}1{$ELSE}0{$ENDIF}; // 0=quiet, 1=normal, 2=verbose 268 269procedure RaiseCatchableException(const Msg: string); 270procedure RaiseAndCatchException; 271 272procedure DebugLn(Args: array of const); 273procedure DebugLn(const S: String; Args: array of const);// similar to Format(s,Args) 274procedure DebugLn; inline; 275procedure DebugLn(const s: string); inline; 276procedure DebugLn(const s1,s2: string); inline; 277procedure DebugLn(const s1,s2,s3: string); inline; 278procedure DebugLn(const s1,s2,s3,s4: string); inline; 279procedure DebugLn(const s1,s2,s3,s4,s5: string); inline; 280procedure DebugLn(const s1,s2,s3,s4,s5,s6: string); inline; 281procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7: string); inline; 282procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8: string); inline; 283procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9: string); inline; 284procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string); inline; 285procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string); inline; 286procedure DebugLn(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string); inline; 287 288procedure DbgOut(Args: array of const); 289procedure DbgOut(const s: string); inline; 290procedure DbgOut(const s1,s2: string); inline; 291procedure DbgOut(const s1,s2,s3: string); inline; 292procedure DbgOut(const s1,s2,s3,s4: string); inline; 293procedure DbgOut(const s1,s2,s3,s4,s5: string); inline; 294procedure DbgOut(const s1,s2,s3,s4,s5,s6: string); inline; 295 296function DbgS(Args: array of const): string; overload; 297function DbgS(const c: char): string; overload; 298function DbgS(const c: cardinal): string; inline; overload; 299function DbgS(const i: integer): string; inline; overload; 300function DbgS(const i: QWord): string; inline; overload; 301function DbgS(const i: int64): string; inline; overload; 302function DbgS(const r: TRect): string; inline; overload; 303function DbgS(const p: TPoint): string; inline; overload; 304function DbgS(const p: pointer): string; inline; overload; 305function DbgS(const e: extended; MaxDecimals: integer = 999): string; overload; inline; 306function DbgS(const b: boolean): string; overload; inline; 307function DbgS(const ms: TCustomMemoryStream; Count: PtrInt = -1): string; inline; overload; 308function DbgSName(const p: TObject): string; overload; inline; 309function DbgSName(const p: TClass): string; overload; inline; 310function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; inline; 311 312function DbgS(const i1,i2,i3,i4: integer): string; overload; inline; 313function DbgStr(const StringWithSpecialChars: string): string; overload; 314function DbgStr(const StringWithSpecialChars: string; StartPos, Len: PtrInt): string; overload; 315function DbgText(const StringWithSpecialChars: string; 316 KeepLines: boolean = true // true = add LineEnding for each line break 317 ): string; overload; 318 319type 320 TCTMemStat = class 321 public 322 Name: string; 323 Sum: PtrUint; 324 end; 325 326 { TCTMemStats } 327 328 TCTMemStats = class 329 private 330 function GetItems(const Name: string): PtrUint; 331 procedure SetItems(const Name: string; const AValue: PtrUint); 332 public 333 Tree: TAVLTree; // tree of TCTMemStat sorted for Name with CompareText 334 Total: PtrUInt; 335 constructor Create; 336 destructor Destroy; override; 337 property Items[const Name: string]: PtrUint read GetItems write SetItems; default; 338 procedure Add(const Name: string; Size: PtrUint); 339 procedure WriteReport; 340 end; 341 342function CompareCTMemStat(Stat1, Stat2: TCTMemStat): integer; 343function CompareNameWithCTMemStat(KeyAnsiString: Pointer; Stat: TCTMemStat): integer; 344 345function GetTicks: int64; // not thread-safe 346 347type 348 TCTStackTracePointers = array of Pointer; 349 TCTLineInfoCacheItem = record 350 Addr: Pointer; 351 Info: string; 352 end; 353 PCTLineInfoCacheItem = ^TCTLineInfoCacheItem; 354 355procedure CTDumpStack; 356function CTGetStackTrace(UseCache: boolean): string; 357procedure CTGetStackTracePointers(var AStack: TCTStackTracePointers); 358function CTStackTraceAsString(const AStack: TCTStackTracePointers; 359 UseCache: boolean): string; 360function CTGetLineInfo(Addr: Pointer; UseCache: boolean): string; // not thread safe 361function CompareCTLineInfoCacheItems(Data1, Data2: Pointer): integer; 362function CompareAddrWithCTLineInfoCacheItem(Addr, Item: Pointer): integer; 363 364 365implementation 366 367// to get more detailed error messages consider the os 368{$IFnDEF Windows} 369uses 370 {$IFDEF darwin} 371 MacOSAll, 372 {$ENDIF} 373 Unix; 374{$ENDIF} 375 376{$IFDEF EnableWrapperFunctions} 377// LazUTF8 378function UTF8ToSys(const s: string): string; 379begin 380 Result:=LazUTF8.UTF8ToSys(s); 381end; 382 383function SysToUTF8(const s: string): string; 384begin 385 Result:=LazUTF8.SysToUTF8(s); 386end; 387 388function UTF8CharacterLength(p: PChar): integer; 389begin 390 Result:=LazUTF8.UTF8CharacterLength(p); 391end; 392 393function ParamStrUTF8(Param: Integer): string; 394begin 395 Result:=LazUTF8.ParamStrUTF8(Param); 396end; 397 398function GetEnvironmentStringUTF8(Index: Integer): String; 399begin 400 Result:=LazUTF8.GetEnvironmentStringUTF8(Index); 401end; 402 403function GetEnvironmentVariableUTF8(const EnvVar: String): String; 404begin 405 Result:=LazUTF8.GetEnvironmentVariableUTF8(EnvVar); 406end; 407 408// LazFileUtils 409function CompareFilenames(const Filename1, Filename2: string): integer; 410begin 411 Result:=LazFileUtils.CompareFilenames(Filename1,Filename2); 412end; 413 414function CompareFilenamesIgnoreCase(const Filename1, Filename2: string): integer; 415begin 416 Result:=LazFileUtils.CompareFilenamesIgnoreCase(Filename1,Filename2); 417end; 418 419//function CompareFileExt(const Filename, Ext: string; CaseSensitive: boolean): integer; 420//begin 421// Result:=LazFileUtils.CompareFileExt(Filename,Ext,CaseSensitive); 422//end; 423 424function CompareFilenameStarts(const Filename1, Filename2: string): integer; 425begin 426 Result:=LazFileUtils.CompareFilenameStarts(Filename1,Filename2); 427end; 428 429function CompareFilenames(Filename1: PChar; Len1: integer; Filename2: PChar; 430 Len2: integer): integer; 431begin 432 Result:=LazFileUtils.CompareFilenames(Filename1,Len1,Filename2,Len2); 433end; 434 435function DirPathExists(DirectoryName: string): boolean; 436begin 437 Result:=LazFileUtils.DirPathExists(DirectoryName); 438end; 439 440function DirectoryIsWritable(const DirectoryName: string): boolean; 441begin 442 Result:=LazFileUtils.DirectoryIsWritable(DirectoryName); 443end; 444 445function ExtractFileNameOnly(const AFilename: string): string; 446begin 447 Result:=LazFileUtils.ExtractFileNameOnly(AFilename); 448end; 449 450function FilenameIsAbsolute(const TheFilename: string): boolean; 451begin 452 Result:=LazFileUtils.FilenameIsAbsolute(TheFilename); 453end; 454 455function FilenameIsWinAbsolute(const TheFilename: string): boolean; 456begin 457 Result:=LazFileUtils.FilenameIsWinAbsolute(TheFilename); 458end; 459 460function FilenameIsUnixAbsolute(const TheFilename: string): boolean; 461begin 462 Result:=LazFileUtils.FilenameIsUnixAbsolute(TheFilename); 463end; 464 465function ForceDirectory(DirectoryName: string): boolean; 466begin 467 Result:=LazFileUtils.ForceDirectory(DirectoryName); 468end; 469 470procedure CheckIfFileIsExecutable(const AFilename: string); 471begin 472 LazFileUtils.CheckIfFileIsExecutable(AFilename); 473end; 474 475function FileIsExecutable(const AFilename: string): boolean; 476begin 477 Result:=LazFileUtils.FileIsExecutable(AFilename); 478end; 479 480function FileIsReadable(const AFilename: string): boolean; 481begin 482 Result:=LazFileUtils.FileIsReadable(AFilename); 483end; 484 485function FileIsWritable(const AFilename: string): boolean; 486begin 487 Result:=LazFileUtils.FileIsWritable(AFilename); 488end; 489 490function FileIsText(const AFilename: string): boolean; 491begin 492 Result:=LazFileUtils.FileIsText(AFilename); 493end; 494 495function FileIsText(const AFilename: string; out FileReadable: boolean): boolean; 496begin 497 Result:=LazFileUtils.FileIsText(AFilename,FileReadable); 498end; 499 500function FilenameIsTrimmed(const TheFilename: string): boolean; 501begin 502 Result:=LazFileUtils.FilenameIsTrimmed(TheFilename); 503end; 504 505function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean; 506begin 507 Result:=LazFileUtils.FilenameIsTrimmed(StartPos,NameLen); 508end; 509 510function TrimFilename(const AFilename: string): string; 511begin 512 Result:=LazFileUtils.TrimFilename(AFilename); 513end; 514 515function CleanAndExpandFilename(const Filename: string): string; 516begin 517 Result:=LazFileUtils.CleanAndExpandFilename(Filename); 518end; 519 520function CleanAndExpandDirectory(const Filename: string): string; 521begin 522 Result:=LazFileUtils.CleanAndExpandDirectory(Filename); 523end; 524 525function TrimAndExpandFilename(const Filename: string; const BaseDir: string): string; 526begin 527 Result:=LazFileUtils.TrimAndExpandFilename(Filename,BaseDir); 528end; 529 530function TrimAndExpandDirectory(const Filename: string; const BaseDir: string): string; 531begin 532 Result:=LazFileUtils.TrimAndExpandDirectory(Filename,BaseDir); 533end; 534 535function CreateRelativePath(const Filename, BaseDirectory: string; 536 UsePointDirectory: boolean): string; 537begin 538 Result:=LazFileUtils.CreateRelativePath(Filename,BaseDirectory,UsePointDirectory); 539end; 540 541function FileIsInPath(const Filename, Path: string): boolean; 542begin 543 Result:=LazFileUtils.FileIsInPath(Filename,Path); 544end; 545 546function AppendPathDelim(const Path: string): string; 547begin 548 Result:=LazFileUtils.AppendPathDelim(Path); 549end; 550 551function ChompPathDelim(const Path: string): string; 552begin 553 Result:=LazFileUtils.ChompPathDelim(Path); 554end; 555 556function FileExistsUTF8(const Filename: string): boolean; 557begin 558 Result:=LazFileUtils.FileExistsUTF8(Filename); 559end; 560 561function FileAgeUTF8(const FileName: string): Longint; 562begin 563 Result:=LazFileUtils.FileAgeUTF8(Filename); 564end; 565 566function DirectoryExistsUTF8(const Directory: string): Boolean; 567begin 568 Result:=LazFileUtils.DirectoryExistsUTF8(Directory); 569end; 570 571function ExpandFileNameUTF8(const FileName: string): string; 572begin 573 Result:=LazFileUtils.ExpandFileNameUTF8(Filename); 574end; 575 576function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint; 577begin 578 Result:=LazFileUtils.FindFirstUTF8(Path,Attr,Rslt); 579end; 580 581function FindNextUTF8(var Rslt: TSearchRec): Longint; 582begin 583 Result:=LazFileUtils.FindNextUTF8(Rslt); 584end; 585 586procedure FindCloseUTF8(var F: TSearchrec); 587begin 588 LazFileUtils.FindCloseUTF8(F); 589end; 590 591function FileSetDateUTF8(const FileName: String; Age: Longint): Longint; 592begin 593 Result:=LazFileUtils.FileSetDateUTF8(FileName,Age); 594end; 595 596function FileGetAttrUTF8(const FileName: String): Longint; 597begin 598 Result:=LazFileUtils.FileGetAttrUTF8(FileName); 599end; 600 601function FileSetAttrUTF8(const Filename: String; Attr: longint): Longint; 602begin 603 Result:=LazFileUtils.FileSetAttrUTF8(FileName,Attr); 604end; 605 606function DeleteFileUTF8(const FileName: String): Boolean; 607begin 608 Result:=LazFileUtils.DeleteFileUTF8(FileName); 609end; 610 611function RenameFileUTF8(const OldName, NewName: String): Boolean; 612begin 613 Result:=LazFileUtils.RenameFileUTF8(OldName,NewName); 614end; 615 616function FileSearchUTF8(const Name, DirList: String): String; 617begin 618 Result:=LazFileUtils.FileSearchUTF8(Name,DirList); 619end; 620 621function FileIsReadOnlyUTF8(const FileName: String): Boolean; 622begin 623 Result:=LazFileUtils.FileIsReadOnlyUTF8(FileName); 624end; 625 626function GetCurrentDirUTF8: String; 627begin 628 Result:=LazFileUtils.GetCurrentDirUTF8; 629end; 630 631function SetCurrentDirUTF8(const NewDir: String): Boolean; 632begin 633 Result:=LazFileUtils.SetCurrentDirUTF8(NewDir); 634end; 635 636function CreateDirUTF8(const NewDir: String): Boolean; 637begin 638 Result:=LazFileUtils.CreateDirUTF8(NewDir); 639end; 640 641function RemoveDirUTF8(const Dir: String): Boolean; 642begin 643 Result:=LazFileUtils.RemoveDirUTF8(Dir); 644end; 645 646function ForceDirectoriesUTF8(const Dir: string): Boolean; 647begin 648 Result:=LazFileUtils.ForceDirectoriesUTF8(Dir); 649end; 650 651function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string; 652begin 653 Result:=LazFileUtils.CreateAbsoluteSearchPath(SearchPath,BaseDirectory); 654end; 655 656function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): string; 657begin 658 Result:=LazFileUtils.CreateRelativeSearchPath(SearchPath,BaseDirectory); 659end; 660 661function MinimizeSearchPath(const SearchPath: string): string; 662begin 663 Result:=LazFileUtils.MinimizeSearchPath(SearchPath); 664end; 665 666//function FindPathInSearchPath(APath: PChar; APathLen: integer; 667// SearchPath: PChar; SearchPathLen: integer): PChar; 668//begin 669// Result:=LazFileUtils.FindPathInSearchPath(APath,APathLen,SearchPath,SearchPathLen); 670//end; 671 672// LazFileCache 673function FileExistsCached(const AFilename: string): boolean; 674begin 675 Result:=LazFileCache.FileExistsCached(AFilename); 676end; 677 678function DirPathExistsCached(const AFilename: string): boolean; 679begin 680 Result:=LazFileCache.DirPathExistsCached(AFilename); 681end; 682 683function DirectoryIsWritableCached(const ADirectoryName: string): boolean; 684begin 685 Result:=LazFileCache.DirectoryIsWritableCached(ADirectoryName); 686end; 687 688function FileIsExecutableCached(const AFilename: string): boolean; 689begin 690 Result:=LazFileCache.FileIsExecutableCached(AFilename); 691end; 692 693function FileIsReadableCached(const AFilename: string): boolean; 694begin 695 Result:=LazFileCache.FileIsReadableCached(AFilename); 696end; 697 698function FileIsWritableCached(const AFilename: string): boolean; 699begin 700 Result:=LazFileCache.FileIsWritableCached(AFilename); 701end; 702 703function FileIsTextCached(const AFilename: string): boolean; 704begin 705 Result:=LazFileCache.FileIsTextCached(AFilename); 706end; 707 708function FileAgeCached(const AFileName: string): Longint; 709begin 710 Result:=LazFileCache.FileAgeCached(AFileName); 711end; 712 713procedure InvalidateFileStateCache(const Filename: string = ''); 714begin 715 LazFileCache.InvalidateFileStateCache(Filename); 716end; 717 718// LazUtilities 719function ComparePointers(p1, p2: Pointer): integer; 720begin 721 Result:=LazUtilities.ComparePointers(p1,p2); 722end; 723 724procedure MergeSort(List: PPointer; ListLength: PtrInt; const Compare: TListSortCompare); 725begin 726 LazUtilities.MergeSort(List,ListLength,Compare); 727end; 728 729function GetNextDelimitedItem(const List: string; Delimiter: char; 730 var Position: integer): string; 731begin 732 Result:=LazUtilities.GetNextDelimitedItem(List,Delimiter,Position); 733end; 734 735function HasDelimitedItem(const List: string; Delimiter: char; FindItem: string): boolean; 736begin 737 Result:=LazUtilities.HasDelimitedItem(List,Delimiter,FindItem); 738end; 739 740function FindNextDelimitedItem(const List: string; Delimiter: char; 741 var Position: integer; FindItem: string): string; 742begin 743 Result:=LazUtilities.FindNextDelimitedItem(List,Delimiter,Position,FindItem); 744end; 745 746// LazDbgLog 747function MemSizeString(const s: string): PtrUInt; 748begin 749 Result:=LazDbgLog.MemSizeString(s); 750end; 751 752function MemSizeFPList(const List: TFPList): PtrUInt; 753begin 754 Result:=LazDbgLog.MemSizeFPList(List); 755end; 756 757function GetStringRefCount(const s: string): PtrInt; 758begin 759 Result:=LazDbgLog.GetStringRefCount(s); 760end; 761 762{$ENDIF EnableWrapperFunctions} 763 764procedure CTIncreaseChangeStamp(var ChangeStamp: integer); 765begin 766 LazFileCache.LUIncreaseChangeStamp(ChangeStamp); 767end; 768 769procedure CTIncreaseChangeStamp64(var ChangeStamp: int64); 770begin 771 LazFileCache.LUIncreaseChangeStamp64(ChangeStamp); 772end; 773 774function SimpleFormat(const Fmt: String; const Args: array of const): String; 775var 776 Used: array of boolean; 777 p: Integer; 778 StartPos: Integer; 779 780 procedure ReplaceArg(i: integer; var s: string); 781 var 782 Arg: String; 783 begin 784 if (i<Low(Args)) or (i>High(Args)) then exit; 785 case Args[i].VType of 786 vtInteger: Arg:=dbgs(Args[i].vinteger); 787 vtInt64: Arg:=dbgs(Args[i].VInt64^); 788 vtQWord: Arg:=dbgs(Args[i].VQWord^); 789 vtBoolean: Arg:=dbgs(Args[i].vboolean); 790 vtExtended: Arg:=dbgs(Args[i].VExtended^); 791 vtString: Arg:=Args[i].VString^; 792 vtAnsiString: Arg:=AnsiString(Args[i].VAnsiString); 793 vtChar: Arg:=Args[i].VChar; 794 vtPChar: Arg:=Args[i].VPChar; 795 else exit; 796 end; 797 Used[i]:=true; 798 ReplaceSubstring(s,StartPos,p-StartPos,Arg); 799 p:=StartPos+length(Arg); 800 end; 801 802var 803 RunIndex: Integer; 804 FixedIndex: Integer; 805begin 806 Result:=Fmt; 807 if Low(Args)>High(Args) then exit; 808 SetLength(Used,High(Args)-Low(Args)+1); 809 for RunIndex:=Low(Args) to High(Args) do 810 Used[RunIndex]:=false; 811 RunIndex:=Low(Args); 812 p:=1; 813 while p<=length(Result) do 814 begin 815 if Result[p]='%' then 816 begin 817 StartPos:=p; 818 inc(p); 819 case Result[p] of 820 's': 821 begin 822 inc(p); 823 ReplaceArg(RunIndex,Result); 824 inc(RunIndex); 825 end; 826 '0'..'9': 827 begin 828 FixedIndex:=0; 829 while (p<=length(Result)) and (Result[p] in ['0'..'9']) do 830 begin 831 if FixedIndex<High(Args) then 832 FixedIndex:=FixedIndex*10+ord(Result[p])-ord('0'); 833 inc(p); 834 end; 835 if (p<=length(Result)) and (Result[p]=':') then 836 begin 837 inc(p); 838 if (p<=length(Result)) and (Result[p]='s') then 839 inc(p); 840 end; 841 ReplaceArg(FixedIndex,Result); 842 end; 843 else 844 inc(p); 845 end; 846 end else 847 inc(p); 848 end; 849 850 // append all missing arguments 851 for RunIndex:=Low(Args) to High(Args) do 852 begin 853 if Used[RunIndex] then continue; 854 Result+=','; 855 StartPos:=length(Result)+1; 856 p:=StartPos; 857 ReplaceArg(RunIndex,Result); 858 end; 859end; 860 861procedure RaiseCatchableException(const Msg: string); 862begin 863 { Raises an exception. 864 gdb does not catch fpc Exception objects, therefore this procedure raises 865 a standard AV which is catched by gdb. } 866 DebugLn('ERROR in CodeTools: ',Msg); 867 // creates an exception, that gdb catches: 868 DebugLn('Creating gdb catchable error:'); 869 if (length(Msg) div (length(Msg) div 10000))=0 then ; 870end; 871 872procedure RaiseAndCatchException; 873begin 874 try 875 if (length(ctsAddsDirToIncludePath) div (length(ctsAddsDirToIncludePath) div 10000))=0 then ; 876 except 877 end; 878end; 879 880var 881 LineInfoCache: TAVLTree = nil; 882 LastTick: int64 = 0; 883 884function FileDateToDateTimeDef(aFileDate: TCTFileAgeTime; const Default: TDateTime 885 ): TDateTime; 886begin 887 try 888 Result:=FileDateToDateTime(aFileDate); 889 except 890 Result:=Default; 891 end; 892end; 893 894{------------------------------------------------------------------------------- 895 function ClearFile(const Filename: string; RaiseOnError: boolean): boolean; 896-------------------------------------------------------------------------------} 897function ClearFile(const Filename: string; RaiseOnError: boolean): boolean; 898var 899 fs: TFileStreamUTF8; 900begin 901 if LazFileUtils.FileExistsUTF8(Filename) then begin 902 try 903 LazFileUtils.InvalidateFileStateCache(Filename); 904 fs:=TFileStreamUTF8.Create(Filename,fmOpenWrite); 905 fs.Size:=0; 906 fs.Free; 907 except 908 on E: Exception do begin 909 Result:=false; 910 if RaiseOnError then raise; 911 exit; 912 end; 913 end; 914 end; 915 Result:=true; 916end; 917 918function GetTempFilename(const Path, Prefix: string): string; 919var 920 i: Integer; 921 CurPath: String; 922 CurName: String; 923begin 924 Result:=LazFileUtils.ExpandFileNameUTF8(Path); 925 CurPath:=LazFileUtils.AppendPathDelim(ExtractFilePath(Result)); 926 CurName:=Prefix+LazFileUtils.ExtractFileNameOnly(Result); 927 i:=1; 928 repeat 929 Result:=CurPath+CurName+IntToStr(i)+'.tmp'; 930 if not LazFileUtils.FileExistsUTF8(Result) then exit; 931 inc(i); 932 until false; 933end; 934 935function FindDiskFilename(const Filename: string): string; 936// Searches for the filename case on disk. 937// if it does not exist, only the found path will be improved 938// For example: 939// If Filename='file' and there is only a 'File' then 'File' will be returned. 940var 941 StartPos: Integer; 942 EndPos: LongInt; 943 FileInfo: TSearchRec; 944 CurDir: String; 945 CurFile: String; 946 AliasFile: String; 947 Ambiguous: Boolean; 948 FileNotFound: Boolean; 949begin 950 Result:=Filename; 951 // check every directory and filename 952 StartPos:=1; 953 {$IFDEF Windows} 954 // uppercase Drive letter and skip it 955 if ((length(Result)>=2) and (Result[1] in ['A'..'Z','a'..'z']) 956 and (Result[2]=':')) then begin 957 StartPos:=3; 958 if Result[1] in ['a'..'z'] then 959 Result[1]:=FPUpChars[Result[1]]; 960 end; 961 {$ENDIF} 962 FileNotFound:=false; 963 repeat 964 // skip PathDelim 965 while (StartPos<=length(Result)) and (Result[StartPos]=PathDelim) do 966 inc(StartPos); 967 // find end of filename part 968 EndPos:=StartPos; 969 while (EndPos<=length(Result)) and (Result[EndPos]<>PathDelim) do 970 inc(EndPos); 971 if EndPos>StartPos then begin 972 // search file 973 CurDir:=copy(Result,1,StartPos-1); 974 CurFile:=copy(Result,StartPos,EndPos-StartPos); 975 AliasFile:=''; 976 Ambiguous:=false; 977 if LazFileUtils.FindFirstUTF8(CurDir+FileMask,faAnyFile,FileInfo)=0 then 978 begin 979 repeat 980 // check if special file 981 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') 982 then 983 continue; 984 if LazFileUtils.CompareFilenamesIgnoreCase(FileInfo.Name,CurFile)=0 then begin 985 //writeln('FindDiskFilename ',FileInfo.Name,' ',CurFile); 986 if FileInfo.Name=CurFile then begin 987 // file found, has already the correct name 988 AliasFile:=''; 989 break; 990 end else begin 991 // alias found, but has not the correct name 992 if AliasFile='' then begin 993 AliasFile:=FileInfo.Name; 994 end else begin 995 // there are more than one candidate 996 Ambiguous:=true; 997 end; 998 end; 999 end; 1000 until LazFileUtils.FindNextUTF8(FileInfo)<>0; 1001 end else 1002 FileNotFound:=true; 1003 LazFileUtils.FindCloseUTF8(FileInfo); 1004 if FileNotFound then break; 1005 if (AliasFile<>'') and (not Ambiguous) then begin 1006 // better filename found -> replace 1007 Result:=CurDir+AliasFile+copy(Result,EndPos,length(Result)); 1008 end; 1009 end; 1010 StartPos:=EndPos+1; 1011 until StartPos>length(Result); 1012end; 1013 1014{------------------------------------------------------------------------------ 1015 function ReadAllLinks(const Filename: string; 1016 ExceptionOnError: boolean): string; 1017 ------------------------------------------------------------------------------} 1018function ReadAllLinks(const Filename: string; 1019 ExceptionOnError: boolean): string; 1020begin 1021 Result:=LazFileUtils.ReadAllLinks(Filename,ExceptionOnError); 1022end; 1023 1024function TryReadAllLinks(const Filename: string): string; 1025begin 1026 Result:=LazFileUtils.TryReadAllLinks(Filename); 1027end; 1028 1029{$IFDEF darwin} 1030function GetDarwinSystemFilename(Filename: string): string; 1031var 1032 s: CFStringRef; 1033 l: CFIndex; 1034begin 1035 if Filename='' then exit(''); 1036 s:=CFStringCreateWithCString(nil,Pointer(Filename),kCFStringEncodingUTF8); 1037 l:=CFStringGetMaximumSizeOfFileSystemRepresentation(s); 1038 SetLength(Result,l); 1039 if Result<>'' then begin 1040 CFStringGetFileSystemRepresentation(s,@Result[1],length(Result)); 1041 SetLength(Result,StrLen(PChar(Result))); 1042 end; 1043 CFRelease(s); 1044end; 1045{$ENDIF} 1046 1047function GetFilenameOnDisk(const AFilename: string): string; 1048begin 1049 Result:=FindDiskFilename(AFilename); 1050end; 1051 1052function CompareAnsiStringFilenames(Data1, Data2: Pointer): integer; 1053begin 1054 Result:=LazFileUtils.CompareFilenames(AnsiString(Data1),AnsiString(Data2)); 1055end; 1056 1057function CompareFilenameOnly(Filename: PChar; FilenameLen: integer; 1058 NameOnly: PChar; NameOnlyLen: integer; CaseSensitive: boolean): integer; 1059// compare only the filename (without extension and path) 1060var 1061 EndPos: integer; 1062 StartPos: LongInt; 1063 p: Integer; 1064 l: LongInt; 1065 FilenameOnlyLen: Integer; 1066begin 1067 StartPos:=FilenameLen; 1068 while (StartPos>0) and (Filename[StartPos-1]<>PathDelim) do dec(StartPos); 1069 EndPos:=FilenameLen; 1070 while (EndPos>StartPos) and (Filename[EndPos]<>'.') do dec(EndPos); 1071 if (EndPos=StartPos) and (EndPos<FilenameLen) and (Filename[EndPos]<>'.') then 1072 EndPos:=FilenameLen; 1073 FilenameOnlyLen:=EndPos-StartPos; 1074 l:=FilenameOnlyLen; 1075 if l>NameOnlyLen then 1076 l:=NameOnlyLen; 1077 //DebugLn('CompareFilenameOnly NameOnly="',copy(NameOnly,1,NameOnlyLen),'" FilenameOnly="',copy(Filename,StartPos,EndPos-StartPos),'"'); 1078 p:=0; 1079 if CaseSensitive then begin 1080 while p<l do begin 1081 Result:=ord(Filename[StartPos+p])-ord(NameOnly[p]); 1082 if Result<>0 then exit; 1083 inc(p); 1084 end; 1085 end else begin 1086 while p<l do begin 1087 Result:=ord(FPUpChars[Filename[StartPos+p]])-ord(FPUpChars[NameOnly[p]]); 1088 if Result<>0 then exit; 1089 inc(p); 1090 end; 1091 end; 1092 Result:=FilenameOnlyLen-NameOnlyLen; 1093end; 1094 1095function FilenameIsPascalUnit(const Filename: string; 1096 CaseSensitive: boolean): boolean; 1097begin 1098 Result:=(Filename<>'') 1099 and FilenameIsPascalUnit(PChar(Filename),length(Filename),CaseSensitive); 1100end; 1101 1102function FilenameIsPascalUnit(Filename: PChar; FilenameLen: integer; 1103 CaseSensitive: boolean): boolean; 1104var 1105 ExtPos: LongInt; 1106 ExtLen: Integer; 1107 e: TCTPascalExtType; 1108 i: Integer; 1109 p: PChar; 1110begin 1111 if (Filename=nil) or (FilenameLen<2) then exit(false); 1112 ExtPos:=FilenameLen-1; 1113 while (ExtPos>0) and (Filename[ExtPos]<>'.') do dec(ExtPos); 1114 if ExtPos<=0 then exit(false); 1115 // check extension 1116 ExtLen:=FilenameLen-ExtPos; 1117 for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin 1118 if (CTPascalExtension[e]='') or (length(CTPascalExtension[e])<>ExtLen) then 1119 continue; 1120 i:=0; 1121 p:=PChar(Pointer(CTPascalExtension[e]));// pointer type cast avoids #0 check 1122 if CaseSensitive then begin 1123 while (i<ExtLen) and (p^=Filename[ExtPos+i]) do begin 1124 inc(i); 1125 inc(p); 1126 end; 1127 end else begin 1128 while (i<ExtLen) and (FPUpChars[p^]=FPUpChars[Filename[ExtPos+i]]) do 1129 begin 1130 inc(i); 1131 inc(p); 1132 end; 1133 end; 1134 if i<>ExtLen then continue; 1135 // check name is dotted identifier 1136 p:=@Filename[ExtPos]; 1137 while (p>Filename) and (p[-1]<>PathDelim) do dec(p); 1138 repeat 1139 if not (p^ in ['a'..'z','A'..'Z','_']) then exit(false); 1140 inc(p); 1141 while (p^ in ['a'..'z','A'..'Z','_','0'..'9']) do inc(p); 1142 if p^<>'.' then exit(false); 1143 if p-Filename=ExtPos then exit(true); 1144 inc(p); 1145 until false; 1146 end; 1147 Result:=false; 1148end; 1149 1150function ExtractFileUnitname(Filename: string; WithNameSpace: boolean): string; 1151var 1152 p: Integer; 1153begin 1154 Result:=LazFileUtils.ExtractFileNameOnly(Filename); 1155 if (Result='') or WithNameSpace then exit; 1156 // find last dot 1157 p:=length(Result); 1158 while p>0 do begin 1159 if Result[p]='.' then begin 1160 Delete(Result,1,p); 1161 exit; 1162 end; 1163 dec(p); 1164 end; 1165end; 1166 1167function IsPascalUnitExt(FileExt: PChar; CaseSensitive: boolean): boolean; 1168// check if asciiz FileExt is a CTPascalExtension '.pp', '.pas' 1169var 1170 ExtLen: Integer; 1171 p: PChar; 1172 e: TCTPascalExtType; 1173 f: PChar; 1174begin 1175 Result:=false; 1176 if (FileExt=nil) then exit; 1177 ExtLen:=strlen(FileExt); 1178 if ExtLen=0 then exit; 1179 for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin 1180 if length(CTPascalExtension[e])<>ExtLen then 1181 continue; 1182 p:=PChar(Pointer(CTPascalExtension[e]));// pointer type cast avoids #0 check 1183 f:=FileExt; 1184 //debugln(['IsPascalUnitExt p="',dbgstr(p),'" f="',dbgstr(f),'"']); 1185 if CaseSensitive then begin 1186 while (p^=f^) and (p^<>#0) do begin 1187 inc(p); 1188 inc(f); 1189 end; 1190 end else begin 1191 while (FPUpChars[p^]=FPUpChars[f^]) and (p^<>#0) do 1192 begin 1193 inc(p); 1194 inc(f); 1195 end; 1196 end; 1197 if p^=#0 then 1198 exit(true); 1199 end; 1200end; 1201 1202function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string; 1203 SearchCase: TCTSearchFileCase): string; 1204 1205 procedure RaiseNotImplemented; 1206 begin 1207 raise Exception.Create('not implemented'); 1208 end; 1209 1210var 1211 Base: String; 1212 FileInfo: TSearchRec; 1213 LowerCaseUnitname: String; 1214 UpperCaseUnitname: String; 1215 CurUnitName: String; 1216begin 1217 Base:=LazFileUtils.AppendPathDelim(BaseDirectory); 1218 Base:=LazFileUtils.TrimFilename(Base); 1219 // search file 1220 Result:=''; 1221 if SearchCase=ctsfcAllCase then 1222 Base:=FindDiskFilename(Base); 1223 1224 if SearchCase in [ctsfcDefault,ctsfcLoUpCase] then begin 1225 LowerCaseUnitname:=lowercase(AnUnitName); 1226 UpperCaseUnitname:=uppercase(AnUnitName); 1227 end else begin 1228 LowerCaseUnitname:=''; 1229 UpperCaseUnitname:=''; 1230 end; 1231 1232 if LazFileUtils.FindFirstUTF8(Base+FileMask,faAnyFile,FileInfo)=0 then 1233 begin 1234 repeat 1235 // check if special file 1236 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') 1237 then 1238 continue; 1239 if not FilenameIsPascalUnit(FileInfo.Name,false) then continue; 1240 case SearchCase of 1241 ctsfcDefault,ctsfcLoUpCase: 1242 if (CompareFilenameOnly(PChar(Pointer(FileInfo.Name)),// pointer type cast avoids #0 check 1243 length(FileInfo.Name), 1244 PChar(Pointer(AnUnitName)), 1245 length(AnUnitName),false)=0) 1246 then begin 1247 CurUnitName:=LazFileUtils.ExtractFileNameOnly(FileInfo.Name); 1248 if CurUnitName=AnUnitName then begin 1249 Result:=FileInfo.Name; 1250 break; 1251 end else if ((LowerCaseUnitname=CurUnitName) 1252 or (UpperCaseUnitname=CurUnitName)) then begin 1253 Result:=FileInfo.Name; 1254 end; 1255 end; 1256 1257 ctsfcAllCase: 1258 if (CompareFilenameOnly(PChar(Pointer(FileInfo.Name)),// pointer type cast avoids #0 check 1259 length(FileInfo.Name), 1260 PChar(Pointer(AnUnitName)),length(AnUnitName), 1261 false)=0) 1262 then begin 1263 Result:=FileInfo.Name; 1264 CurUnitName:=LazFileUtils.ExtractFileNameOnly(FileInfo.Name); 1265 if CurUnitName=AnUnitName then 1266 break; 1267 end; 1268 1269 else 1270 RaiseNotImplemented; 1271 end; 1272 until LazFileUtils.FindNextUTF8(FileInfo)<>0; 1273 end; 1274 LazFileUtils.FindCloseUTF8(FileInfo); 1275 if Result<>'' then Result:=Base+Result; 1276end; 1277 1278function SearchPascalUnitInPath(const AnUnitName, BasePath, SearchPath, 1279 Delimiter: string; SearchCase: TCTSearchFileCase): string; 1280var 1281 p, StartPos, l: integer; 1282 CurPath, Base: string; 1283begin 1284 Base:=LazFileUtils.AppendPathDelim(LazFileUtils.ExpandFileNameUTF8(BasePath)); 1285 // search in current directory 1286 Result:=SearchPascalUnitInDir(AnUnitName,Base,SearchCase); 1287 if Result<>'' then exit; 1288 // search in search path 1289 StartPos:=1; 1290 l:=length(SearchPath); 1291 while StartPos<=l do begin 1292 p:=StartPos; 1293 while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do inc(p); 1294 CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos)); 1295 if CurPath<>'' then begin 1296 if not LazFileUtils.FilenameIsAbsolute(CurPath) then 1297 CurPath:=Base+CurPath; 1298 CurPath:=LazFileUtils.AppendPathDelim(ResolveDots(CurPath)); 1299 Result:=SearchPascalUnitInDir(AnUnitName,CurPath,SearchCase); 1300 if Result<>'' then exit; 1301 end; 1302 StartPos:=p+1; 1303 end; 1304 Result:=''; 1305end; 1306 1307function SearchPascalFileInDir(const ShortFilename, BaseDirectory: string; 1308 SearchCase: TCTSearchFileCase): string; 1309 1310 procedure RaiseNotImplemented; 1311 begin 1312 raise Exception.Create('not implemented'); 1313 end; 1314 1315var 1316 Base: String; 1317 FileInfo: TSearchRec; 1318 LowerCaseFilename: string; 1319 UpperCaseFilename: string; 1320begin 1321 Base:=LazFileUtils.AppendPathDelim(BaseDirectory); 1322 Base:=LazFileUtils.TrimFilename(Base); 1323 // search file 1324 Result:=''; 1325 if SearchCase=ctsfcAllCase then 1326 Base:=FindDiskFilename(Base); 1327 1328 if SearchCase in [ctsfcDefault,ctsfcLoUpCase] then begin 1329 LowerCaseFilename:=lowercase(ShortFilename); 1330 UpperCaseFilename:=uppercase(ShortFilename); 1331 end else begin 1332 LowerCaseFilename:=''; 1333 UpperCaseFilename:=''; 1334 end; 1335 1336 if LazFileUtils.FindFirstUTF8(Base+FileMask,faAnyFile,FileInfo)=0 then 1337 begin 1338 repeat 1339 // check if special file 1340 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') 1341 then 1342 continue; 1343 case SearchCase of 1344 ctsfcDefault,ctsfcLoUpCase: 1345 if (ShortFilename=FileInfo.Name) then begin 1346 Result:=FileInfo.Name; 1347 break; 1348 end else if (LowerCaseFilename=FileInfo.Name) 1349 or (UpperCaseFilename=FileInfo.Name) 1350 then 1351 Result:=FileInfo.Name; 1352 1353 ctsfcAllCase: 1354 if LazFileUtils.CompareFilenamesIgnoreCase(ShortFilename,FileInfo.Name)=0 then begin 1355 Result:=FileInfo.Name; 1356 if ShortFilename=FileInfo.Name then break; 1357 end; 1358 1359 else 1360 RaiseNotImplemented; 1361 end; 1362 until LazFileUtils.FindNextUTF8(FileInfo)<>0; 1363 end; 1364 LazFileUtils.FindCloseUTF8(FileInfo); 1365 if Result<>'' then Result:=Base+Result; 1366end; 1367 1368function SearchPascalFileInPath(const ShortFilename, BasePath, SearchPath, 1369 Delimiter: string; SearchCase: TCTSearchFileCase): string; 1370// search in each directory, first normal case, then lower case, then upper case 1371var 1372 p, StartPos, l: integer; 1373 CurPath, Base: string; 1374begin 1375 Base:=LazFileUtils.AppendPathDelim(LazFileUtils.ExpandFileNameUTF8(BasePath)); 1376 // search in current directory 1377 if not LazFileUtils.FilenameIsAbsolute(Base) then 1378 Base:=''; 1379 if Base<>'' then begin 1380 Result:=SearchPascalFileInDir(ShortFilename,Base,SearchCase); 1381 if Result<>'' then exit; 1382 end; 1383 // search in search path 1384 StartPos:=1; 1385 l:=length(SearchPath); 1386 while StartPos<=l do begin 1387 p:=StartPos; 1388 while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do inc(p); 1389 CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos)); 1390 if CurPath<>'' then begin 1391 if not LazFileUtils.FilenameIsAbsolute(CurPath) then 1392 CurPath:=Base+CurPath; 1393 CurPath…
Large files files are truncated, but you can click here to view the full file