root/trunk/ExtraFileUtilsLCL.pas

///////////////////////////////////////////////////////////
//                   ExtraFileUtilsLCL                   //
//    Модуль с самопальными функциями и прочим общего    //
//              для работы с файлами под LCL.            //
//             Copyright (C) 2007 Gipat Group            //
//              Распространяется на условиях             //
//                      LGPL v2.1                        //
//                                                       //
//                  www.gipatgroup.org                   //
///////////////////////////////////////////////////////////

//К работе над данным файлом приложили руки, ноги.... короче аффтары:
// 1) Immortal (immortalGAD@rambler.ru)
// 2) Sagrer (sagrer@yandex.ru)

////////////////////////////////////////////////////////////////////////

unit ExtraFileUtilsLCL;

{$mode objfpc}{$H+}

interface

uses
  windows ,Classes, SysUtils, FileUtil, ExtraFunctionsLcl, syncobjs;

const
// Размер буффера, который будет использоватсья для копирования файлов
  FILECOPY_BUFFER_SIZE = 81920;
// Нереальное значение аттрибута
  INVALID_SYSFILE_ATTR :LongInt = -1;
  
// возрвращаемые значения
  resOk = 0;
  resParametersError = 1;
/////////////////////////
  
type
// таки пока только для внутреннего пользования.
  IOException = class(Exception) end;
  TFileSystemIterator = class;
  
////////////////////////////////////////////////////////////////////////////////
// Прототип процедуры, для информирования о ходе копирования
  TCopyFileProgressCallback = procedure(const current, total :Int64) of object;
// Прототип процедуры, для информирования о завершении
  TCopyFileFinishCallback   = procedure(const resultt :Boolean) of object;

// класс для асинхронного копирования файла.
  TCopyFileThread = class (TThread)
    private
      curLock, totalLock :TCriticalSection;
      _current, _total :Int64;
    protected
      procedure Execute; override;
      function  GetTotal   :Int64;
      procedure SetTotal  (const value :Int64);
      function  GetCurrent :Int64;
      procedure SetCurrent(const value :Int64);
    public
      // результат операции
      CopyResult :Boolean;
      constructor Create(const source, dest :AnsiString; const overwriteExists , startSuspended :Boolean);
      destructor Destroy; override;
      CopyFileProgress :TCopyFileProgressCallback;
      CopyFileFinish   :TCopyFileFinishCallback;
      SourceFilePath   :AnsiString;
      DestFilePath     :AnsiString;
      OverwriteExists  :Boolean;  // переписывать файл , если уже существует
      property Total   :Int64 read GetTotal;
      property Current :Int64 read GetCurrent;
  end;

////////////////////////////////////////////////////////////////////////////////
//  базовый класс, для представления файла или папки
  TFileSystemElemInfo = class
    protected
      SearchRec :TSearchRec;
    public
      // абсолютный путь к файлу или папке
      FullPath :AnsiString;
      constructor Create(const filePath :AnsiString); virtual;
      constructor Create(const filePath: AnsiString; const searchInfo :TSearchRec); virtual;
      function  Name :AnsiString; virtual;
      function  Attributes :Longint; virtual;
      function  Exists :Boolean; virtual; abstract;
      function  CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean; virtual; abstract;
      function  Delete :Boolean; virtual ;abstract;
  end;

////////////////////////////////////////////////////////////////////////////////
//  класс для работы с файлами
  TFileInfo = class (TFileSystemElemInfo)
    public
      function CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean; override;
      function Delete :Boolean; override;
      function Exists :Boolean; override;
  end;
  
////////////////////////////////////////////////////////////////////////////////
//  класс для работы с директорией
  TDirectoryInfo = class (TFileSystemElemInfo)
    public
      function CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean; override;
      function Delete :Boolean; override;
      function Exists :Boolean; override;
      function GetFiles :TFileSystemIterator;
      function GetFiles(const mask :AnsiString) :TFileSystemIterator;
      function GetDirectories :TFileSystemIterator;
      function GetDirectories(const mask :AnsiString) :TFileSystemIterator;
  end;
  
