lina-components/Source/uFileTools.pas

unit uFileTools;

//////////////////////////////////////
///  Lina File Tools Unit          ///
///  ****************************  ///
///  (c) 2014 Dennis Göhlert a.o.  ///
//////////////////////////////////////

interface

{ Da Delphi vor Version 2009 noch keine Generics kannte, musste die TWinFiles-
  Deklaration auf Compiler-Versionen 20.0 oder höher beschränkt werden.
  Meines Wissens nach gibt es keine einfache Möglichkeit, Typisierte Listen
  auch in ältere Versionen zu integrieren. }

uses
  { Standard-Units }
  Classes, SysUtils, ShellAPI, Forms, Winapi.Windows,  Dialogs,
  {$IFNDEF NO_GENERIC}
    Generics.Collections,
  {$ENDIF}
  { Andere Package-Units }
  uBase;

type
  { Fehlermeldungen }
  EFileNoExist = class(Exception);
  EMissingTypeDesc = class(Exception);
  EMissingExts = class(Exception);
  EInvalidStyle = class(Exception);

type
  { Hilfsklassen }
  TFileExecuteMode = (feOpen,feEdit,feExplore,feFind,fePrint);
  TFileNameStyles = set of (fnDirectory,fnExtension);

type
  { Hauptklassen }
  TWinFile = class
  private
    { Private-Deklarationen }
    FFileName: String;
    FExecuteMode: TFileExecuteMode;
  public
    { Public-Deklarationen }
    constructor Create(AFileName: String);
    destructor Destroy;
    property FileName: String read FFileName;
    property ExecuteMode: TFileExecuteMode read FExecuteMode write FExecuteMode;
    function GetExtension(WithDot: Boolean = True): String;     //ExtractFileExt()
    function GetPath: String;                                   //ExtractFilePath()
    function GetDir: String;                                    //ExtractFileDir()
    function GetFileName(WithExt: Boolean = True): String;      //ExtractFileName()
    function GetFolderName: String;                             //ExtractFileFolder()
    // GetSize: Int64
    // GetVersion: Extended
    // GetAttribute: ...
    // GetOwner: String
    // GetCreated: TDateTime
    // GetModified: TDateTime
    function Execute: Boolean;                                  //ExecuteFile()
    function SafeExecute: Boolean;                              //.............
  end;

  TWinFiles = array of TWinFile;

  {$IFNDEF NOGENERIC}
    TWinFileList = TList<TWinFile>;
  {$ENDIF}

  function FEModeToPChar(FEMode: TFileExecuteMode): PChar;
  procedure EnsureDirDelimeter(var Dir: String);
  function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode = feOpen;
    InDir: Boolean = False): Boolean;
  function ExtractFileFolder(FileName: String): String;
  procedure ListFiles(Dir: String; OutList: TStrings; FileExts: array of String;
    NameStyles: TFileNameStyles = []); overload;
  procedure ListFolders(Dir: String; OutList: TStrings;
    NameStyles: TFileNameStyles = []); overload;

//const
  { Dateierweiterungen für ListFiles() }
  {FXT_ANY = '*.*'
  FXT_EXE = ('*.exe');
  FXT_TXT = ('*.txt';'*.rtf');
  FXT_IMG = ('*.jpg','*.jpeg','*.png','*.tif','*.tiff','*.bmp','*.gif');
  FXT_PAS = ('*.pas','*.dpr','*.dpk','*.dfm');
  FXT_MSO = ('*.doc','*.xls','*.ppt');
  FXT_MSI = ('*.msi');
  FXT_IMG = ('*.img','*.iso');  }

implementation

{ TWinFile }

function FEModeToPChar(FEMode: TFileExecuteMode): PChar;
begin
  case FEMode of
    feOpen: Result := 'open';
    feEdit: Result := 'edit';
    feExplore: Result := 'explore';
    feFind: Result := 'find';
    fePrint: Result := 'print';
    else Result := nil;
  end;
end;

