Sordie.co.uk

libsassy/libSassy.FileSystem.pas

Raw

{(
 )) libSassy.FileSystem
((    File system functions
 ))
((  Copyright  Sordie Aranka Solomon-Smith 2015
 ))
((  This work is made available under the terms of the Creative Commons
 )) Attribution-NonCommercial-ShareAlike 3.0 Unported license
((  http://creativecommons.org/licenses/by-nc-sa/3.0/
 )}

unit libSassy.FileSystem;

interface

uses
  Winapi.Windows,

  libSassy.Strings,
  libSassy.Streams;

{$REGION 'FileStream'}
type
  TFileMode = (fmRead, fmReadWrite, fmCreate, fmClosed);

function FileStream(const FileName: String; const FileMode: TFileMode = fmRead; const FreeAfterOp: Boolean = True): THandleStream;

type
  TStreamFileHelper = class helper for TStream
  public
    function SaveToFile  (const FileName: String; const PreservePosition: Boolean = True): Boolean;
    function LoadFromFile(const FileName: String; const PreservePosition: Boolean = True): Boolean;
  end;
{$ENDREGION}

{$REGION 'Path functions'}
const
  // Path and device separator
  PathSeparator      = '\';
  DeviceSeparator    = ':';
  ExtensionSeparator = '.';

function ExcludePathTrail(const Path: String): String;
function IncludePathTrail(const Path: String): String;

function GetFilePath        (const FileName: String): String;
function GetFileName        (const FileName: String; const NoExtension: Boolean = False): String;
function GetFileExtension   (const FileName: String): String;
function ChangeFileExtension(const FileName, NewExtension: String): String;

function AppFile(const Extension: String): String; inline;
{$ENDREGION}

{$REGION 'FileSystem functions'}
function CreateDir (const Path: String): Boolean; inline;
function RemoveDir (const Path: String): Boolean; inline;
function CreatePath(const Path: String): Boolean;

function GetFileSize(const Path: String): Int64;

const
  faReadOnly  = 1;
  faHidden    = 2;
  faSysFile   = 4;
  faVolumeID  = 8;
  faDirectory = 16;
  faArchive   = 32;
  faAnyFile   = 63;

function GetFileAttributes(const FileName: String): Integer; inline;
function SetFileAttributes(const FileName: String; const Attributes: Integer): Boolean; inline;

function CopyFile  (const Source, Dest:     String): Boolean; inline;
function RenameFile(const OldName, NewName: String): Boolean; inline;
function DeleteFile(const FileName:         String): Boolean; inline;

function NewerFile(const File1, File2: String; const SameIsNewer: Boolean = False): Boolean;

function TouchFile(FileName: String; Created: Boolean = False; Accessed: Boolean = True; Modified: Boolean = True; TimeHigh: Cardinal = 0; TimeLow: Cardinal = 0): Boolean;

function FileSystemExists(const Path: String; const AnyFile: Boolean = True; const Attributes: Integer = faAnyFile): Boolean;
function PathExists      (const Path: String): Boolean; inline;
function FileExists      (const Path: String): Boolean; inline;
{$ENDREGION}

{$REGION 'TFileSystemEnum'}
type
  // File system enumeration
  TFileSystemEnum = class
  private
    function FindNextAttrMatch: Boolean;
  public
    Data:    TWin32FindData;
    Handle:  Cardinal;
    Attrs:   Cardinal;
    Done:    Boolean;
    AnyFile: Boolean;

    constructor Create(const APath: String; const AAttr: Cardinal; const AAnyFile: Boolean = False);
    destructor  Destroy; override;

    function Next: Boolean;
  end;
{$ENDREGION}

{$REGION 'File location functions'}
function ImageName: String;
function ImagePath: String; inline;

function WorkingPath: String;
function WindowsPath: String;
function SystemPath:  String;
function SystemRoot:  String; inline;

function ExpandPath(const Path: String): String;
{$ENDREGION}

implementation

{$REGION 'FileStream'}
function FileStream;
var
  am: LongWord;
  sm: LongWord;
  cm: LongWord;
  fh: THandle;
begin
  case FileMode of
    fmReadWrite:
    begin
      am := GENERIC_READ or GENERIC_WRITE;
      sm := FILE_SHARE_READ;
      cm := OPEN_ALWAYS;
    end;

    fmCreate:
    begin
      am := GENERIC_READ or GENERIC_WRITE;
      sm := FILE_SHARE_READ;
      cm := CREATE_ALWAYS;
    end;
  else
    am := GENERIC_READ;
    sm := FILE_SHARE_READ or FILE_SHARE_WRITE;
    cm := OPEN_EXISTING;
  end;

  fh := CreateFile(PWideChar(FileName), am, sm,  nil, cm, FILE_ATTRIBUTE_NORMAL, 0);
  if fh = INVALID_HANDLE_VALUE then exit(nil);

  Result := THandleStream.Create(fh);
  Result.FreeAfterOp := FreeAfterOp;

  if Result.Handle = 0 then
  begin
    Result.Free;
    Result := nil;
  end;