////////////////////////////////////////////////////////////////////////////////
// класс для перебора файлов и поддирекорий в директории
  TFileSystemIterator = class
    protected
      searchInfo :TSearchRec;
      folder     :AnsiString;
    public
      Current    :TFileSystemElemInfo;  // текущий файл\папка
      SearchAttr :Longint;
      constructor Create(const folderPath :AnsiString; const onlyFiles :Boolean = false);
      constructor Create(const folderPath :AnsiString; const attrPredicat :Longint);
      constructor Create(const folderPath, searchMask :AnsiString; const onlyFiles :Boolean = false);
      constructor Create(const folderPath, searchMask :AnsiString; const attrPredicat :Longint); //
      destructor  Destroy; override;
      function Next :Boolean;
  end;

// Класс для работы с временными папками. Чистит temp по завершению работы.
  TTempFolder = class
    protected
      path :AnsiString;
      name :AnsiString;
    public
      constructor Create(const subName :AnsiString);
      destructor  Destroy; override;
      function GetTempPath :AnsiString;   //получить путь к временной директории
  end;
  
////////////////////////////////////////////////////////////////////////////////
//  Процедуры и функции
////////////////////////////////////////////////////////////////////////////////

// копирует дирректорию
function CopyDirectory(const sourceDir, destDir :AnsiString; const overwriteExists :Boolean = false;
                        const recursive :Boolean = true) :Boolean;


//AsyncCopyFile - копирует файл в отдельном потоке
function AsyncCopyFile(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
                        const overwriteExists :Boolean = false) :TThread;
function AsyncCopyFile(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
                        const onProgress :TCopyFileProgressCallback; const overwriteExists :Boolean = false) :TThread;

// SysFileExists - проверяет существует ли по указанному пути файл или папка
function FileSystemElemExists(const path :AnsiString) :Boolean;

// IsDirectory - проверяет по пути или атрибутам является или "это" папкой
function IsDirectory(const path :AnsiString) :Boolean;
function IsDirectory(const attr :Longint) :Boolean;

Function IsLocalPath(const PathStr : AnsiString) : boolean;     //Возвращает true если путь локальный, и false если глобальный. Под локальным понимается путь начинающийся с точки.
Function IsGlobalPath(const PathStr : AnsiString) : boolean;   //Возвращает true если путь глобальный. Под глобальным понимается путь, начинающийся на имя диска (функция для вендов).
Function FixLocalPath(const PathStr : AnsiString) : AnsiString;   //Правильно оформляет предположительно локальный но неправильно оформленный путь - чтоб была точка в начале.
Function ResolveLocalPath(const LocalPath, GlobalPath : AnsiString) : AnsiString;  //Превратить относительный путь в абсолютный
Function GetLocalPath(const GlobalRoot, FullPath : AnsiString): AnsiString;    //Вернуть относительный путь.
Function GetFileSize(const FileName : AnsiString) : Int64;   //Получить размер файла.
function GetFilesNumber(const DirName : AnsiString; const Recursive : boolean) : LongInt;//Подсчитать количество файлов и папок в папке...
Function IsDirsChild(const DirName, ChildName : AnsiString) : boolean;   //Проверить - принадлежит ли путь ChildName пути DirName.
function AddExtensionIfAbsent(const path, extension :String) :String; // добаляет расширение если его еще нет.
function GetFileNameWithoutExtension(const path :String) :String;  // чистое имя файла, без расширения
Function HasLastSlash(const Str : string) : boolean;    //Функа для проверки наличия последнего слэша.
Function AddLastSlash(const str : string) : string;     //Функа для добавления в путь последнего слэша (если надо).
Function DelLastSlash(const Str : string) : string;     //Удаляет последний слеш если он есть.


implementation


//////////////////////////  TFileSystemIterator     ///////////////////////////////
constructor TFileSystemIterator.Create(const folderPath :AnsiString; const onlyFiles :Boolean = false);
begin
  Create(folderPath, AllDirectoryEntriesMask, onlyFiles);
end;

constructor TFileSystemIterator.Create(const folderPath :AnsiString; const attrPredicat :Longint);
begin
  Create(folderPath, AllDirectoryEntriesMask, attrPredicat);
end;

constructor TFileSystemIterator.Create(const folderPath, searchMask :AnsiString; const onlyFiles :Boolean = false);
var
  temp :Longint;
begin
  temp := faAnyFile;
  if onlyFiles then begin
    temp := temp and not faDirectory;
  end;
  Create(folderPath, searchMask, temp);
end;

