File utility functions v3.02

unit cFileUtils;

interface

uses

Windows,

SysUtils;

const
PathSeperator =
;

function  PathHasDriveLetter(const Path: String): Boolean;
function  PathIsDriveLetter(const Path: String): Boolean;
function  PathIsDriveRoot(const Path: String): Boolean;
function  PathIsRoot(const Path: String): Boolean;
function  PathIsUNCPath(const Path: String): Boolean;
function  PathIsAbsolute(const Path: String): Boolean;
function  PathIsDirectory(const Path: String): Boolean;
function  PathInclSuffix(const Path: String;
const PathSep: Char = PathSeperator): String;
function  PathExclSuffix(const Path: String;
const PathSep: Char = PathSeperator): String;
procedure PathEnsureSuffix(var Path: String;
const PathSep: Char = PathSeperator);
procedure PathEnsureNoSuffix(var Path: String;
const PathSep: Char = PathSeperator);
function  PathCanonical(const Path: String;
const PathSep: Char = PathSeperator): String;
function  PathExpand(const Path: String; const BasePath: String = ;
const PathSep: Char = PathSeperator): String;

function  PathLeftElement(const Path: String;
const PathSep: Char = PathSeperator): String;
procedure PathSplitLeftElement(const Path: String;
var LeftElement, RightPath: String;
const PathSep: Char = PathSeperator);

procedure DecodeFilePath(const FilePath: String;
var Path, FileName: String;
const PathSep: Char = PathSeperator);

function  FileNameValid(const FileName: String): String;
function  FilePath(const FileName, Path: String; const BasePath: String = ;
const PathSep: Char = PathSeperator): String;

function  DirectoryExpand(const Path: String; const BasePath: String = ;
const PathSep: Char = PathSeperator): String;

function  UnixPathToWinPath(const Path: String): String;
function  WinPathToUnixPath(const Path: String): String;

type
EFileError = class(Exception);

function  GetFileSize(const FileName: String): Int64;
function  GetFileDateTime(const FileName: String): TDateTime;
function  GetFirstFileNameMatching(const FileMask: String): String;
function  DirEntryGetAttr(const FileName: String): Integer;
function  DirEntryIsDirectory(const FileName: String): Boolean;
function  FileHasAttr(const FileName: String; const Attr: Word): Boolean;
function  FileIsReadOnly(const FileName: String): Boolean;
procedure CopyFile(const FileName, DestName: String);
procedure MoveFile(const FileName, DestName: String);
function  DeleteFiles(const FileMask: String): Boolean;

type
TLogicalDriveType = (
DriveRemovable,
DriveFixed,
DriveRemote,
DriveCDRom,
DriveRamDisk,
DriveTypeUnknown);

function  DriveIsValid(const Drive: Char): Boolean;
function  DriveGetType(const Path: String): TLogicalDriveType;
function  DriveFreeSpace(const Path: String): Int64;

procedure SelfTest;

implementation

uses

cUtils,
cStrings;

function PathHasDriveLetter(const Path: String): Boolean;
var P: PChar;
begin
Result := False;
if Length(Path) <  then
exit;
P := Pointer(Path);
if not (P^ in [.., ..]) then
exit;
Inc(P);
if P^ <>  then
exit;
Result := True;
end;

function PathIsDriveLetter(const Path: String): Boolean;
begin
Result := (Length(Path) = ) and PathHasDriveLetter(Path);
end;

function PathIsDriveRoot(const Path: String): Boolean;
begin
Result := (Length(Path) = ) and PathHasDriveLetter(Path) and
(Path[] = );
end;

function PathIsRoot(const Path: String): Boolean;
begin
Result := ((Length(Path) = ) and (Path[] in csSlash)) or
PathIsDriveRoot(Path);
end;

function PathIsUNCPath(const Path: String): Boolean;
var P: PChar;
begin
Result := False;
if Length(Path) <  then
exit;
P := Pointer(Path);
if P^ <>  then
exit;
Inc(P);
if P^ <>  then
exit;
Result := True;
end;

function PathIsAbsolute(const Path: String): Boolean;
begin
if Path =  then
Result := False else
if PathHasDriveLetter(Path) then
Result := True else
if PChar(Pointer(Path))^ in [, ] then
Result := True else
Result := False;
end;

function PathIsDirectory(const Path: String): Boolean;
var L: Integer;
P: PChar;
begin
L := Length(Path);
if L =  then
Result := False else
if (L = ) and PathHasDriveLetter(Path) then
Result := True else
begin
P := Pointer(Path);
Inc(P, L - );
Result := P^ in csSlash;
end;
end;

