PageRenderTime 72ms CodeModel.GetById 26ms app.highlight 23ms RepoModel.GetById 1ms app.codeStats 3ms

/components/codetools/fileprocs.pas

http://github.com/graemeg/lazarus
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