constructor TFileSystemIterator.Create(const folderPath, searchMask :AnsiString; const attrPredicat :Longint);
begin
  inherited Create;
  Self.SearchAttr := attrPredicat;
  Self.folder := folderPath;
  FindFirst(AppendPathDelim(folderPath) + searchMask, faAnyFile, searchInfo);
end;

destructor TFileSystemIterator.Destroy;
begin
  inherited;
  FindClose(searchInfo);
end;

function TFileSystemIterator.Next :Boolean;
begin
  Result := (FindNext(searchInfo) = 0);
  if not Result then exit;
  
  if (searchInfo.Name = '.') or (searchInfo.Name = '..') then begin
    Result := Self.Next;
    exit;
  end;
  
  if (searchInfo.Attr and SearchAttr) = 0 then begin
    Result := Self.Next;
    exit;
  end;

  if IsDirectory(searchInfo.Attr) then
    Current := TDirectoryInfo.Create(folder, searchInfo)
  else
    Current := TFileInfo.Create(folder, searchInfo);

end;

///////////////////              TCopyFileThread             ///////////////////

//  конструктор
constructor TCopyFileThread.Create(const source, dest :AnsiString; const overwriteExists, startSuspended :Boolean);
begin
  inherited Create(startSuspended);
  SourceFilePath := source;
  DestFilePath   := dest;
  self.OverwriteExists := overwriteExists;
  self._current := 0;
  Self._total := -1;
  totalLock := TCriticalSection.Create;
  curLock   := TCriticalSection.Create;
end;

destructor TCopyFileThread.Destroy;
begin
  inherited;
  totalLock.Free;
  curLock.Free;
end;

//  процедура , копирует файл.
procedure TCopyFileThread.Execute;
var
  sourceStream :TFileStream;
  destStream   :TFileStream;
  curr, max    :Int64;
  stepReaded   :Integer;
  part, temp   :Int64;
  buffer       :array[0 .. FILECOPY_BUFFER_SIZE - 1] of byte;
begin
  CopyResult := false;
  
  if not FileExists(SourceFilePath) then begin
    if assigned (CopyFileFinish) then CopyFileFinish(false);
    exit;
  end;
  
  // Проверяем сущестует ли файл который мы собираемся создать. Если да - то если разрешенно пробуем удалить,
  // в случае неудачи выходим.
  if FileExists(DestFilePath) then begin
    if (not OverwriteExists) or (not DeleteFile(DestFilePath)) then begin
      if assigned (CopyFileFinish) then CopyFileFinish(false);
      exit;
    end;
  end;
  
  // открываем потоки
  sourceStream := TFileStream.Create(SourceFilePath, fmOpenRead);
  destStream   := TFileStream.Create(DestFilePath, fmCreate);
  
  curr := 0;
  max := sourceStream.Size;
  SetTotal(max);
  part := total div 100;
  temp := 0;

  try
    while (curr < max) do begin
      stepReaded := sourceStream.Read(buffer, FILECOPY_BUFFER_SIZE);
      destStream.Write(buffer, stepReaded);
      curr := curr + stepReaded;
      SetCurrent(curr);
      // будем сообщать о прогрессе по окончанию копирования каждой 100-й части,
      // чтобы не перегружать поток вызовами.
      if assigned(CopyFileProgress) then begin
        temp := temp + stepReaded;
        if temp >= part then begin
          temp := temp mod part;
          CopyFileProgress(curr, max);
        end;
      end;
    end;
  finally
    sourceStream.Free;
    destStream.Free;
  end;
  
  CopyResult := true;
  if assigned (CopyFileFinish) then CopyFileFinish(CopyResult);

end;


function TCopyFileThread.GetTotal :Int64;
begin
  totalLock.Acquire;
  try
    Result := _total;
  finally
    totalLock.Release;
  end;
end;

procedure TCopyFileThread.SetTotal(const value :Int64);
begin
  totalLock.Acquire;
  try
    _total := value;
  finally
    totalLock.Release;
  end;
end;

function TCopyFileThread.GetCurrent :Int64;
begin
  curLock.Acquire;
  try
    Result := _current;
  finally
    curLock.Release;
  end;
end;

procedure TCopyFileThread.SetCurrent(const value :Int64);
begin
  curLock.Acquire;
  try
    _current := value;
  finally
    curLock.Release;
  end;