function PathInclSuffix(const Path: String; const PathSep: Char): String;
var L: Integer;
P: PChar;
begin
L := Length(Path);
if L =  then
Result :=  else
begin
P := Pointer(Path);
Inc(P, L - );
if P^ = PathSep then
Result := Path else
Result := Path + PathSep;
end;
end;

procedure PathEnsureSuffix(var Path: String; const PathSep: Char);
begin
Path := PathInclSuffix(Path, PathSep);
end;

procedure PathEnsureNoSuffix(var Path: String; const PathSep: Char);
begin
Path := PathExclSuffix(Path, PathSep);
end;

function PathExclSuffix(const Path: String; const PathSep: Char): String;
var L: Integer;
P: PChar;
begin
L := Length(Path);
if L =  then
Result :=  else
begin
P := Pointer(Path);
Inc(P, L - );
if P^ = PathSep then
Result := Copy(Path, , L - ) else
Result := Path;
end;
end;

function PathCanonical(const Path: String; const PathSep: Char): String;
var L, M : Integer;
I, J : Integer;
P    : StringArray;
Q    : PChar;
begin
Result := Path;

M := Length(Result);
Repeat
L := M;
if L =  then
exit;
Result := StrReplace(, , Result);
Result := StrReplace(, , Result);
M := Length(Result);
Until L = M;

StrEnsureNoPrefix(Result, );
StrEnsureNoPrefix(Result, );

StrEnsureNoSuffix(Result, );
StrEnsureNoSuffix(Result, );

if Pos(, Result) >  then
begin
P := StrSplitChar(Result, PathSep);
Repeat
J := -;
For I := Length(P) -  downto  do
if P[I] =  then
begin
J := I;
break;
end;
if J = - then
break;
M := -;
For I := J -  downto  do
if (P[I] = ) or ((I = ) and PathHasDriveLetter(P[I])) then
break else
if P[I] <>  then
begin
M := I;
break;
end;
if M = - then
break;
Remove(P, J, );
Remove(P, M, );
Until False;
Result := StrJoinChar(P, PathSep);
end;

While StrMatchLeft(Result, ) do
Delete(Result, , );
While StrMatchLeft(Result, ) do
Delete(Result, , );
if (Result = ) or (Result = ) then
Result := ;
L := Length(Result);
if L =  then
exit;

Q := Pointer(Result);
if Q^ in [.., ..] then
begin
if StrMatch(Result, , ) then
Delete(Result, , ) else
if (L = ) and StrMatch(Result, , ) then
begin
SetLength(Result, );
exit;
end;
L := Length(Result);
end;

Q := Pointer(Result);
if L =  then
begin
if Q^ =  then
Result := ;
exit;
end;

Inc(Q, L - );
if not (Q^ in [, , , ]) then
begin
Inc(Q);
if Q^ =  then
Delete(Result, L, );
end;
end;

function PathExpand(const Path: String; const BasePath: String;
const PathSep: Char): String;
begin
if Path =  then
Result := BasePath else
if PathIsAbsolute(Path) then
Result := Path else
Result := PathInclSuffix(BasePath, PathSep) + Path;
Result := PathCanonical(Result, PathSep);
end;

function PathLeftElement(const Path: String; const PathSep: Char): String;
var I: Integer;
begin
I := PosChar(PathSep, Path);
if I <=  then
Result := Path else
Result := Copy(Path, , I - );
end;

procedure PathSplitLeftElement(const Path: String;
var LeftElement, RightPath: String; const PathSep: Char);
var I: Integer;
begin
I := PosChar(PathSep, Path);
if I <=  then
begin
LeftElement := Path;
RightPath := ;
end else
begin
LeftElement := Copy(Path, , I - );
RightPath := CopyFrom(Path, I + );
end;
end;

procedure DecodeFilePath(const FilePath: String; var Path, FileName: String;
const PathSep: Char);
var I: Integer;
begin
I := PosCharRev(PathSep, FilePath);
if I <=  then
begin
Path := ;
FileName := FilePath;
end else
begin
Path := Copy(FilePath, , I);
FileName := CopyFrom(FilePath, I + );
end;
end;

function FileNameValid(const FileName: String): String;
begin
Result := StrReplaceChar([, , , , , , ], , FileName);
if Result =  then
Result :=  else
if Result =  then
Result := ;
end;