end;

function TStreamFileHelper.SaveToFile;
var
  FStream: THandleStream;
  SavePos: Int64;
begin
  FStream := FileStream(FileName, fmCreate, True);
  SavePos := Position;

  try
    Result := StreamTo(FStream) > 0;
  finally
    if PreservePosition then
      Position := SavePos;
  end;
end;

function TStreamFileHelper.LoadFromFile;
var
  FStream: THandleStream;
  SavePos: Int64;
begin
  FStream := FileStream(FileName, fmRead, True);

  SavePos := Position;

  try
    Result := StreamFrom(FStream) > 0;
  finally
    if PreservePosition then
      Position := SavePos;
  end;
end;
{$ENDREGION}

{$REGION 'Path functions'}
function ExcludePathTrail;
begin
  Result := Path;

  if (Result.Length > 1) and (Path[Result.Length] = PathSeparator) and (Path[Result.Length - 1] <> DeviceSeparator) then
    Result := Result.Copy(1, Result.Length - 1);
end;

function IncludePathTrail;
begin
  Result := Path;

  if Result.Empty or (Result[Result.Length] <> PathSeparator) then
    Result := Result + PathSeparator;
end;

function GetFilePath;
var
  i: Integer;
begin
  for i := FileName.Length downto 1 do
    if FileName[i] = PathSeparator then break;

  Result := FileName.Copy(1, i);
end;

function GetFileName;
var
  i: Integer;
begin
  for i := FileName.Length downto 1 do
    if FileName[i] = PathSeparator then break;

  Result := FileName.Copy(i + 1);

  if NoExtension then Result := Result.Copy(1, Result.Length - GetFileExtension(Result).Length);
end;

function GetFileExtension;
var
  i: Integer;
begin
  Result := GetFileName(FileName);

  i := Result.Pos(ExtensionSeparator);
  if i = 0 then Result := '' else Result := Result.Copy(i);
end;

function ChangeFileExtension;
var
  i: Integer;
begin
  for i := FileName.Length downto 1 do
    if FileName[i] = ExtensionSeparator then
      exit(FileName.Copy(1, i - 1) + NewExtension)

    else if FileName[i] = PathSeparator then break;

  Result := FileName + NewExtension;
end;

function AppFile;
begin
  Result := ChangeFileExtension(ParamStr(0), '.' + Extension);
end;
{$ENDREGION}

{$REGION 'FileSystem functions'}
function CreateDir;
begin
  Result := CreateDirectory(Path.Ptr, nil);
end;

function RemoveDir;
begin
  Result := RemoveDirectory(Path.Ptr);
end;

function CreatePath;
  function CreatePathNext(var Path: String): Boolean;
  begin
    Path := ExcludePathTrail(Path);

    if (Path.Length < 3) or PathExists(Path) or (GetFilePath(Path) = Path) then exit(True);

    Result := CreatePath(GetFilePath(Path)) and CreateDir(Path);
  end;
var
  BuildPath: String;
begin
  BuildPath := Path;
  Result := CreatePathNext(BuildPath);
end;

function GetFileSize;
begin
  with TFileSystemEnum.Create(Path, faArchive or faSysFile or faHidden or faReadOnly) do try
    if Done then Result := -1 else Result := (Data.nFileSizeHigh shl 32) or Data.nFileSizeLow
  finally
    Free;
  end;
end;

function GetFileAttributes;
begin
  Result := WinApi.Windows.GetFileAttributes(FileName.Ptr);
end;

function SetFileAttributes;
begin
  Result := WinApi.Windows.SetFileAttributes(FileName.Ptr, Attributes);
end;

function CopyFile;
begin
  Result := WinApi.Windows.CopyFile(Source.Ptr, Dest.Ptr, False);
end;

function RenameFile;
begin
  Result := WinApi.Windows.MoveFile(OldName.Ptr, NewName.Ptr);
end;

function DeleteFile;
begin
  SetFileAttributes(FileName, faArchive);
  Result := WinApi.Windows.DeleteFile(FileName.Ptr);
end;