end;

///////////////////////  TFileSystemIterator  & co    /////////////////////////////

// конструктор
constructor TFileSystemElemInfo.Create(const filePath :AnsiString);
begin
  inherited Create;
  Self.FullPath := filePath;
end;

// конструктор
constructor TFileSystemElemInfo.Create(const filePath: AnsiString; const searchInfo :TSearchRec);
begin
  Create(AppendPathDelim(filePath) + searchInfo.Name);
  Self.SearchRec := searchInfo;
end;

// взять аттрибут
function TFileSystemElemInfo.Attributes :Longint;
begin
  // если определена структура SearchRec
  if (SearchRec.FindHandle = 0) then
    Result := INVALID_SYSFILE_ATTR
  else
    Result := SearchRec.Attr;
end;

// извлечь имя из пути
function TFileSystemElemInfo.Name :AnsiString;
begin
  Result := SearchRec.Name;
  if (Result = '') then
    Result := ExtractFileName(FullPath);
end;

// копает
function TFileInfo.CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean;
begin
  if FileExists(path) then begin
    if overwriteExists then begin
      if not DeleteFile(path) then begin
        Result := false;
        exit;
      end;
    end else begin
      Result := true;
      exit;
    end;
  end;
  Result := CopyFile(FullPath, path);
end;

// удаляет
function TFileInfo.Delete :Boolean;
begin
  Result := false;
  if FileExists(FullPath) then
    Result := DeleteFile(FullPath);
end;

// а есть ли у нас такой файл?
function TFileInfo.Exists :Boolean;
begin
  Result := FileExists(FullPath);
end;

// тоже копирует.
function TDirectoryInfo.CopyTo(const path :AnsiString; const overwriteExists :Boolean = false) :Boolean;
begin
  Result := CopyDirectory(FullPath, path, overwriteExists, true);
end;

// удаляет нафиг.
function TDirectoryInfo.Delete :Boolean;
begin
  Result := DeleteDirectory(FullPath, false);
end;

// есть ли папка
function TDirectoryInfo.Exists :Boolean;
begin
  Result := DirectoryExists(FullPath);
end;

// получить итератор на файлы внутри папки
function TDirectoryInfo.GetFiles: TFileSystemIterator;
begin
  Result := GetFiles('*');
end;

// получить итереатор на все чайлд-папки
function TDirectoryInfo.GetFiles(const mask :AnsiString) :TFileSystemIterator;
begin
  Result := TFileSystemIterator.Create(FullPath, mask, true);
end;

function TDirectoryInfo.GetDirectories :TFileSystemIterator;
begin
  Result := GetDirectories('*');
end;

function TDirectoryInfo.GetDirectories(const mask :AnsiString) :TFileSystemIterator;
begin
  Result := TFileSystemIterator.Create(FullPath, mask, faDirectory);
end;

//////////////////////////  TTempFolder     ///////////////////////////////
// конструктор. создает временную директорию
constructor TTempFolder.Create(const subName :AnsiString);
var
  temp :TGUID;
begin
  CreateGUID(temp);
  // собственно путь к папке
  path := AppendPathDelim(GetTempDir) + GUIDToString(temp) + PathDelim;
  ForceDirectory(path + subName);
  name := subName;
end;

// чистит за собой
destructor  TTempFolder.Destroy;
begin
  inherited;
  DeleteDirectory(path, false);
end;

//получить путь к временной директории
function TTempFolder.GetTempPath :AnsiString;
begin
  Result := AppendPathDelim(path + name);
end;

////////////////////////////////////////////////////////////////////////////////
// копирует директорию
function CopyDirectory(const sourceDir, destDir :AnsiString; const overwriteExists :Boolean = false;
                        const recursive :Boolean = true) :Boolean;
var
  it :TFileSystemIterator;
begin
  Result := false;
  if not DirectoryExists(sourceDir) then begin
    exit;
  end;
  // если destDir еще не существует, создаем
  if not DirectoryExists(destDir) then ForceDirectory(destDir);
  it := TFileSystemIterator.Create(sourceDir, not recursive);
  try
    while it.Next do begin
      if not it.Current.CopyTo(AppendPathDelim(destDir) + it.Current.Name, overwriteExists) then begin
        exit;
      end;
    end;
    Result := true;
  finally
    it.Free;
  end;