function FilePath(const FileName, Path: String; const BasePath: String;
const PathSep: Char): String;
var P, F: String;
begin
F := FileNameValid(FileName);
if F =  then
begin
Result := ;
exit;
end;
P := PathExpand(Path, BasePath, PathSep);
if P =  then
Result := F else
Result := PathInclSuffix(P, PathSep) + F;
End;

function DirectoryExpand(const Path: String; const BasePath: String;
const PathSep: Char): String;
begin
Result := PathExpand(PathInclSuffix(Path, PathSep),
PathInclSuffix(BasePath), PathSep);
end;

function UnixPathToWinPath(const Path: String): String;
begin
Result := StrReplaceChar(, ,
StrReplaceChar([, , , , ], , Path));
end;

function WinPathToUnixPath(const Path: String): String;
begin
Result := Path;
if PathHasDriveLetter(Path) then
begin

Result[] := Result[];
Result[] := ;
end else
if StrMatchLeft(Path, ) then

Delete(Result, , ) else
if PathIsUncPath(Path) then

Delete(Result, , );
Result := StrReplaceChar(, ,
StrReplaceChar([, , , , ], , Result));
end;

function GetFileSize(const FileName: String): Int64;
var SRec : TSearchRec;
begin
if FindFirst(FileName, faAnyFile, SRec) <>  then
Result := - else
begin

Int64Rec(Result).Lo := SRec.FindData.nFileSizeLow;
Int64Rec(Result).Hi := SRec.FindData.nFileSizeHigh;

Result := SRec.Size;

FindClose(SRec);
end;
end;

function GetFileDateTime(const FileName: String): TDateTime;
var Age : LongInt;
begin
Age := FileAge(FileName);
if Age = - then
Result :=
else
Result := FileDateToDateTime(Age);
end;

function GetFirstFileNameMatching(const FileMask: String): String;
var SRec : TSearchRec;
begin
Result := ;
if FindFirst(FileMask, faAnyFile, SRec) =  then
try
Repeat
if SRec.Attr and faDirectory =  then
begin
Result := ExtractFilePath(FileMask) + SRec.Name;
exit;
end;
Until FindNext(SRec) <> ;
finally
FindClose(SRec);
end;
end;

function DirEntryGetAttr(const FileName: String): Integer;
var SRec : TSearchRec;
begin
if (FileName = ) or PathIsDriveLetter(FileName) then
Result := - else
if PathIsRoot(FileName) then
Result :=  or faDirectory else
if FindFirst(PathExclSuffix(FileName, ), faAnyFile, SRec) =  then
begin
Result := SRec.Attr;
FindClose(SRec);
end
else
Result := -;
end;

function DirEntryIsDirectory(const FileName: String): Boolean;
var SRec : TSearchRec;
begin
if (FileName = ) or PathIsDriveLetter(FileName) then
Result := False else
if PathIsRoot(FileName) then
Result := True else
if FindFirst(PathExclSuffix(FileName, ), faDirectory, SRec) =  then
begin
Result := SRec.Attr and faDirectory <> ;
FindClose(SRec);
end
else
Result := False;
end;

function FileHasAttr(const FileName: String; const Attr: Word): Boolean;
var A : Integer;
begin
A := FileGetAttr(FileName);
Result := (A >= ) and (A and Attr <> );
end;

function FileIsReadOnly(const FileName: String): Boolean;
begin
Result := FileHasAttr(FileName, faReadOnly);
end;

procedure CopyFile(const FileName, DestName: String);
var
CopyBuffer   : Pointer;
BytesCopied  : Longint;
Source, Dest : Integer;
Destination  : TFileName;
const
ChunkSize = ;
begin
Destination := ExpandFileName(DestName);
if FileHasAttr(Destination, faDirectory) then
Destination := Destination +  + ExtractFileName(FileName);
GetMem(CopyBuffer, ChunkSize);
try
Source := FileOpen(FileName, fmShareDenyWrite);
if Source <  then
raise EFileError.CreateFmt(, [FileName]);
try
Dest := FileCreate(Destination);
if Dest <  then
raise EFileError.CreateFmt(, [Destination]);
try
Repeat
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize);
if BytesCopied >  then
FileWrite(Dest, CopyBuffer^, BytesCopied);
Until BytesCopied < ChunkSize;
finally
FileClose(Dest);
end;
finally
FileClose(Source);
end;
finally
FreeMem(CopyBuffer, ChunkSize);
end;
end;

