(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTFileOperator;

interface
uses Windows, Classes,Sysutils,AHMSystemClass,ShellApi,AHMSystemConst;

type
  TAHMFileFlag     = (opAllowUndo,opConfirmMouse,opFilesOnly,opMultiDestFiles,
                      opNoConfirmation,opNoConfirmMkDir,opRenameOnCollision,
                      opSilent,opSimpleProgress,opWantMappingHandle);
  TAHMFileFlags    = set of TAHMFileFlag;
  TAHMFileFunction = (opCopyFile,opDeleteFile,opMoveFile,opRenameFile);
  TAHMFileOperator = class(TAHMExecuteComponent)
  private
    FData  : TShFileOpStruct;
    FFilesFrom  : TStrings;
    FDirTo,FDirFrom : string;
    FOnDone,FOnSuccessRename,FOnSuccessDelete,FOnSuccessCopy,FOnSuccessMove : TNotifyevent;
    FOnFailRename,FOnFailDelete,FOnFailCopy,FOnFailMove : TNotifyevent;
    FOperation : TAHMFileFunction;
    procedure SetFilesFrom(Value : TStrings);
    procedure SetFlags(Value : TAHMFileFlags);
    procedure SetOperFlag(F : Cardinal;V :Boolean);
    function GetFlags : TAHMFileFlags;
    function GetOperFlag(F : Cardinal) :Boolean;
  protected
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    function Execute : Boolean; override;
    function DiskCopy : Boolean;
  published
    Property FilesFrom : TStrings read FFilesFrom write SetFilesFrom;
    Property DirFrom : String read FDirFrom write FDirFrom;
    Property DirTo : String read FDirTo write FDirTo;
    Property Operation : TAHMFileFunction read FOperation write FOperation default opCopyFile;
    Property Flags : TAHMFileFlags read GetFlags write SetFlags default [opAllowUndo,opNoConfirmMkDir];
    Property OnSuccessRename : TNotifyevent read FOnSuccessRename write FOnSuccessRename;
    Property OnSuccessCopy : TNotifyevent read FOnSuccessCopy write FOnSuccessCopy;
    Property OnSuccessDelete : TNotifyevent read FOnSuccessDelete write FOnSuccessDelete;
    Property OnSuccessMove : TNotifyevent read FOnSuccessMove write FOnSuccessMove;
    Property OnFailRename : TNotifyevent read FOnFailRename write FOnFailRename;
    Property OnFailCopy : TNotifyevent read FOnFailCopy write FOnFailCopy;
    Property OnFailDelete : TNotifyevent read FOnFailDelete write FOnFailDelete;
    Property OnFailMove : TNotifyevent read FOnFailMove write FOnFailMove;
    Property OnDone : TNotifyevent read FOnDone write FOnDone;
  end;

implementation

procedure TAHMFileOperator.SetFilesFrom(Value : TStrings);
begin
  FFilesFrom.assign(Value);
end;

procedure TAHMFileOperator.SetFlags(Value : TAHMFileFlags);
begin
  SetOperFlag(FOF_ALLOWUNDO,opAllowUndo in Value);
  SetOperFlag(FOF_CONFIRMMOUSE,opConfirmMouse in Value);
  SetOperFlag(FOF_FILESONLY,opFilesOnly in Value);
  SetOperFlag(FOF_MULTIDESTFILES,opMultiDestFiles in Value);
  SetOperFlag(FOF_NOCONFIRMATION,opNoConfirmation in Value);
  SetOperFlag(FOF_NOCONFIRMMKDIR,opNoConfirmMkDir in Value);
  SetOperFlag(FOF_RENAMEONCOLLISION,opRenameOnCollision in Value);
  SetOperFlag(FOF_SILENT,opSilent in Value);
  SetOperFlag(FOF_SIMPLEPROGRESS,opSimpleProgress in Value);
  SetOperFlag(FOF_WANTMAPPINGHANDLE,opWantMappingHandle in Value);
end;

function TAHMFileOperator.GetFlags : TAHMFileFlags;
begin
  result := [];
  if GetOperFlag(FOF_ALLOWUNDO) then include(result,opAllowUndo);
  if GetOperFlag(FOF_CONFIRMMOUSE) then include(result,opConfirmMouse);
  if GetOperFlag(FOF_FILESONLY) then include(result,opFilesOnly);
  if GetOperFlag(FOF_MULTIDESTFILES) then include(result,opMultiDestFiles);
  if GetOperFlag(FOF_NOCONFIRMATION) then include(result,opNoConfirmation);
  if GetOperFlag(FOF_NOCONFIRMMKDIR) then include(result,opNoConfirmMkDir);
  if GetOperFlag(FOF_RENAMEONCOLLISION) then include(result,opRenameOnCollision);
  if GetOperFlag(FOF_SILENT) then include(result,opSilent);
  if GetOperFlag(FOF_SIMPLEPROGRESS) then include(result,opSimpleProgress);
  if GetOperFlag(FOF_WANTMAPPINGHANDLE) then include(result,opWantMappingHandle);
end;

function TAHMFileOperator.GetOperFlag(F : Cardinal):boolean;
begin
  result:=(FData.fFlags and F)<>0;
end;

procedure TAHMFileOperator.SetOperFlag(F : Cardinal;V :Boolean);
begin
 with FData do if V then fFlags:=fFlags or F else fFlags:=fFlags and (not F);
end;

constructor TAHMFileOperator.Create(AOwner : TComponent);
begin
 inherited Create(AOwner);
 FFilesFrom        := TStringlist.create;
 FData.fFlags := FOF_ALLOWUNDO OR FOF_NOCONFIRMMKDIR;
end;

function TAHMFileOperator.Execute :Boolean;
var i : integer;
    S1,S2,e1 : STRING;
procedure failure;
begin
  case FData.wFunc of
    FO_COPY   : if assigned(FOnFailCopy) then FOnFailCopy(self);
    FO_DELETE : if assigned(FOnFailDelete)then FOnFailDelete(self);
    FO_RENAME : if assigned(FOnFailRename) then FOnFailRename(self);
    FO_MOVE   : if assigned(FOnFailMove) then FOnFailMove(self);
  end;
end;
begin
 case FOperation of
   opCopyfile : FData.wFunc := FO_COPY;
   opDeletefile : FData.wFunc := FO_DELETE;
   opRenamefile : FData.wFunc := FO_RENAME;
   opMovefile : FData.wFunc := FO_MOVE;
 end;
 case FOperation of
   opCopyfile   : e1:=ahmsccopyE;
   opDeletefile : e1:=ahmscdeleteE;
   opRenamefile : e1:=ahmscrenameE;
   opMovefile   : e1:=ahmscmoveE;
 end;
 case FData.wFunc of
    FO_COPY   : FData.lpszProgressTitle := PChar(ahmscCopyO);
    FO_DELETE : FData.lpszProgressTitle := PChar(ahmscDeleteO);
    FO_RENAME : FData.lpszProgressTitle := PChar(ahmscRenameO);
    FO_MOVE   : FData.lpszProgressTitle := PChar(ahmscMoveO);
 end;
 if length(FDirFrom)>0 then
 IF FDirFrom[LENGTH(FDirFrom)]<>'\' THEN FDirFrom:=CONCAT(FDirFrom,'\');
 result:=false;
 if (FOperation<>opDeleteFile) and (FDirTo='') then raise Exception.Create('Directory Information is invalid')
 else
 begin
    if FDirFrom<>'' then
    begin
      {$I-}
      ChDir(FDirFrom);
      if IOResult <> 0 then raise Exception.Create('Can not locate current Directory');
      {$I+}
    end;
    if FFilesFrom.count>0 then
    begin
      S1:='';
      S1:=CONCAT(FDirFrom,FFilesFrom[0]);
      for i:=1 to FFilesFrom.count-1 do S1:=CONCAT(S1,#0,FDirFrom,FFilesFrom[i]);
      begin
        S1:=S1+#0;
        S2:=FDirTo+#0;
        FData.pFrom := PChar(S1);
        FData.pTo := PChar(S2);
        result := ShFileOperation(FData)=0;
        if result then
        begin
          case FData.wFunc of
            FO_COPY   : if assigned(FOnSuccessCopy)   then FOnSuccessCopy(self);
            FO_DELETE : if assigned(FOnSuccessDelete) then FOnSuccessDelete(self);
            FO_RENAME : if assigned(FOnSuccessRename)    then FOnSuccessRename(self);
            FO_MOVE   : if assigned(FOnSuccessMove)   then FOnSuccessMove(self);
          end;
        end;
      end;
    end;
  end;
  if not(result) then failure;
  if assigned(FOnDone) then FOnDone(self);
end;

destructor TAHMFileOperator.Destroy;
begin
  FFilesFrom.free;
  inherited Destroy;
end;

function TAHMFileOperator.DiskCopy : Boolean;
begin
  result:=not(WinExec('rundll32.exe Diskcopy.dll,DiskCopyRunDll', SW_SHOWDEFAULT) <= 31);
end;

end.