end;


// копирования файла в отдельном потоке
function AsyncCopyFile(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
                        const overwriteExists :Boolean = false) :TThread;
begin
  Result := AsyncCopyFile(sourcePath, destPath, onFinish, nil, overwriteExists);
end;

// копирует файл в отдельном поток
function AsyncCopyFile(const sourcePath, destPath :AnsiString; const onFinish :TCopyFileFinishCallback;
                       const onProgress :TCopyFileProgressCallback; const overwriteExists :Boolean = false) :TThread;
var
  worker :TCopyFileThread;
begin
  worker := TCopyFileThread.Create(sourcePath, destPath, overwriteExists ,true);
  worker.CopyFileProgress := onProgress;
  worker.CopyFileFinish   := onFinish;
  worker.FreeOnTerminate  := true;
  worker.Resume;
  Result := worker;
end;

function FileSystemElemExists(const path :AnsiString) :Boolean;
begin
  Result := (FileGetAttr(path) <> INVALID_SYSFILE_ATTR);
end;

// а директория ли по переданному пути ?
function IsDirectory(const path :AnsiString) :Boolean;
var
  attr :Longint;
begin
  attr := FileGetAttr(path);
  if attr <> INVALID_SYSFILE_ATTR then begin
    Result := IsDirectory(attr);
  end else
    Result  := false;
end;

// проверят является ли системный файл директорией по аттрибутам
function IsDirectory(const attr :Longint) :Boolean;
begin
  Result := (attr and faDirectory) = faDirectory;
end;


////////////////   импорт из ExtraFunctionsCLC  ////////////////////////////////
Function IsLocalPath(const PathStr : string) : boolean;
//Возвращает true если путь локальный, и false если глобальный.
//Под локальным понимается путь начинающийся с точки.
begin
  Result := false;   //По умолчанию считаем что путь глобален.

  if Length(PathStr) >= 1 then begin
    if PathStr[1] = '.' then begin
      Result := true;
    end;
  end;
end;

Function IsGlobalPath(const PathStr : AnsiString) : boolean;
//Возвращает true если путь глобальный. Под глобальным понимается путь,
//начинающийся на имя диска (функция для вендов).
begin
  Result := false;   //По умолчанию считаем что путь не глобален.

  if Length(PathStr) >= 3 then begin
    if PathStr[2]+PathStr[3] = ':\' then begin
      Result := true;
    end;
  end;
end;

Function FixLocalPath(const PathStr : AnsiString) : AnsiString;
//Правильно оформляет предположительно локальный но неправильно оформленный
//путь - чтоб была точка в начале.
begin
  Result := PathStr;

  if IsLocalPath(Result) = false then begin
    if Length(Result) >= 1 then begin
      if Result[1] <> '\' then begin
        Result := '\'+Result;
      end;
    end
    else begin
      Result := '\'+Result;
    end;
    Result := '.'+Result;
  end;
end;

Function ResolveLocalPath(const LocalPath, GlobalPath : AnsiString) : AnsiString;
//Превратить относительный путь в абсолютный. Если относительный путь задан неправильно - предварительно
//будет пофиксан. Если относительный путь на самом деле абсолютный - вернет абсолютный путь
//который якобы относительный.
var
  TempLocalPath, LocalParsed : AnsiString;
