{* 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;
{**
* 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): THandle;
{** @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(): THandle;
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;
{**
* 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; inline;
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): THandle;
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(): THandle;
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(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(): THandle;
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): THandle;
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.FileIsReadOnly(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.