1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
| unit c_Shfileop;
{Component based on the ShFileOperation API function
Michel BURDIN - 1997}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellApi;
type
TShFlags = (shAllowUndo, shFilesOnly, shNoConfirmation, shNoConfirmMkDir,
shRenameOnCollision, shSilent, shSimpleProgress);
TShFlag = Set of TShFlags;
TShOp = (shCopy, shDelete, shMove, shRename);
TShFileOP = class(TComponent)
private
fHParent: THandle;
fOperation: TShOp;
fTo: AnsiString;
fFlags: TShFlag;
fFromList: TStringList;
fAborted: boolean;
fTitle: AnsiString;
fKeepFilesList: boolean;
protected
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
function Execute: boolean;
property Aborted: boolean read fAborted;
published
property Operation: TShOp read fOperation write fOperation default shCopy;
property FilesList: TStringList read fFromList write fFromList;
property Destination: AnsiString read fTo write fTo;
property Title: AnsiString read fTitle write fTitle;
property Options: TShFlag read fFlags write fFlags default [shAllowUndo];
property KeepFilesList: boolean read fKeepFilesList write fKeepFilesList
default False;
end;
procedure Register;
implementation
const
{+NT} ct_Shfileop_1 = 'PARF';
{+NT} vide = '';
constructor TShFileOp.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
if (aOwner is TWinControl) then fHParent := TWinControl(aOwner).Handle
else fHParent := 0;
fOperation := shCopy;
fTo := vide;
fFlags := [shAllowUndo];
fFromList := TStringList.Create;
fAborted := False;
fTitle := vide;
fKeepFilesList := False;
end;
destructor TShFileOp.Destroy;
begin
fFromList.Free;
inherited Destroy;
end;
function TShFileOp.Execute: boolean;
var TmpBuf: AnsiString;
shFO: TSHFileOpStruct;
i: Integer;
begin
Result := True;
TmpBuf := vide;
if fFromList.Count > 0 then
for i := 0 to fFromList.Count-1 do
{+NT} if fFromList[i] <> vide then TmpBuf := TmpBuf + fFromList[i] + ';';
for i := 1 to Length(TmpBuf) do
{+NT} if TmpBuf[i] = ';' then TmpBuf[i] := #0;
shFO.Wnd := fHParent;
case fOperation of
shCopy: shFO.wFunc := FO_COPY;
shDelete: shFo.wFunc := FO_DELETE;
shMove: shFo.wFunc := FO_MOVE;
shRename: shFo.wFunc := FO_RENAME;
end;
shFO.pFrom := PAnsiChar(TmpBuf);
shFO.pTo := PAnsiChar(fTo);
shFO.fFlags := 0;
if shAllowUndo in fFlags then shFO.fFlags := shFO.fFlags or FOF_ALLOWUNDO;
if shFilesOnly in fFlags then shFO.fFlags := shFO.fFlags or FOF_FILESONLY;
if shNoConfirmation in fFlags then shFO.fFlags := shFO.fFlags or FOF_NOCONFIRMATION;
if shNoConfirmMkDir in fFlags then shFO.fFlags := shFO.fFlags or FOF_NOCONFIRMMKDIR;
if shRenameOnCollision in fFlags then shFO.fFlags := shFO.fFlags or FOF_RENAMEONCOLLISION;
if shSilent in fFlags then shFO.fFlags := shFO.fFlags or FOF_SILENT;
if shSimpleProgress in fFlags then shFO.fFlags := shFO.fFlags or FOF_SIMPLEPROGRESS;
ShFO.fAnyOperationsAborted := False;
ShFO.hNameMappings := nil;
shFO.lpszProgressTitle := pAnsiChar(fTitle);
Result := (ShFileOperation(shFO) = 0);
fAborted := ShFO.fAnyOperationsAborted;
if not fKeepFilesList then fFromList.Clear;
end;
procedure Register;
begin
RegisterComponents(ct_Shfileop_1, [TShFileOp]); {PARF}
end;
end. |
Partager