procedure EnsureDirDelimeter(var Dir: String);
begin
  if (Dir[Length(Dir)] <> '\') and (Dir[Length(Dir)] <> '/') then
  begin
    Dir := Dir + '\';
  end else
  begin
    while Length(Dir) >= 1 do
    begin
      if (Dir[Length(Dir) - 1] = '\') or (Dir[Length(Dir) - 1] = '/') then
      begin
        Delete(Dir,Length(Dir) - 1,1);
      end else
      begin
        Break;
      end;
    end;
  end;
end;

procedure ListFiles(Dir: String; OutList: TStrings; FileExts: array of String;
  NameStyles: TFileNameStyles = []);
var
  SRec: TSearchRec;
  ExtIndex: Integer;
begin
  EnsureDirDelimeter(Dir);
  if Length(FileExts) < 1 then
  begin
    raise EMissingExts.Create('Missing file extensions');
  end;
  for ExtIndex := Low(FileExts) to High(FileExts) do
  begin
    if FindFirst(Dir + FileExts[ExtIndex],faAnyFile,SRec) = 0 then
    begin
      repeat
      if ((SRec.Attr and faDirectory) <> faDirectory) and
         (SRec.Name <> '.') and (SRec.Name <> '..') and
         (ChangeFileExt(SRec.Name,ExtractFileExt(FileExts[ExtIndex])) = SRec.Name) then
        begin
          OutList.Add(SRec.Name);
          if fnDirectory in NameStyles then
          begin
            OutList.Strings[OutList.Count - 1] := Dir + OutList.Strings[OutList.Count - 1];
          end;
          if not (fnExtension in NameStyles) then
          begin
            OutList.Strings[OutList.Count - 1] := ChangeFileExt(OutList.Strings[OutList.Count - 1],'');
          end;
        end;
      until FindNext(SRec) <> 0;
      SysUtils.FindClose(SRec);
    end;
  end;
end;

procedure ListFolders(Dir: String; OutList: TStrings;
  NameStyles: TFileNameStyles = []);
var
  SRec: TSearchRec;
begin
  EnsureDirDelimeter(Dir);
  if FindFirst(Dir + '*.*',faAnyFile,SRec) = 0 then
  begin
    repeat
      if ((SRec.Attr and faDirectory) = faDirectory) and
         (SRec.Name <> '.') and (SRec.Name <> '..') then
      begin
        if fnDirectory in NameStyles then
        begin
          OutList.Add(Dir + SRec.Name);
        end else
        begin
          OutList.Add(SRec.Name);
        end;
      end;
    until FindNext(SRec) <> 0;
    SysUtils.FindClose(SRec);
  end;
  if fnExtension in NameStyles then
  begin
    raise EInvalidStyle.Create('The extension file name style is invalid for directory names and has been ignored');
  end;
end;

function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode = feOpen;
  InDir: Boolean = False): Boolean;
begin
  Result := True;
  try
    if InDir = True then
    begin
      ShellExecute(Application.Handle,FEModeToPChar(ExecMode),PChar(FileName),nil,PChar(ExtractFileDir(FileName)),SW_NORMAL);
    end else
    begin
      ShellExecute(Application.Handle,FEModeToPChar(ExecMode),PChar(FileName),nil,nil,SW_NORMAL);
    end;
  except
    Result := False;
  end;
end;

function ExtractFileFolder(FileName: String): String;
begin
  Result := ExtractFileName(ExtractFileDir(FileName));        //Name d. übergeord. Ordners
end;

constructor TWinFile.Create(AFileName: String);
begin
  ExecuteMode := feOpen;
  FFileName := AFileName;
  if FileExists(AFileName) = False then
  begin
    raise EFileNoExist.Create('File not found: "' + AFileName + '"');
  end;
end;

destructor TWinFile.Destroy;
begin
  ExecuteMode := feOpen;
end;

function TWinFile.GetExtension(WithDot: Boolean = True): String;
begin
  if WithDot = True then
  begin
    Result := ExtractFileExt(FFileName);
  end else
  begin
    Result := Copy(ExtractFileExt(FFileName),2,Length(ExtractFileExt(FFileName)) - 1);
  end;
end;

function TWinFile.GetFileName(WithExt: Boolean = True): String;
begin
  if WithExt = True then
  begin
    Result := ExtractFileName(FFileName);                     //Name + Erweiterung
  end else
  begin
    Result := ExtractFileName(ChangeFileExt(FFileName,''));   //Nur Dateiname
  end;
end;

function TWinFile.GetFolderName: String;
begin
  Result := ExtractFileFolder(FFileName);
end;

function TWinFile.GetPath: String;
begin
  Result := ExtractFilePath(FFileName);                       //Gesamter Ordnerpfad (ohne Dateiname)
end;

function TWinFile.GetDir: String;
begin
  Result := ExtractFileDir(FFileName);
end;

function TWinFile.Execute: Boolean;
begin
  Result := ExecuteFile(FileName,ExecuteMode);
end;

function TWinFile.SafeExecute: Boolean;
begin
  Result := ExecuteFile(FileName,ExecuteMode,True);
end;

end.