unit FileOperator; { +------------------------------------------------------------------------------+ | TFileOperator Component Version 1.02 / 1999 | +------------------------------------------------------------------------------+ | Author: Ingo Eckel | | | | Based on the TFileOperator component written by Glen Why 1996 | | Enhancements: uses TStringList as operands, undo functionality implemented. | +------------------------------------------------------------------------------+ | Description: | | This component encapsulates the ShFileOperation API of Microsoft Windows. | | Performs a copy, move, rename, or delete operation on a file system object. | | It also allows to undo the last operation, if a copy or move operation | | was performed. | +------------------------------------------------------------------------------+ | Properties: | | | | OperandFrom: | | Stringlist, that contains the names of the source files, | | wildcard filename (*.*) is accepted. | | | | OperandTo: | | Stringlist that specifies the destination for the moved, | | copied or renamed file. Should be the target directory, when | | performing a copy or move operation. | | | | WantMappingHandle: True, if shFileOperation should create a filename- | | mapping of the processed files. This mapping is allocated by | | shFileOperation and will be automatically deallocated by the | | component. | | | | Operation: | | -foCopy Copies the files specified by OperandFrom to the location | | specified by OperandTo. | | -foDelete Deletes the files specified by OperandFrom (OperandTo | | ignored). | | -foMove Moves the files specified by OperandFrom to the location | | specified by OperandTo. | | -foRename Renames the files specified by OperandFrom. | | | | Options: | | -foAllowUndo Preserves undo information, if possible. | | -foConfirmMouse Not implemented. | | -foFilesOnly Performs the operation only on files if a wildcard | | filename (*.*) is specified. | | -foMultiDestFiles Indicates that the OperandTo member specifies multiple| | destination files (one for each source file) rather | | than one directory where all source files are | | to be deposited. | | Note: not compatible with undo operation. | | -foNoConfirmation Responds with "yes to all" for any dialog box that | | is displayed. | | -fofNoConfirmMkDir Does not confirm the creation of a new directory | | if the operation requires one to be created. | | -foRenameOnCollision Gives the file being operated on a new name | | (such as "Copy #1 of...") in a move, copy, | | or rename operation if a file of the target name | | already exists. | | Note: not compatible with undo operation. | | -foSilent Does not display a progress dialog box. | | -foSimpleProgress Displays a progress dialog box, but does not show | | the filenames. | | | | Title: String to use as the title for a progress dialog box. | | This member is used only if Options includes fofSimpleProgress. | | | | OperationAborted: Value that receives True if the user aborted any file | | operations before they were completed or FALSE otherwise. | | | | LastOperandFrom Stringlist of last performed value of Operandfrom. | | | | LastOperandTo Stringlist of last performed value of OperandTo. | | | | LastOperation Value of last performed operation. | | | | WantMappingHandle After execution should a file mapping be returned. | | Works only, when option foMultiDestFiles used. | | Note: don't know, how to use this. | | | | NameMappings Pointer to namemappings, if property wantmapping- | | handle set. | +------------------------------------------------------------------------------+ | Methods: | | | | Function Execute : Boolean; | | Performs the copy, move, rename, or delete operation. | | Returns zero if successful or nonzero value if an error occurs. | | | | Function UndoExecute : Boolean; | | Reverses the last copy, move or rename operation. | | Note: works currently only, if only a single OperandTo is used. This | | OperandTo must be the target directory. | | | | Function CanUndo : Boolean; | | Returns TRUE, if undo of last operation is possible. | | | | Procedure ClearUndo; | | Clears the preserved undo informations. After that, CanUndo allways | | returns false. | +------------------------------------------------------------------------------+ | Events: | +------------------------------------------------------------------------------+ } {==============================================================} interface {==============================================================} uses Windows, Classes, Forms, Controls, ShellAPI, BaseUtils, SysUtils; Type TFileOperation = ( foCopy, foDelete, foMove, foRename ); TFileOperationFlag = ( foAllowUndo, foConfirmMouse, foFilesOnly, foMultiDestFiles, foNoConfirmation, foNoConfirmMkDir, foRenameOnCollision, foSilent, foSimpleProgress); TFileOperationFlags = set of TFileOperationFlag; {==============================================================} TFileOperator = class( TComponent ) {==============================================================} private {==============================================================} FData : TShFileOpStruct; FFrom : TStringList; FTo : TStringList; FLastFrom : TStringList; FLastTo : TStringList; FLastOperation : TFileOperation; fLastFlags : TFileOperationFlags; fCanUndo : Boolean; Procedure SetOperation( Value :TFileOperation ); Function GetOperation :TFileOperation; Function GetWantMappingHandle :Boolean; Procedure SetWantMappingHandle ( Value :Boolean ); Procedure SetFlags( Value :TFileOperationFlags ); Function GetFlags :TFileOperationFlags; Function GetOperFlag( F :Cardinal ) :Boolean; Procedure SetOperFlag( F :Cardinal; V :Boolean ); Procedure ReadData( Reader :TReader ); Procedure WriteData( Writer :TWriter ); Procedure SwapStringList(Var FromL, ToL : TStringList); Function GetOperationAborted: Bool; {==============================================================} protected {==============================================================} Procedure DefineProperties( Filer :TFiler ); override; {==============================================================} public {==============================================================} Property OperationAborted : Bool Read GetOperationAborted; Property OperandFrom : TStringList Read fFrom Write fFrom; Property OperandTo : TStringList Read FTo Write fTo; Property CanUndo : Boolean Read fCanUndo; Property LastOperation : TFileOperation Read fLastOperation; Property LastOperandFrom : TStringList Read fLastFrom; Property LastOperandTo : TStringList Read fLastTo; Constructor Create(aOwner :TComponent); Override; Destructor Destroy; override; Function Execute : Boolean; Function UndoExecute : Boolean; Procedure ClearUndo; {==============================================================} published {==============================================================} Property Operation : TFileOperation Read GetOperation Write SetOperation Stored false; Property Flags : TFileOperationFlags Read GetFlags Write SetFlags Stored false; Property WantMappingHandle :Boolean Read GetWantMappingHandle Write SetWantMappingHandle Stored false; end; const FileOperatorDefaultFlags = [foAllowUndo, foNoConfirmMkDir]; procedure Register; {==============================================================} implementation {==============================================================} uses PasTools; { TFileOperator } procedure TFileOperator.SetOperation( Value :TFileOperation ); begin with FData do case Value of foCopy : wFunc := FO_COPY; foDelete : wFunc := FO_DELETE; foRename : wFunc := FO_RENAME; foMove : wFunc := FO_MOVE; end; end; {SetOperation} function TFileOperator.GetOperation :TFileOperation; begin result := foCopy; case FData.wFunc of FO_COPY : result := foCopy; FO_DELETE : result := foDelete; FO_RENAME : result := foRename; FO_MOVE : result := foMove; end; end; {GetOperation} function TFileOperator.GetWantMappingHandle :Boolean; begin result := GetOperFlag( FOF_WANTMAPPINGHANDLE ); end; procedure TFileOperator.SetWantMappingHandle ( Value :Boolean ); begin SetOperFlag( FOF_WANTMAPPINGHANDLE, Value ); end; procedure TFileOperator.SetFlags( Value :TFileOperationFlags ); begin SetOperFlag( FOF_ALLOWUNDO, foAllowUndo in Value ); SetOperFlag( FOF_CONFIRMMOUSE, foConfirmMouse in Value ); SetOperFlag( FOF_FILESONLY, foFilesOnly in Value ); SetOperFlag( FOF_MULTIDESTFILES, foMultiDestFiles in Value ); SetOperFlag( FOF_NOCONFIRMATION, foNoConfirmation in Value ); SetOperFlag( FOF_NOCONFIRMMKDIR, foNoConfirmMkDir in Value ); SetOperFlag( FOF_RENAMEONCOLLISION, foRenameOnCollision in Value ); SetOperFlag( FOF_SILENT, foSilent in Value ); SetOperFlag( FOF_SIMPLEPROGRESS, foSimpleProgress in Value ); end; {SetFlags} function TFileOperator.GetFlags :TFileOperationFlags; begin result := []; if GetOperFlag( FOF_ALLOWUNDO ) then include( result, foAllowUndo ); if GetOperFlag( FOF_CONFIRMMOUSE ) then include( result, foConfirmMouse ); if GetOperFlag( FOF_FILESONLY ) then include( result, foFilesOnly ); if GetOperFlag( FOF_MULTIDESTFILES ) then include( result, foMultiDestFiles ); if GetOperFlag( FOF_NOCONFIRMATION ) then include( result, foNoConfirmation ); if GetOperFlag( FOF_NOCONFIRMMKDIR ) then include( result, foNoConfirmMkDir ); if GetOperFlag( FOF_RENAMEONCOLLISION ) then include( result, foRenameOnCollision ); if GetOperFlag( FOF_SILENT ) then include( result, foSilent ); if GetOperFlag( FOF_SIMPLEPROGRESS ) then include( result, foSimpleProgress ); end; {GetFlags} function TFileOperator.GetOperFlag( F :Cardinal ):boolean; begin result := ( FData.fFlags and F ) <> 0; end; procedure TFileOperator.SetOperFlag( F :Cardinal; V :Boolean ); begin with FData do if V then fFlags := fFlags or F else fFlags := fFlags and ( not F ); end; procedure TFileOperator.DefineProperties( Filer :TFiler ); begin Inherited DefineProperties( Filer ); Filer.DefineProperty( 'data', ReadData, WriteData, true ); end; procedure TFileOperator.ReadData( Reader :TReader ); begin Reader.Read( FData, SizeOf( FData ) ); end; procedure TFileOperator.WriteData( Writer :TWriter ); begin writer.write( FData, SizeOf( FData ) ); end; Constructor TFileOperator.Create(aOwner :TComponent); begin inherited Create(aOwner); fFrom := TStringList.Create; fTo := TStringList.Create; fLastFrom := TStringList.Create; fLastTo := TStringList.Create; fCanUndo := False; FData.fFlags := 0; Flags := FileOperatorDefaultFlags; end; {Create} function TFileOperator.Execute : Boolean; Var SFrom : String; sTo : String; Function ConvertOperand(List : TStringList) : String; Var i : Integer; Begin Result := ''; For i := 0 to Pred(List.Count) Do Begin // SHFileOperation does not support long paths anyway Result := Result + ApiPath(List[i]); SetLength(Result, Succ(Length(Result))); Result[Length(Result)] := #0; End; SetLength(Result, Succ(Length(Result))); Result[Length(Result)] := #0; End; {ConvertOperand} begin {Execute} SFrom := ConvertOperand(FFrom); STo := ConvertOperand(FTo); FData.pFrom := PChar( SFrom ); FData.pTo := PChar( STo ); IF (Owner is TWinControl) And TWinControl(Owner).HandleAllocated Then FData.Wnd := GetParentForm(TWinControl(Owner)).Handle Else FData.Wnd := Application.Handle; Try IF Assigned(FData.hNameMappings) Then shFreeNameMappings(THandle(FData.hNameMappings)); Finally FData.hNameMappings := NIL; End; Try Try IF Operation = foRename Then Result := RenameFile(FFrom[0], FTo[0]) Else Result := ShFileOperation( FData ) = 0; Finally IF GetOperFlag(FOF_ALLOWUNDO) And Not GetOperFlag(FOF_MULTIDESTFILES) And Not GetOperFlag(FOF_RENAMEONCOLLISION) And (Operation <> foDelete) Then Begin SwapStringList(fLastFrom, fFrom); SwapStringList(fLastTo, fTo); fLastFlags := Flags; fCanUndo := True; fLastOperation := Operation; End Else Begin FLastFrom.Clear; FLastTo.Clear; fCanUndo := False; End; FFrom.Clear; FTo.Clear; End; Except Result := False; End; end; {Execute} destructor TFileOperator.Destroy; begin IF Assigned(FFrom) Then FFrom.Free; IF Assigned(FTo) Then FTo.Free; IF Assigned(FLastFrom) Then FLastFrom.Free; IF Assigned(FLastTo) Then FLastTo.Free; IF Assigned(FData.hNameMappings) Then shFreeNameMappings(THandle(FData.hNameMappings)); inherited Destroy; end; {Destroy} Procedure TFileOperator.SwapStringList(Var FromL, ToL : TStringList); Var StrL : TStringList; Begin StrL := FromL; FromL := ToL; ToL := StrL; End; {SwapStringList} Function TFileOperator.GetOperationAborted: Bool; Begin Result := FData.fAnyOperationsAborted; End; Function TFileOperator.UndoExecute : Boolean; Var SaveFlags : TFileOperationFlags; SaveOperation : TFileOperation; i : Integer; Begin Result := False; IF Not fCanUndo Or (fLastFrom.Count = 0) Or (FLastTo.Count <> 1) Then Exit; SaveFlags := Flags; SaveOperation := Operation; Flags := fLastFlags; Case SaveOperation OF foCopy : IF fLastTo.Count = 1 Then Begin Operation := foDelete; Flags := Flags - [foAllowUndo] + [foNoConfirmation]; OperandFrom.Clear; For i := 0 To fLastFrom.Count - 1 Do OperandFrom.Add(IncludeTrailingPathDelimiter(fLastTo[0]) + ExtractFilename(fLastFrom[i])); Result := Execute; End; foMove : IF fLastTo.Count = 1 Then Begin Operation := foMove; Flags := Flags + [foAllowUndo, foNoConfirmation]; OperandFrom.Clear; OperandTo.Clear; OperandTo.Add(ExtractFilePath(fLastFrom[0])); For i := 0 To fLastFrom.Count - 1 Do OperandFrom.Add(IncludeTrailingPathDelimiter(fLastTo[0]) + ExtractFilename(fLastFrom[i])); Result := Execute; End; foRename: IF (FLastFrom.Count = 1) And (FLastTo.Count = 1) Then Begin Operation := foRename; Flags := Flags + [foAllowUndo, foNoConfirmation]; OperandFrom.Clear; OperandTo.Clear; OperandFrom.Add(fLastTo[0]); OperandTo.Add(fLastFrom[0]); Result := Execute; End; End; {Case} Flags := SaveFlags; Operation := SaveOperation; End; {UndoExecute} Procedure TFileOperator.ClearUndo; Begin fCanUndo := False; fLastFrom.Clear; fLastTo.Clear; End; {ClearUndo} procedure Register; begin {MP}RegisterComponents( {'Tools'}'DriveDir', [ TFileOperator ] ); end; end.