function NewerFile;
  function GetWriteTime(FileName: String; var FileTime: TFileTime): Boolean;
  var
    Handle: THandle;
  begin
    Handle := CreateFile(FileName.Ptr, 0, FILE_SHARE_READ {or FILE_SHARE_WRITE{}, nil, OPEN_EXISTING, 0, 0);

    if Handle = INVALID_HANDLE_VALUE then exit(False);

    try
      Result := GetFileTime(Handle, nil, nil, @FileTime);
    finally
      CloseHandle(Handle);
    end;
  end;
var
  Time1: TFileTime;
  Time2: TFileTime;
  Comp:  Integer;
begin
  GetWriteTime(File1, Time1);
  GetWriteTime(File2, Time2);

  Comp := CompareFileTime(Time1, Time2);

       if Comp < 0 then Result := False
  else if Comp > 0 then Result := True
  else                  Result := SameIsNewer;
end;

function TouchFile;
var
  Time:      TFileTime;
  PCreated:  PFileTime;
  PAccessed: PFileTime;
  PModified: PFileTime;
  Handle:    THandle;
begin
  if not FileSystemExists(FileName) then exit(False);

  Time.dwHighDateTime := TimeHigh;
  Time.dwLowDateTime  := TimeLow;

  if Created  then PCreated  := @Time else PCreated  := nil;
  if Accessed then PAccessed := @Time else PAccessed := nil;
  if Modified then PModified := @Time else PModified := nil;

  Handle := CreateFile(FileName.Ptr, GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if Handle = 0 then exit(False);

  try
    Result := SetFileTime(Handle, PCreated, PAccessed, PModified);
  finally
    CloseHandle(Handle);
  end;
end;

function FileSystemExists;
begin
  with TFileSystemEnum.Create(Path, Attributes, AnyFile) do try
    Result := not Done;
  finally
    Free;
  end;
end;

function PathExists;
begin
  Result := FileSystemExists(Path, False, faDirectory or faArchive or faSysFile or faHidden or faReadOnly);
end;

function FileExists;
begin
  Result := FileSystemExists(Path, False, faArchive or faSysFile or faHidden or faReadOnly);
end;
{$ENDREGION}

{$REGION 'TFileSystemEnum'}
function TFileSystemEnum.FindNextAttrMatch;
begin
  while (Data.dwFileAttributes and Attrs <> 0) do
    if not FindNextFileW(Handle, Data) then exit(False);

  Result := True;
end;

constructor TFileSystemEnum.Create;
begin
  inherited Create;

  Attrs := not AAttr and (faHidden or faSysFile or faVolumeID or faDirectory);
  AnyFile := AAnyFile;

  Handle := FindFirstFile(APath.Ptr, Data);

  if Handle = INVALID_HANDLE_VALUE then
    Done := True
  else if AnyFile then
    Done := False
  else
    Done := not FindNextAttrMatch;
end;

destructor TFileSystemEnum.Destroy;
begin
  if Handle <> INVALID_HANDLE_VALUE then FindClose(Handle);

  inherited;
end;

function TFileSystemEnum.Next;
begin
  if FindNextFile(Handle, Data) then
  begin
    if AnyFile then
      Result := True
    else
      Result := FindNextAttrMatch;
  end

  else Result := False;

  Done := not Result;
end;
{$ENDREGION}

{$REGION 'File location functions'}
function ImageName;
begin
  Result.Length := MAX_PATH;
  Result.Length := GetModuleFileName(HInstance, Result.Ptr, Result.Length);
end;

function ImagePath;
begin
  Result := GetFilePath(ImageName);
end;

function WorkingPath;
begin
  Result.Length := MAX_PATH;
  Result.Length := GetCurrentDirectory(Result.Length, Result.Ptr);
  Result := IncludePathTrail(Result);
end;

function WindowsPath;
begin
  Result.Length := MAX_PATH;
  Result.Length := GetWindowsDirectory(Result.Ptr, Result.Length);
  Result := IncludePathTrail(Result);
end;

function SystemPath;
begin
  Result.Length := MAX_PATH;
  Result.Length := GetSystemDirectory(Result.Ptr, Result.Length);
  Result := IncludePathTrail(Result);
end;

function SystemRoot;
begin
  Result := SystemPath.Copy(1, 3);
end;

function ExpandPath;
var
  i, j:      Integer;
  LastDelim: Boolean;
  c:         Char;
  TempName:  String;
  UNC:       Boolean;
begin
  Result := ''; if Path.Empty then exit;

  if Path[1] = '.' then TempName := WorkingPath + PathSeparator + Path else TempName := Path;

  // TempName := PathMacros.Expand(TempName);

  UNC := TempName.Copy(1, 2) = PathSeparator + PathSeparator;
  if UNC then TempName := TempName.Copy(2);

  i := 1; j := 1;
  LastDelim := False;

  while i <= TempName.Length do
  begin
    c := TempName[i];

    if c = PathSeparator then
    begin
      if j < i then
      begin
        if (i = 1) or (TempName[i - 1] <> PathSeparator) then Result := Result + TempName.Copy(j, i - j);

        j := i;

        LastDelim := True;
      end;
    end

    else if c = '.' then
    begin
      if LastDelim then
      begin
        if i < TempName.Length then
        begin
          if (TempName[i + 1] = '.') and ((i + 1 >= TempName.Length) or (TempName[i + 2] <> '.')) then
          begin
            if Result.Length > 1 then Result := GetFilePath(ExcludePathTrail(Result));
            j := i;
          end

          else if TempName[i + 1] = PathSeparator then
          begin
            Result := IncludePathTrail(Result);
            inc(i);
            j := i + 1;
          end
          else
            LastDelim := False;
        end
        else
        begin
          Result := ExcludePathTrail(Result);
          j := i + 1;
        end;
      end;
    end

    else LastDelim := False;

    inc(i);
  end;

  if (i - j > 1) or (TempName[i] <> PathSeparator) then
    Result := Result + TempName.Copy(j, i - j);

  if UNC then Result := PathSeparator + Result;
end;
{$ENDREGION}

end.