Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/unity/d56/FNDUTL.ZIP/System/cFileUtils.pas

Pascal/Delphi Source File | 2002-10-29 | 12.1 KB | 341 lines

{$INCLUDE ..\cDefines.inc}
unit cFileUtils;

{                                                                              }
{                        File utility functions v3.01                          }
{                                                                              }
{         This unit is copyright ⌐ 2002 by David Butler ([e-mail])        }
{                                                                              }
{                  This unit is part of Delphi Fundamentals.                   }
{                  Its original file name is cFileUtils.pas                    }
{       The latest version is available from the Fundamentals home page        }
{                     http://fundementals.sourceforge.net/                     }
{                                                                              }
{                I invite you to use this unit, free of charge.                }
{        I invite you to distibute this unit, but it must be for free.         }
{             I also invite you to contribute to its development,              }
{             but do not distribute a modified copy of this file.              }
{                                                                              }
{          A forum is available on SourceForge for general discussion          }
{             http://sourceforge.net/forum/forum.php?forum_id=2117             }
{                                                                              }
{ Revision history:                                                            }
{   01/06/2002  3.01  Created cFileUtils from cSysUtils.                       }
{                                                                              }
interface

uses
  // Delphi
  SysUtils;



{                                                                              }
{ Path functions                                                               }
{                                                                              }
const
  {$IFDEF OS_UNIX}
  PathSeparator = '/';
  {$ENDIF}
  {$IFDEF OS_MSWIN}
  PathSeparator = '\';
  {$ENDIF}

Function  UnixPathToWindowsPath (const Path : String) : String;
Function  WindowsPathToUnixPath (const Path : String) : String;
Function  StringToValidFileName (const S : String) : String;

Function  PathWithSlashSuffix (const Path : String; const PathSep : Char = PathSeparator) : String;
Function  PathWithoutSlashSuffix (const Path : String; const PathSep : Char = PathSeparator) : String;
Function  PathLeftElement (const Path : String; const PathSep : Char = PathSeparator) : String;
Function  PathRightElement (const Path : String; const PathSep : Char = PathSeparator) : String;
Function  PathWithoutLeftElement (const Path : String; const PathSep : Char = PathSeparator) : String;
Function  PathWithoutRightElement (const Path : String; const PathSep : Char = PathSeparator) : String;
Procedure PathSplitLeftElement (const Path : String; const PathSep : Char;
          var LeftElement, RightElement : String);
Procedure PathSplitRightElement (const Path : String; const PathSep : Char;
          var LeftElement, RightElement : String);

Function  MergeFilePath (const Path : String; const FileName : String;
          const PathSep : Char = PathSeparator) : String;
Function  IsAbsolutePath (const Path : String) : Boolean;
Function  ExpandPath (const Path, DefaultPath : String) : String;



{                                                                              }
{ File operations                                                              }
{   MoveFile will first attempt a rename, then a copy&delete.                  }
{                                                                              }
type
  EFileError = class (Exception);

Function  GetFileSize (const FileName : String) : Int64;
Function  GetFileDateTime (const FileName : String) : TDateTime;
Function  GetFirstFileNameMatching (const FileMask : String) : String;
Function  FileHasAttr (const FileName : String; const Attr : Word) : Boolean;
Procedure CopyFile (const FileName, DestName : String);
Procedure MoveFile (const FileName, DestName : String);
Function  DeleteFiles (const FileMask : String) : Boolean;



implementation

uses
  // Fundamentals
  cStrings;



{                                                                              }
{ Path functions                                                               }
{                                                                              }
Function UnixPathToWindowsPath (const Path : String) : String;
  Begin
    Result := Replace ('/', '\', Replace (['\', ':', '"', '<', '>', '|'], '_', Path));
  End;

{ Network path:  \\      --->   /                                              }
{ Device path:   \\.\    --->   /                                              }
{ Drive letter:  X:      --->   X/                                             }
Function WindowsPathToUnixPath (const Path : String) : String;
  Begin
    Result := Path;
    if Length (Result) >= 2 then
      if Result [2] = ':' then // drive letter
        Result [2] := '/' else
      if (Result [1] = '\') and (Result [2] = '\') then
        if (Length (Result) >= 3) and (Result [3] = '.') then
          Delete (Result, 1, 3) else    // device path
          Delete (Result, 1, 1);        // network path
    Result := Replace ('\', '/', Replace (['/', ':', '"', '<', '>', '|'], '_', Path));
  End;

Function StringToValidFileName (const S : String) : String;
  Begin
    Result := Replace (['\', '/', ':', '>', '<', '*', '?'], '_', S);
  End;

Function PathWithSlashSuffix (const Path : String; const PathSep : Char) : String;
  Begin
    Result := Path;
    if Result = '' then
      exit;
    EnsureSuffix (Result, PathSep);
  End;

Function PathWithoutSlashSuffix (const Path : String; const PathSep : Char) : String;
  Begin
    Result := Path;
    EnsureNoSuffix (Result, PathSep);
  End;

Function PathLeftElement (const Path : String; const PathSep : Char) : String;
  Begin
    Result := CopyBefore (Path, PathSep, True);
  End;

Function PathRightElement (const Path : String; const PathSep : Char) : String;
  Begin
    Result := CopyFrom (Path, Pos (PathSep, Path, [foReverse]) + 1);
  End;

Function PathWithoutLeftElement (const Path : String; const PathSep : Char) : String;
  Begin
    Result := CopyAfter (Path, PathSep, False);
  End;

Function PathWithoutRightElement (const Path : String; const PathSep : Char) : String;
  Begin
    Result := CopyBefore (Path, PathSep, False, [foReverse]);
  End;

Procedure PathSplitLeftElement (const Path : String; const PathSep : Char; var LeftElement, RightElement : String);
  Begin
    Split (Path, PathSep, LeftElement, RightElement, True, splitCenter, []);
  End;

Procedure PathSplitRightElement (const Path : String; const PathSep : Char; var LeftElement, RightElement : String);
  Begin
    Split (Path, PathSep, LeftElement, RightElement, False, splitCenter, [foReverse]);
    if (LeftElement = '') and (RightElement = '') then
      RightElement := Path;
  End;

Function MergeFilePath (const Path : String; const FileName : String; const PathSep : Char) : String;
  Begin
    if Path = '' then
      Result := FileName else
      begin
        Result := Path;
        EnsureSuffix (Result, PathSep);
        Result := Result + FileName;
      end;
  End;

Function ExpandPath (const Path, DefaultPath : String) : String;
  Begin
    if Path = '' then
      Result := DefaultPath else
      Result := PathWithSlashSuffix (Path);
    if Result <> '' then
      Result := ExpandFileName (Result);
  End;

Function IsAbsolutePath (const Path : String) : Boolean;
var L : Integer;
  Begin
    L := Length (Path);
    if L = 0 then
      Result := False else
      if Path [1] = '\' then
        Result := True else
        if L = 1 then
          Result := False else
          if Path [2] = ':' then
            Result := True else // c:xxx considered absolute
            Result := False;
  End;



{                                                                              }
{ File operations                                                              }
{                                                                              }
Function GetFileSize (const FileName : String) : Int64;
var SRec : TSearchRec;
  Begin
    if FindFirst (FileName, faAnyFile, SRec) <> 0 then
      Result := -1 else
      begin
        {$IFDEF MSWINDOWS}
        {$WARNINGS OFF}
        Int64Rec (Result).Lo := SRec.FindData.nFileSizeLow;
        Int64Rec (Result).Hi := SRec.FindData.nFileSizeHigh;
        {$IFDEF DEBUG}{$WARNINGS ON}{$ENDIF}
        {$ELSE}
        Result := SRec.Size;
        {$ENDIF}
        FindClose (SRec);
      end;
  End;

Function GetFileDateTime (const FileName : String) : TDateTime;
var Age : LongInt;
  Begin
    Age := FileAge (FileName);
    if Age = -1 then
      Result := 0 else
      Result := FileDateToDateTime (Age);
  End;

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

{$WARN SYMBOL_PLATFORM OFF}
Function FileHasAttr (const FileName : String; const Attr : Word) : Boolean;
var A : Integer;
  Begin
    A := FileGetAttr (FileName);
    Result := (A >= 0) and (A and Attr <> 0);
  End;

Procedure CopyFile (const FileName, DestName : String);
var
  CopyBuffer   : Pointer;
  BytesCopied  : Longint;
  Source, Dest : Integer;
  Destination  : TFileName;
const
  ChunkSize = 8192;

  Begin
    Destination := ExpandFileName (DestName);
    if FileHasAttr (Destination, faDirectory) then // if destination is a directory, append file name
      Destination := Destination + '\' + ExtractFileName (FileName);
    GetMem (CopyBuffer, ChunkSize);
    try
      Source := FileOpen (FileName, fmShareDenyWrite);
      if Source < 0 then
        raise EFileError.CreateFmt ('Can not open file %s', [FileName]);
      try
        Dest := FileCreate (Destination);
        if Dest < 0 then
          raise EFileError.CreateFmt('Can not create file %s', [Destination]);
        try
          Repeat
            BytesCopied := FileRead (Source, CopyBuffer^, ChunkSize);
            if BytesCopied > 0 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 < 0) or (Attr and faReadOnly <> 0) then
          raise EFileError.Create (Format ('Can not move file %s', [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) = 0;
    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) = 0) then
        begin
          Result := DeleteFile (Path + SRec.Name);
          if not Result then
            break;
        end;
      Until FindNext (SRec) <> 0;
    finally
      FindClose (SRec);
    end;
  End;
{$WARN SYMBOL_PLATFORM ON}



end.