begin
  //Принцип действия: в относительном пути могут быть точки и "двоеточия".
  //Копируем в результат абсолютный путь, убираем последний слеш,
  //и дальше парсим локальный путь (по слешам) - встречаем точку - ничО не делаем,
  //встречаем двоеточие - отрезаем от результата кусок до последнего слеша включительно,
  //встречаем что-то еще - добавляем в результат слеш и копируем пропарсенное туда же.
  //В итоге получаем абсолютный путь.

  //Копируем в результат абсолютный путь, убираем последний слеш.
  Result := ChompPathDelim(GlobalPath);
  TempLocalPath := LocalPath;     //Это чтоб не портить присланный в функцию аргумент.
  
  //Проверяем - надо ли пофиксать локальный путь? А если надо - то как раз пофиксать.
  if IsGlobalPath(TempLocalPath) = false then begin
    //Путь не глобален. Оформлен ли он как локальный?
    if IsLocalPath(TempLocalPath) = false then begin
      //Как локальный тоже не оформлен - оформляем.
      TempLocalPath := FixLocalPath(TempLocalPath);
    end;
  end;
  
  //Теперь - если локальный путь действительно локальный - то работаем.
  if IsLocalPath(TempLocalPath) = true then begin
    repeat
      //Парсим...
      LocalParsed := Parse(TempLocalPath,'\');

      //Смотря чего выпарсили...
      if (LocalParsed = '.') or (LocalParsed = '') then begin
        //Если точка либо просто слеш без всего - то ничего не делать.
      end
      else if LocalParsed = '..' then begin
        //Две точки - поднятся на уровень выше...
        ParseTail(Result,'\');
      end
      else begin
        //Если там еще какая-то фигня - то добавляем её к пути...
        Result := Result+'\'+LocalParsed;
      end;

    until TempLocalPath = '';

    //Готово. Теперь если в LocalPath в конце был слеш - добавим и к результату...
    if HasLastSlash(LocalPath) = true then begin
      Result := Result+'\';
    end;
  end
  else begin
    //Локальный путь на самом деле абсолютный - его и возвращаем.
    Result := TempLocalPath;
  end;

end;

Function GetLocalPath(const GlobalRoot, FullPath : AnsiString): AnsiString;
//Вернуть относительный путь.
var
  TmpGlobalRoot, TmpFullPath, CommonPart, TempStr : AnsiString;
  Finded : boolean;

begin
  //Если глобальный корневой путь не входит в состав полного пути.
  if StrPos(PChar(UpperCase(FullPath)),PChar(DelLastSlash(UpperCase(GlobalRoot)))) = nil then begin

    //Проверить - совпадает ли первый элемент пути до первого слеша - под вендами это будет буква диска,
    //под каким нить линухом в теории одинаковая пустая строка.
    TmpGlobalRoot := AddLastSlash(GlobalRoot);
    TmpFullPath := AddLastSlash(FullPath);
    if UpperCase(Parse(TmpGlobalRoot,'\')) = UpperCase(Parse(TmpFullPath,'\')) then begin
      //Если "диск" один и тот же - тогда формируем относительный путь с "двоеточиями".

      //Ищем общую часть пути...
      CommonPart := '';
      Finded := false;
      TmpGlobalRoot := DelLastSlash(GlobalRoot);
      TmpFullPath := DelLastSlash(FullPath);
      repeat
        TempStr := Parse(TmpGlobalRoot,'\');
        if UpperCase(TempStr) = UpperCase(Parse(TmpFullPath,'\')) then begin
          //Кусок пути совпадает.
          CommonPart := CommonPart+TempStr+'\';
        end
        else begin
          //Не совпало. Делаем отметку. Путь остается с последним слешем.
          Finded := true;
        end;
      until Finded = true;

      //Терь генерим обрезки путей чтоб были без общей части...
      TmpGlobalRoot := AddLastSlash(GlobalRoot);
      TmpFullPath := AddLastSlash(FullPath);
      TmpGlobalRoot := DelLastSlash(RightStr(TmpGlobalRoot,Length(TmpGlobalRoot)-Length(CommonPart)));
      TmpFullPath := DelLastSlash(RightStr(TmpFullPath,Length(TmpFullPath)-Length(CommonPart)));
      //Теперь можно сгенерить начало результата из двоеточий...
      Result := '';
      repeat
        //Парсим пока TmpGlobalRoot не опустеет.
        if Parse(TmpGlobalRoot,'\') <> '' then begin
          //Если еще чего-то пропарсилось - добавляем две точки...
          Result := Result+'..\';
        end;
      until TmpGlobalRoot = '';
      //Теперь добавляем обрезок полного пути.
      Result := Result+TmpFullPath;
      //Все, можно выходить.
      Exit;
    end
    else begin
      //Если "диск"-и разные - просто возвращаем полный путь
      Result := FullPath;
      Exit;
    end;

  end;

  //Если у нас один и тот же путь и там и там - то сразу возвращаем ./
  if UpperCase(DelLastSlash(GlobalRoot)) = UpperCase(DelLastSlash(FullPath)) then begin
    Result := '.\';
    Exit;
  end;

  //Взять копию входной инфы...
  TmpGlobalRoot := AddLastSlash(GlobalRoot);
  TmpFullPath := FullPath;

  TmpFullPath := RightStr(TmpFullPath,Length(TmpFullPath)-Length(TmpGlobalRoot));
  Result := '.\'+TmpFullPath;
end;

Function GetFileSize(const FileName : AnsiString) : Int64;
//Получить размер файла.
var
  TheFileStream : TFileStream;
begin
  //По умолчанию возвращаем ноль.
  Result := 0;
  //Если файл существует...
  if FileExists(FileName) = true then begin
    //... то открываем его...
    TheFileStream := TFileStream.Create(FileName,fmOpenRead);
    //... и получаем размер.
    Result := TheFileStream.Size;
    //И закрываем файлег.
    TheFileStream.Free;
  end;
end;

Function GetFilesNumber(const DirName : AnsiString; const Recursive : boolean) : LongInt;
//Подсчитать количество файлов и папок в папке...
var
  SearchRec : TSearchRec;
begin
  Result := 0;

  if FindFirst(AddLastSlash(DirName)+'*', faAnyFile and faDirectory, SearchRec) = 0 then begin
    //Если поиск начат успешно - начинаем (рекурсивно если надо) считать содержимое.
    repeat
      if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin
        //Чего-то нашли.
        Result := Result+1;
        //Writeln(SearchRec.Name);
        if Recursive = true then begin
          //Если надо действовать рекурсивно...
          if (SearchRec.Attr and faDirectory) = faDirectory then begin
            //... и если это директория - то подсчитываем эту директорию.
            Result := Result+GetFilesNumber(AddLastSlash(DirName)+SearchRec.Name, Recursive);
          end;
        end;
      end;;
    until FindNext(SearchRec) <> 0;
    SysUtils.FindClose(SearchRec);
  end;
  //Writeln(IntToStr(Result));

end;

Function IsDirsChild(const DirName, ChildName : AnsiString) : boolean;
//Проверить - принадлежит ли путь ChildName пути DirName.
var
  TempStr : AnsiString;
begin
  //Инициализация.
  Result := false;     //Изначально путь не считается child-ом

  //Получение "локального пути".
  TempStr := GetLocalPath(DirName,ChildName);
  //Проверка - есть ли там ".\"
  if Length(TempStr) > 1 then begin
    //Только если искомое могло поместиться в строку.
    if TempStr[1]+TempStr[2] = '.\' then begin
      //Изучаемый путь является child-ом DirName
      Result := true;
    end;
  end;
end;

// добаляет расширение если его еще нет.
function AddExtensionIfAbsent(const path, extension :String) :String;
var
  ex :AnsiString;
begin
  Result := path;
  ex := ExtractFileExt(path);
  if (ex = '') then begin
    Result := path + extension;
  end;
end;

// чистое имя файла, без расширения
function GetFileNameWithoutExtension(const path :String) :String;
var
  fileName :String;
  i        :Integer;
begin
  fileName := ExtractFileName(path);
  i := Length(FileName);
  while (i > 0) and (FileName[i] <> '.') do Dec(i);

  if (i > 0) then
    Result := Copy(FileName, 1, i - 1)
  else
    Result := fileName;
end;

Function HasLastSlash(const Str : string) : boolean;
//Функа для проверки наличия последнего слэша.
var
  I : integer;
  LastCh : char;
begin
  if Length(Str) > 0 then begin
    //Смысл что-то проверять есть только если строка не пуста.
    I := 0;
    LastCh := #0;
    repeat
      I := I+1;
      If str[I] <> #0 then begin
        LastCh := str[I];
      end;
    until str[I] = #0;
    //Если последний символ слэш то резулт тру, иначе фалс:
    If LastCh = '\' then result := true
    else result := false;
  end
  else begin
    //А если строка пуста - то оно всегда фалсе.
    Result := false;
  end;
end;

Function AddLastSlash(const str : string): string;
//Функа для добавления в путь последнего слэша (если надо).
begin
  //Если последний символ не слэш - то приплюсоватить его туды.
  If HasLastSlash(str) = false then result := str+'\'
  else result := str;
end;

Function DelLastSlash(const Str : string) : string;
//Удаляет последний слеш если он есть.
begin
  Result := '';
  if HasLastSlash(Str) = true then begin
    SetLength(Result,Length(Str)-1);
    CopyMemory(@Result[1],@Str[1],Length(Str)-1);
  end
  else begin
    Result := Str;
  end;
end;

end.