procedure MoveFile(const FileName, DestName: String);
var Destination : String;
Attr : Integer;
begin
Destination := ExpandFileName(DestName);
if not RenameFile(FileName, Destination) then
begin
Attr := FileGetAttr(FileName);
if (Attr < ) or (Attr and faReadOnly <> ) then
raise EFileError.Create(Format(, [FileName]));
CopyFile(FileName, Destination);
DeleteFile(FileName);
end;
end;

function DeleteFiles(const FileMask: String): Boolean;
var SRec : TSearchRec;
Path : String;
begin
Result := FindFirst(FileMask, faAnyFile, SRec) = ;
if not Result then
exit;
try
Path := ExtractFilePath(FileMask);
Repeat
if (SRec.Name <> ) and (SRec.Name  <> ) and (SRec.Name <> ) and
(SRec.Attr and (faVolumeID + faDirectory) = ) then
begin
Result := DeleteFile(Path + SRec.Name);
if not Result then
break;
end;
Until FindNext(SRec) <> ;
finally
FindClose(SRec);
end;
end;

function DriveIsValid(const Drive: Char): Boolean;
var D : Char;
begin
D := UpCase(Drive);
Result := D in [..];
if not Result then
exit;
Result := IsBitSet(GetLogicalDrives, Ord(D) - Ord());
end;

function DriveGetType(const Path: String): TLogicalDriveType;
begin
Case GetDriveType(PChar(Path)) of
DRIVE_REMOVABLE : Result := DriveRemovable;
DRIVE_FIXED     : Result := DriveFixed;
DRIVE_REMOTE    : Result := DriveRemote;
DRIVE_CDROM     : Result := DriveCDRom;
DRIVE_RAMDISK   : Result := DriveRamDisk;
else
Result := DriveTypeUnknown;
end;
end;

function DriveFreeSpace(const Path: String): Int64;
var D: Byte;
begin
if PathHasDriveLetter(Path) then
D := Ord(UpCase(PChar(Path)^)) - Ord() +  else
if PathIsUNCPath(Path) then
begin
Result := -;
exit;
end else
D := ;
Result := DiskFree(D);
end;

procedure SelfTest;
begin
Assert(PathHasDriveLetter(), );
Assert(PathHasDriveLetter(), );
Assert(not PathHasDriveLetter(), );
Assert(not PathHasDriveLetter(), );

Assert(PathIsAbsolute(), );
Assert(PathIsAbsolute(), );
Assert(PathIsAbsolute(), );
Assert(PathIsAbsolute(), );
Assert(PathIsAbsolute(), );
Assert(PathIsAbsolute(), );
Assert(not PathIsAbsolute(), );
Assert(not PathIsAbsolute(), );
Assert(not PathIsAbsolute(), );
Assert(not PathIsAbsolute(), );
Assert(not PathIsAbsolute(), );
Assert(not PathIsAbsolute(), );

Assert(PathIsDirectory(), );
Assert(PathIsDirectory(), );
Assert(PathIsDirectory(), );
Assert(PathIsDirectory(), );
Assert(PathIsDirectory(), );
Assert(not PathIsDirectory(), );
Assert(not PathIsDirectory(), );
Assert(not PathIsDirectory(), );

Assert(PathInclSuffix(, ) = , );
Assert(PathInclSuffix(, ) = , );
Assert(PathInclSuffix(, ) = , );
Assert(PathInclSuffix(, ) = , );
Assert(PathInclSuffix(, ) = , );
Assert(PathInclSuffix(, ) = , );
Assert(PathInclSuffix(, ) = , );

Assert(PathExclSuffix(, ) = , );
Assert(PathExclSuffix(, ) = , );
Assert(PathExclSuffix(, ) = , );
Assert(PathExclSuffix(, ) = , );
Assert(PathExclSuffix(, ) = , );
Assert(PathExclSuffix(, ) = , );
Assert(PathExclSuffix(, ) = , );

Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );
Assert(PathCanonical(, ) = , );

Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );
Assert(PathExpand(, , ) = , );

Assert(FilePath(, , , ) = , );
Assert(FilePath(, , , ) = , );
Assert(FilePath(, , , ) = , );
Assert(FilePath(, , , ) = , );
Assert(FilePath(, , , ) = , );
Assert(FilePath(, , , ) = , );

Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );
Assert(DirectoryExpand(, , ) = , );

Assert(UnixPathToWinPath() = , );
Assert(WinPathToUnixPath() = , );
end;

end.