{* UltraStar Deluxe - Karaoke Game * * UltraStar Deluxe is the legal property of its developers, whose names * are too numerous to list here. Please refer to the COPYRIGHT * file distributed with this source distribution. * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. * * $URL$ * $Id$ *} unit UPath; {$IFDEF FPC} {$MODE Delphi} {$ENDIF} {$I switches.inc} interface uses SysUtils, Classes, IniFiles, {$IFDEF MSWINDOWS} TntClasses, {$ENDIF} UConfig, UUnicodeUtils; type IPath = interface; {$IFDEF FPC} TFileHandle = THandle; {$ELSE} TFileHandle = Longint; {$ENDIF} {** * TUnicodeMemoryStream *} TUnicodeMemoryStream = class(TMemoryStream) public procedure LoadFromFile(const FileName: IPath); procedure SaveToFile(const FileName: IPath); end; {** * Unicode capable IniFile implementation. * TMemIniFile and TIniFile are not able to handle INI-files with * an UTF-8 BOM. This implementation checks if an UTF-8 BOM exists * and removes it from the internal string-list. * UTF8Encoded is set accordingly. *} TUnicodeMemIniFile = class(TMemIniFile) private FFilename: IPath; FUTF8Encoded: boolean; public constructor Create(const FileName: IPath; UTF8Encoded: boolean = false); reintroduce; procedure UpdateFile; override; property UTF8Encoded: boolean READ FUTF8Encoded WRITE FUTF8Encoded; end; {** * TBinaryFileStream (inherited from THandleStream) *} {$IFDEF MSWINDOWS} TBinaryFileStream = class(TTntFileStream) {$ELSE} TBinaryFileStream = class(TFileStream) {$ENDIF} public {** * @seealso TFileStream.Create for valid Mode parameters *} constructor Create(const FileName: IPath; Mode: word); end; {** * TTextFileStream *} TTextFileStream = class(TStream) protected fLineBreak: RawByteString; fFilename: IPath; fMode: word; function ReadLine(var Success: boolean): RawByteString; overload; virtual; abstract; public constructor Create(Filename: IPath; Mode: word); function ReadString(): RawByteString; virtual; abstract; function ReadLine(var Line: UTF8String): boolean; overload; function ReadLine(var Line: AnsiString): boolean; overload; procedure WriteString(const Str: RawByteString); virtual; procedure WriteLine(const Line: RawByteString); virtual; property LineBreak: RawByteString read fLineBreak write fLineBreak; property Filename: IPath read fFilename; end; {** * TMemTextStream *} TMemTextFileStream = class(TTextFileStream) private fStream: TMemoryStream; protected function GetSize: int64; override; {** * Copies fStream.Memory from StartPos to EndPos-1 to the result string; *} function CopyMemString(StartPos: int64; EndPos: int64): RawByteString; public constructor Create(Filename: IPath; Mode: word); destructor Destroy(); override; function Read(var Buffer; Count: longint): longint; override; function Write(const Buffer; Count: longint): longint; override; function Seek(Offset: longint; Origin: word): longint; override; function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override; function ReadLine(var Success: boolean): RawByteString; override; function ReadString(): RawByteString; override; end; {** TUnicodeIniStream = class() end; *} {** * pdKeep: Keep path as is, neither remove or append a delimiter * pdAppend: Append a delimiter if path does not have a trailing one * pdRemove: Remove a trailing delimiter from the path *} TPathDelimOption = (pdKeep, pdAppend, pdRemove); IPathDynArray = array of IPath; {** * An IPath represents a filename, a directory or a filesystem path in general. * It hides some of the operating system's specifics like path delimiters * and encodings and provides an easy to use interface to handle them. * Internally all paths are stored with the same path delimiter (PathDelim) * and encoding (UTF-8). The transformation is already done AT THE CREATION of * the IPath and hence calls to e.g. IPath.Equal() will not distinguish between * Unix and Windows style paths. * * Create new paths with one of the Path() functions. * If you need a string representation use IPath.ToNative/ToUTF8/ToWide. * Note that due to the path-delimiter and encoding transformation the string * might have changed. Path('one\test/path').ToUTF8() might return 'one/test/path'. * * It is recommended to use an IPath as long as possible without a string * conversion (IPath.To...()). The whole Delphi (< 2009) and FPC RTL is ANSI * only on Windows. If you would use for example FileExists(MyPath.ToNative) * it would not find a file which contains characters that are not in the * current locale. Same applies to AssignFile(), TFileStream.Create() and * everything else in the RTL that expects a filename. * As a rule of thumb: NEVER use any of the Delphi/FPC RTL filename functions * if the filename parameter is not of a UTF8String or WideString type. * * If you need to open a file use TBinaryStream or TFileStream instead. Many * of the RTL classes offer a LoadFromStream() method so ANSI Open() methods * can be workaround. * * If there is only a ANSI and no IPath/UTF-8/WideString version and you cannot * even pass a stream instead of a filename be aware that even if you know that * a filename is ASCII only, subdirectories in an absolute path might contain * some non-ASCII characters (for example the user's name) and hence might * fail (if the characters are not in the current locale). * It is rare but it happens. * * IMPORTANT: * This interface needs the cwstring unit on Unix (Max OS X / Linux) systems. * Cwstring functions (WideUpperCase, ...) cannot be used by external threads * as FPC uses Thread-Local-Storage for the implementation. As a result do not * call IPath stuff by external threads (e.g. in C callbacks or by SDL-threads). *} IPath = interface ['{686BF103-CE43-4598-B85D-A2C3AF950897}'] {** * Returns the path as an UTF8 encoded string. * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) * is used. If it is set to false the (more) portable '/' delimiter will used. *} function ToUTF8(UseNativeDelim: boolean = true): UTF8String; {** * Returns the path as an UTF-16 encoded string. * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) * is used. If it is set to false the delimiter will be '/'. *} function ToWide(UseNativeDelim: boolean = true): WideString; {** * Returns the path with the system's native encoding and path delimiter. * Win32: ANSI (use the UTF-16 version IPath.ToWide() whenever possible) * Mac: UTF8 * Unix: UTF8 or ANSI according to LC_CTYPE *} function ToNative(): RawByteString; {** * Note: File must be closed with FileClose(Handle) after usage * @seealso SysUtils.FileOpen() *} function Open(Mode: longword): TFileHandle; {** @seealso SysUtils.ExtractFileDrive() *} function GetDrive(): IPath; {** @seealso SysUtils.ExtractFilePath() *} function GetPath(): IPath; {** @seealso SysUtils.ExtractFileDir() *} function GetDir(): IPath; {** @seealso SysUtils.ExtractFileName() *} function GetName(): IPath; {** @seealso SysUtils.ExtractFileExtension() *} function GetExtension(): IPath; {** * Returns a copy of the path with the extension changed to Extension. * The file itself is not changed, use Rename() for this task. * @seealso SysUtils.ChangeFileExt() *} function SetExtension(const Extension: IPath): IPath; overload; function SetExtension(const Extension: RawByteString): IPath; overload; function SetExtension(const Extension: WideString): IPath; overload; {** * Returns the representation of the path relative to Basename. * Note that the basename must be terminated with a path delimiter * otherwise the last path component will be ignored. * @seealso SysUtils.ExtractRelativePath() *} function GetRelativePath(const BaseName: IPath): IPath; {** @seealso SysUtils.ExpandFileName() *} function GetAbsolutePath(): IPath; {** * Returns the concatenation of this path with Child. If this path does not * end with a path delimiter one is inserted in front of the Child path. * Example: Path('parent').Append(Path('child')) -> Path('parent/child') *} function Append(const Child: IPath; DelimOption: TPathDelimOption = pdKeep): IPath; overload; function Append(const Child: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; function Append(const Child: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; {** * Splits the path into its components. Path delimiters are not removed from * components. * Example: C:\test\my\dir -> ['C:\', 'test\', 'my\', 'dir'] *} function SplitDirs(): IPathDynArray; {** * Returns the parent directory or PATH_NONE if none exists. *} function GetParent(): IPath; {** * Checks if this path is a subdir of or file inside Parent. * If Direct is true this path must be a direct child. * Example: C:\test\file is a direct child of C:\test and a child of C:\ *} function IsChildOf(const Parent: IPath; Direct: boolean): boolean; {** * Adjusts the case of the path on case senstitive filesystems. * If the path does not exist or the filesystem is case insensitive * the original path will be returned. Otherwise a corrected copy. *} function AdjustCase(AdjustAllLevels: boolean): IPath; {** @seealso SysUtils.IncludeTrailingPathDelimiter() *} function AppendPathDelim(): IPath; {** @seealso SysUtils.ExcludeTrailingPathDelimiter() *} function RemovePathDelim(): IPath; function Exists(): boolean; function IsFile(): boolean; function IsDirectory(): boolean; function IsAbsolute(): boolean; function GetFileAge(): integer; overload; function GetFileAge(out FileDateTime: TDateTime): boolean; overload; function GetAttr(): cardinal; function SetAttr(Attr: Integer): boolean; function IsReadOnly(): boolean; function SetReadOnly(ReadOnly: boolean): boolean; {** * Checks if this path points to nothing, that means the path consists of * the empty string '' and hence equals PATH_NONE. * This is a shortcut for IPath.Equals('') or IPath.Equals(PATH_NONE). * If IsUnset() returns true this path and PATH_NONE are equal but they must * not be identical as the references might point to different objects. * * Example: * Path('').Equals(PATH_EMPTY) -> true * Path('') = PATH_EMPTY -> false *} function IsUnset(): boolean; function IsSet(): boolean; {** * Compares this path with Other and returns true if both paths are * equal. Both paths are expanded and trailing slashes excluded before * comparison. If IgnoreCase is true, the case will be ignored on * case-sensitive filesystems. *} function Equals(const Other: IPath; IgnoreCase: boolean = false): boolean; overload; function Equals(const Other: RawByteString; IgnoreCase: boolean = false): boolean; overload; function Equals(const Other: WideString; IgnoreCase: boolean = false): boolean; overload; {** * Searches for a file in DirList. The Result is nil if the file was * not found. Use IFileSystem.FileFind() instead if you want to use * wildcards. * @seealso SysUtils.FileSearch() *} function FileSearch(const DirList: IPath): IPath; {** * File must be closed with FileClose(Handle) after usage *} function CreateFile(): TFileHandle; function DeleteFile(): boolean; function CreateDirectory(Force: boolean = false): boolean; function DeleteEmptyDir(): boolean; function Rename(const NewName: IPath): boolean; function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; // TODO: Dirwatch stuff // AddFileChangeListener(Listener: TFileChangeListener); {** * Internal string representation. For debugging only. *} function GetIntern: UTF8String; property Intern: UTF8String READ GetIntern; end; {** * Creates a new path with the given pathname. PathName can be either in UTF8 * or the local encoding. * Notes: * - On Apple only UTF8 is supported * - Same applies to Unix with LC_CTYPE set to UTF8 encoding (default on newer systems) *} function Path(const PathName: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; function Path(PathName: PChar; DelimOption: TPathDelimOption = pdKeep): IPath; overload; {** * Creates a new path with the given UTF-16 pathname. *} function Path(const PathName: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; {** * Returns a singleton for Path(''). *} function PATH_NONE(): IPath; implementation uses RTLConsts, UTextEncoding, UFilesystem; {* * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019). * * There are two (probably more) scenarios causes a program to crash: * * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will * internally create a temporary variable to hold the result of Path('fail'). * This temporary var is then passed as Self to GetParent(). Unfortunately FPC * does already decrement the ref-count of the temporary var at the end of the * call to Path('fail') and the ref-count drops to zero and the temp object * is destroyed as FPC erroneously assumes that the temp is not used anymore. * As a result the Self variable in GetParent() will be invalid, the same * applies to TPathImpl.fName which reference count dropped to zero when the * temp was destroyed. Hence GetParent() will likely crash. * If it does not, ToUTF8() will either return some random string * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash. * Either way the result of ToUTF8() is messed up. * This scenario applies whenever a function (or method) is called that returns * an interfaced object (e.g. an IPath) and the result is used without storing * a reference to it in a (temporary) variable first. * * Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8(); * * will not crash but is very impractical and error-prone. Note that Tmp2 cannot * be replaced with Tmp (see scenario 2). * * 2. Another situation this bug will ruin our lives is when a variable to an * interfaced object is used at the left and right side of an assignment as in: * MyPath := MyPath.GetParent() * * Although the bug is already fixed in the FPC development version 2.3.1 * it will take quite some time till the next FPC release (> 2.2.4) in which * this issue is fixed. * * To workaround this bug we use some very simple and stupid kind of garbage * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList) * to artificially increase the ref-count of the newly created object. * This keeps the object alive when FPC's temporary variable comes to the end * of its lifetime and the object's ref-count is decremented * (and is now 1 instead of 0). * Later on, the object is either garbage or referenced by another variable. * * Look at * MyPath := Path('SomeDir/SubDir').GetParent() * * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore. * (2) The result of GetParent() is referenced by MyPath * Object (1) has a reference count of 1 (as it is only referenced by the * GarbageList). Object (2) is referenced twice (MyPath + GarbageList). * When the reference to (2) is finally stored in MyPath we can safely remove * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of * (2) will be decremented to 1. * * As we do not know when it is safe to remove an object from the GarbageList * we assume that there are max. GarbageMaxCount IPath elements created until * the execution of the expression is performed and a reference to the resulting * object is assigned to a variable so all temps can be safely deleted. * * Worst-case scenarios are recursive calls or calls with large call stacks with * functions that return an IPath. Also keep in mind that multiple threads might * be executing such functions at the same time. * A reasonable count might be a max. of 20.000 elements. With an average length * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath * this will consume ~1.2MB. *} {$IFDEF FPC} {$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4 {$DEFINE HAVE_REFCNTBUG} {$IFEND} {$ENDIF} {$IFDEF HAVE_REFCNTBUG} const // when GarbageList.Count reaches GarbageMaxCount the oldest references in // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount. GarbageMaxCount = 20000; GarbageAfterCleanCount = GarbageMaxCount-1000; var GarbageList: IInterfaceList; {$ENDIF} type TPathImpl = class(TInterfacedObject, IPath) private fName: UTF8String; //<** internal filename string, always UTF8 with PathDelim {** * Unifies the filename. Path-delimiters are replaced by '/'. *} procedure Unify(DelimOption: TPathDelimOption); {** * Returns a copy of fName with path delimiters changed to '/'. *} function GetPortableString(): UTF8String; procedure AssertRefCount; {$IFDEF HasInline}inline;{$ENDIF} public constructor Create(const Name: UTF8String; DelimOption: TPathDelimOption); destructor Destroy(); override; function ToUTF8(UseNativeDelim: boolean): UTF8String; function ToWide(UseNativeDelim: boolean): WideString; function ToNative(): RawByteString; function Open(Mode: longword): TFileHandle; function GetDrive(): IPath; function GetPath(): IPath; function GetDir(): IPath; function GetName(): IPath; function GetExtension(): IPath; function SetExtension(const Extension: IPath): IPath; overload; function SetExtension(const Extension: RawByteString): IPath; overload; function SetExtension(const Extension: WideString): IPath; overload; function GetRelativePath(const BaseName: IPath): IPath; function GetAbsolutePath(): IPath; function GetParent(): IPath; function SplitDirs(): IPathDynArray; function Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; overload; function Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; overload; function Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; overload; function Equals(const Other: IPath; IgnoreCase: boolean): boolean; overload; function Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; overload; function Equals(const Other: WideString; IgnoreCase: boolean): boolean; overload; function IsChildOf(const Parent: IPath; Direct: boolean): boolean; function AdjustCase(AdjustAllLevels: boolean): IPath; function AppendPathDelim(): IPath; function RemovePathDelim(): IPath; function GetFileAge(): integer; overload; function GetFileAge(out FileDateTime: TDateTime): boolean; overload; function Exists(): boolean; function IsFile(): boolean; function IsDirectory(): boolean; function IsAbsolute(): boolean; function GetAttr(): cardinal; function SetAttr(Attr: Integer): boolean; function IsReadOnly(): boolean; function SetReadOnly(ReadOnly: boolean): boolean; function IsUnset(): boolean; function IsSet(): boolean; function FileSearch(const DirList: IPath): IPath; function CreateFile(): TFileHandle; function DeleteFile(): boolean; function CreateDirectory(Force: boolean): boolean; function DeleteEmptyDir(): boolean; function Rename(const NewName: IPath): boolean; function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; function GetIntern(): UTF8String; end; function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath; begin if (IsUTF8String(PathName)) then Result := TPathImpl.Create(PathName, DelimOption) else if (IsNativeUTF8()) then Result := PATH_NONE else Result := TPathImpl.Create(AnsiToUtf8(PathName), DelimOption); end; function Path(PathName: PChar; DelimOption: TPathDelimOption): IPath; begin Result := Path(RawByteString(PathName)); end; function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath; begin Result := TPathImpl.Create(UTF8Encode(PathName), DelimOption); end; procedure TPathImpl.AssertRefCount; begin {$IFDEF HAVE_REFCNTBUG} if (FRefCount <= 0) then raise Exception.Create('RefCount error: ' + IntToStr(FRefCount)); {$ENDIF} end; constructor TPathImpl.Create(const Name: UTF8String; DelimOption: TPathDelimOption); begin inherited Create(); fName := Name; Unify(DelimOption); {$IFDEF HAVE_REFCNTBUG} GarbageList.Lock; if (GarbageList.Count >= GarbageMaxCount) then begin while (GarbageList.Count > GarbageAfterCleanCount) do GarbageList.Delete(0); end; GarbageList.Add(Self); GarbageList.Unlock; {$ENDIF} end; destructor TPathImpl.Destroy(); begin inherited; end; procedure TPathImpl.Unify(DelimOption: TPathDelimOption); var I: integer; begin // convert all path delimiters to native ones for I := 1 to Length(fName) do begin if (fName[I] in ['\', '/']) and (fName[I] <> PathDelim) then fName[I] := PathDelim; end; // Include/ExcludeTrailingPathDelimiter need PathDelim as path delimiter case DelimOption of pdAppend: fName := IncludeTrailingPathDelimiter(fName); pdRemove: fName := ExcludeTrailingPathDelimiter(fName); end; end; function TPathImpl.GetPortableString(): UTF8String; var I: integer; begin Result := fName; if (PathDelim = '/') then Exit; for I := 1 to Length(Result) do begin if (Result[I] = PathDelim) then Result[I] := '/'; end; end; function TPathImpl.ToUTF8(UseNativeDelim: boolean): UTF8String; begin AssertRefCount; if (UseNativeDelim) then Result := fName else Result := GetPortableString(); end; function TPathImpl.ToWide(UseNativeDelim: boolean): WideString; begin if (UseNativeDelim) then Result := UTF8Decode(fName) else Result := UTF8Decode(GetPortableString()); end; function TPathImpl.ToNative(): RawByteString; begin if (IsNativeUTF8()) then Result := fName else Result := Utf8ToAnsi(fName); end; function TPathImpl.GetDrive(): IPath; begin AssertRefCount; Result := FileSystem.ExtractFileDrive(Self); end; function TPathImpl.GetPath(): IPath; begin AssertRefCount; Result := FileSystem.ExtractFilePath(Self); end; function TPathImpl.GetDir(): IPath; begin AssertRefCount; Result := FileSystem.ExtractFileDir(Self); end; function TPathImpl.GetName(): IPath; begin AssertRefCount; Result := FileSystem.ExtractFileName(Self); end; function TPathImpl.GetExtension(): IPath; begin AssertRefCount; Result := FileSystem.ExtractFileExt(Self); end; function TPathImpl.SetExtension(const Extension: IPath): IPath; begin AssertRefCount; Result := FileSystem.ChangeFileExt(Self, Extension); end; function TPathImpl.SetExtension(const Extension: RawByteString): IPath; begin Result := SetExtension(Path(Extension)); end; function TPathImpl.SetExtension(const Extension: WideString): IPath; begin Result := SetExtension(Path(Extension)); end; function TPathImpl.GetRelativePath(const BaseName: IPath): IPath; begin AssertRefCount; Result := FileSystem.ExtractRelativePath(BaseName, Self); end; function TPathImpl.GetAbsolutePath(): IPath; begin AssertRefCount; Result := FileSystem.ExpandFileName(Self); end; function TPathImpl.GetParent(): IPath; var CurPath, ParentPath: IPath; begin AssertRefCount; Result := PATH_NONE; CurPath := Self.RemovePathDelim(); // check if current path has a parent (no further '/') if (Pos(PathDelim, CurPath.ToUTF8()) = 0) then Exit; // set new path and check if it has changed to avoid endless loops // e.g. with invalid paths like '/C:' (GetPath() uses ':' as delimiter too) // on delphi/win32 ParentPath := CurPath.GetPath(); if (ParentPath.ToUTF8 = CurPath.ToUTF8) then Exit; Result := ParentPath; end; function TPathImpl.SplitDirs(): IPathDynArray; var CurPath: IPath; Components: array of IPath; CurPathStr: UTF8String; DelimPos: integer; I: integer; begin SetLength(Result, 0); if (Length(Self.ToUTF8(true)) = 0) then Exit; CurPath := Self; SetLength(Components, 0); repeat SetLength(Components, Length(Components)+1); CurPathStr := CurPath.ToUTF8(); DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr)); Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr))); CurPath := CurPath.GetParent(); until (CurPath = PATH_NONE); // reverse list SetLength(Result, Length(Components)); for I := 0 to High(Components) do Result[I] := Components[High(Components)-I]; end; function TPathImpl.Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; var TmpResult: IPath; begin AssertRefCount; if (fName = '') then TmpResult := Child else TmpResult := Path(Self.AppendPathDelim().ToUTF8() + Child.ToUTF8()); case DelimOption of pdKeep: Result := TmpResult; pdAppend: Result := TmpResult.AppendPathDelim; pdRemove: Result := TmpResult.RemovePathDelim; end; end; function TPathImpl.Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; begin AssertRefCount; Result := Append(Path(Child), DelimOption); end; function TPathImpl.Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; begin AssertRefCount; Result := Append(Path(Child), DelimOption); end; function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean; var SelfPath, OtherPath: UTF8String; begin SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8(); OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8(); if (FileSystem.IsCaseSensitive() and not IgnoreCase) then Result := (CompareStr(SelfPath, OtherPath) = 0) else Result := (CompareText(SelfPath, OtherPath) = 0); end; function TPathImpl.Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; begin Result := Equals(Path(Other), IgnoreCase); end; function TPathImpl.Equals(const Other: WideString; IgnoreCase: boolean): boolean; begin Result := Equals(Path(Other), IgnoreCase); end; function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean; var SelfPath, ParentPath: UTF8String; begin Result := false; if (Direct) then begin SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8(); ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); // simply check if this paths parent path (SelfPath) equals ParentPath Result := (SelfPath = ParentPath); end else begin SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8(); ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); if (Length(SelfPath) <= Length(ParentPath)) then Exit; // check if ParentPath is a substring of SelfPath if (FileSystem.IsCaseSensitive()) then Result := (StrLComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) else Result := (StrLIComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) end; end; function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath; var OldParent, AdjustedParent: IPath; LocalName: IPath; PathFound: IPath; PathWithAdjParent: IPath; SearchInfo: TFileInfo; FileIter: IFileIterator; Pattern: IPath; begin // if case-sensitive path exists there is no need to adjust case if (CurPath.Exists()) then begin Result := CurPath; Exit; end; LocalName := CurPath.RemovePathDelim().GetName(); // try to adjust parent OldParent := CurPath.GetParent(); if (OldParent <> PATH_NONE) then begin if (not AdjustAllLevels) then begin AdjustedParent := OldParent; end else begin AdjustedParent := AdjustCaseRecursive(OldParent, AdjustAllLevels); if (AdjustedParent = nil) then begin // parent path was not found case-insensitive Result := nil; Exit; end; // check if the path with adjusted parent can be found now PathWithAdjParent := AdjustedParent.Append(LocalName); if (PathWithAdjParent.Exists()) then begin Result := PathWithAdjParent; Exit; end; end; Pattern := AdjustedParent.Append(Path('*')); end else // path has no parent begin // the top path can either be absolute or relative if (CurPath.IsAbsolute) then begin // the only absolute directory at Unix without a parent is root ('/') // and hence does not need to be adjusted Result := CurPath; Exit; end; // this is a relative path, search in the current working dir AdjustedParent := nil; Pattern := Path('*'); end; // compare name with all files in the current directory case-insensitive FileIter := FileSystem.FileFind(Pattern, faAnyFile); while (FileIter.HasNext()) do begin SearchInfo := FileIter.Next(); PathFound := SearchInfo.Name; if (CompareText(LocalName.ToUTF8, PathFound.ToUTF8) = 0) then begin if (AdjustedParent <> nil) then Result := AdjustedParent.Append(PathFound) else Result := PathFound; Exit; end; end; // no matching file found Result := nil; end; function TPathImpl.AdjustCase(AdjustAllLevels: boolean): IPath; begin AssertRefCount; Result := Self; if (FileSystem.IsCaseSensitive) then begin Result := AdjustCaseRecursive(Self, AdjustAllLevels); if (Result = nil) then Result := Self; end; end; function TPathImpl.AppendPathDelim(): IPath; begin AssertRefCount; Result := FileSystem.IncludeTrailingPathDelimiter(Self); end; function TPathImpl.RemovePathDelim(): IPath; begin AssertRefCount; Result := FileSystem.ExcludeTrailingPathDelimiter(Self); end; function TPathImpl.CreateFile(): TFileHandle; begin Result := FileSystem.FileCreate(Self); end; function TPathImpl.CreateDirectory(Force: boolean): boolean; begin if (Force) then Result := FileSystem.ForceDirectories(Self) else Result := FileSystem.DirectoryCreate(Self); end; function TPathImpl.Open(Mode: longword): TFileHandle; begin Result := FileSystem.FileOpen(Self, Mode); end; function TPathImpl.GetFileAge(): integer; begin Result := FileSystem.FileAge(Self); end; function TPathImpl.GetFileAge(out FileDateTime: TDateTime): boolean; begin Result := FileSystem.FileAge(Self, FileDateTime); end; function TPathImpl.Exists(): boolean; begin // note the different specifications of FileExists() on Win32 <> Unix {$IFDEF MSWINDOWS} Result := IsFile() or IsDirectory(); {$ELSE} Result := FileSystem.FileExists(Self); {$ENDIF} end; function TPathImpl.IsFile(): boolean; begin // note the different specifications of FileExists() on Win32 <> Unix {$IFDEF MSWINDOWS} Result := FileSystem.FileExists(Self); {$ELSE} Result := Exists() and not IsDirectory(); {$ENDIF} end; function TPathImpl.IsDirectory(): boolean; begin Result := FileSystem.DirectoryExists(Self); end; function TPathImpl.IsAbsolute(): boolean; begin AssertRefCount; Result := FileSystem.FileIsAbsolute(Self); end; function TPathImpl.GetAttr(): cardinal; begin Result := FileSystem.FileGetAttr(Self); end; function TPathImpl.SetAttr(Attr: Integer): boolean; begin Result := FileSystem.FileSetAttr(Self, Attr); end; function TPathImpl.IsReadOnly(): boolean; begin Result := FileSystem.FileIsReadOnly(Self); end; function TPathImpl.SetReadOnly(ReadOnly: boolean): boolean; begin Result := FileSystem.FileSetReadOnly(Self, ReadOnly); end; function TPathImpl.IsUnset(): boolean; begin Result := (fName = ''); end; function TPathImpl.IsSet(): boolean; begin Result := (fName <> ''); end; function TPathImpl.FileSearch(const DirList: IPath): IPath; begin AssertRefCount; Result := FileSystem.FileSearch(Self, DirList); end; function TPathImpl.Rename(const NewName: IPath): boolean; begin Result := FileSystem.RenameFile(Self, NewName); end; function TPathImpl.DeleteFile(): boolean; begin Result := FileSystem.DeleteFile(Self); end; function TPathImpl.DeleteEmptyDir(): boolean; begin Result := FileSystem.RemoveDir(Self); end; function TPathImpl.CopyFile(const Target: IPath; FailIfExists: boolean): boolean; begin Result := FileSystem.CopyFile(Self, Target, FailIfExists); end; function TPathImpl.GetIntern(): UTF8String; begin Result := fName; end; { TBinaryFileStream } constructor TBinaryFileStream.Create(const FileName: IPath; Mode: word); begin {$IFDEF MSWINDOWS} inherited Create(FileName.ToWide(), Mode); {$ELSE} inherited Create(FileName.ToNative(), Mode); {$ENDIF} end; { TTextStream } constructor TTextFileStream.Create(Filename: IPath; Mode: word); begin inherited Create(); fMode := Mode; fFilename := Filename; fLineBreak := sLineBreak; end; function TTextFileStream.ReadLine(var Line: UTF8String): boolean; begin Line := ReadLine(Result); end; function TTextFileStream.ReadLine(var Line: AnsiString): boolean; begin Line := ReadLine(Result); end; procedure TTextFileStream.WriteString(const Str: RawByteString); begin WriteBuffer(Str[1], Length(Str)); end; procedure TTextFileStream.WriteLine(const Line: RawByteString); begin WriteBuffer(Line[1], Length(Line)); WriteBuffer(fLineBreak[1], Length(fLineBreak)); end; { TMemTextStream } constructor TMemTextFileStream.Create(Filename: IPath; Mode: word); var FileStream: TBinaryFileStream; begin inherited Create(Filename, Mode); fStream := TMemoryStream.Create(); // load data to memory in read mode if ((Mode and 3) in [fmOpenRead, fmOpenReadWrite]) then begin FileStream := TBinaryFileStream.Create(Filename, fmOpenRead); try fStream.LoadFromStream(FileStream); finally FileStream.Free; end; end // check if file exists for write-mode else if ((Mode and 3) = fmOpenWrite) and (not Filename.IsFile) then begin raise EFOpenError.CreateResFmt(@SFOpenError, [FileName.GetAbsolutePath.ToNative]); end; end; destructor TMemTextFileStream.Destroy(); var FileStream: TBinaryFileStream; SaveMode: word; begin // save changes in write mode (= not read-only mode) if ((fMode and 3) <> fmOpenRead) then begin if (fMode = fmCreate) then SaveMode := fmCreate else SaveMode := fmOpenWrite; FileStream := TBinaryFileStream.Create(fFilename, SaveMode); try fStream.SaveToStream(FileStream); finally FileStream.Free; end; end; fStream.Free; inherited; end; function TMemTextFileStream.GetSize: int64; begin Result := fStream.Size; end; function TMemTextFileStream.Read(var Buffer; Count: longint): longint; begin Result := fStream.Read(Buffer, Count); end; function TMemTextFileStream.Write(const Buffer; Count: longint): longint; begin Result := fStream.Write(Buffer, Count); end; function TMemTextFileStream.Seek(Offset: longint; Origin: word): longint; begin Result := fStream.Seek(Offset, Origin); end; function TMemTextFileStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64; begin Result := fStream.Seek(Offset, Origin); end; function TMemTextFileStream.CopyMemString(StartPos: int64; EndPos: int64): RawByteString; var LineLength: cardinal; Temp: RawByteString; begin LineLength := EndPos - StartPos; if (LineLength > 0) then begin // set string length to line-length (+ zero-terminator) SetLength(Temp, LineLength); StrLCopy(PAnsiChar(Temp), @PAnsiChar(fStream.Memory)[StartPos], LineLength); Result := Temp; end else begin Result := ''; end; end; function TMemTextFileStream.ReadString(): RawByteString; var TextPtr: PAnsiChar; CurPos, StartPos, FileSize: int64; begin TextPtr := PAnsiChar(fStream.Memory); CurPos := Position; FileSize := Size; StartPos := -1; while (CurPos < FileSize) do begin // check for whitespace (tab, lf, cr, space) if (TextPtr[CurPos] in [#9, #10, #13, ' ']) then begin // check if we are at the end of a string if (StartPos > -1) then Break; end else if (StartPos = -1) then // start of string found begin StartPos := CurPos; end; Inc(CurPos); end; if (StartPos = -1) then Result := '' else begin Result := CopyMemString(StartPos, CurPos); fStream.Position := CurPos; end; end; {* * Implementation of ReadLine(). We need separate versions for UTF8String * and AnsiString as "var" parameter types have to fit exactly. * To avoid a var-parameter here, the internal version the Line parameter is * used as return value. *} function TMemTextFileStream.ReadLine(var Success: boolean): RawByteString; var TextPtr: PAnsiChar; CurPos, FileSize: int64; begin TextPtr := PAnsiChar(fStream.Memory); CurPos := fStream.Position; FileSize := Size; // check for EOF if (CurPos >= FileSize) then begin Result := ''; Success := false; Exit; end; Success := true; while (CurPos < FileSize) do begin if (TextPtr[CurPos] in [#10, #13]) then begin // copy text line Result := CopyMemString(fStream.Position, CurPos); // handle windows style #13#10 (\r\n) newlines if (TextPtr[CurPos] = #13) and (CurPos+1 < FileSize) and (TextPtr[CurPos+1] = #10) then begin Inc(CurPos); end; // update stream pos fStream.Position := CurPos+1; Exit; end; Inc(CurPos); end; Result := CopyMemString(fStream.Position, CurPos); fStream.Position := FileSize; end; { TUnicodeMemoryStream } procedure TUnicodeMemoryStream.LoadFromFile(const FileName: IPath); var Stream: TStream; begin Stream := TBinaryFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); try LoadFromStream(Stream); finally Stream.Free; end; end; procedure TUnicodeMemoryStream.SaveToFile(const FileName: IPath); var Stream: TStream; begin Stream := TBinaryFileStream.Create(FileName, fmCreate); try SaveToStream(Stream); finally Stream.Free; end; end; { TUnicodeMemIniFile } constructor TUnicodeMemIniFile.Create(const FileName: IPath; UTF8Encoded: boolean); var List: TStringList; Stream: TBinaryFileStream; BOMBuf: array[0..2] of AnsiChar; begin inherited Create(''); FFilename := FileName; FUTF8Encoded := UTF8Encoded; if FileName.Exists() then begin List := nil; Stream := nil; try List := TStringList.Create; Stream := TBinaryFileStream.Create(FileName, fmOpenRead); if (Stream.Read(BOMBuf[0], SizeOf(BOMBuf)) = 3) and (CompareMem(PChar(UTF8_BOM), @BomBuf, Length(UTF8_BOM))) then begin // truncate BOM FUTF8Encoded := true; end else begin // rewind file Stream.Seek(0, soBeginning); end; List.LoadFromStream(Stream); SetStrings(List); finally Stream.Free; List.Free; end; end; end; procedure TUnicodeMemIniFile.UpdateFile; var List: TStringList; Stream: TBinaryFileStream; begin List := nil; Stream := nil; try List := TStringList.Create; GetStrings(List); Stream := TBinaryFileStream.Create(FFileName, fmCreate); if UTF8Encoded then Stream.Write(UTF8_BOM, Length(UTF8_BOM)); List.SaveToStream(Stream); finally List.Free; Stream.Free; end; end; var PATH_NONE_Singelton: IPath; function PATH_NONE(): IPath; begin Result := PATH_NONE_Singelton; end; initialization {$IFDEF HAVE_REFCNTBUG} GarbageList := TInterfaceList.Create(); GarbageList.Capacity := GarbageMaxCount; {$ENDIF} PATH_NONE_Singelton := Path(''); finalization PATH_NONE_Singelton := nil; end.