FileOperator.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302
  1. unit FileOperator;
  2. {
  3. +------------------------------------------------------------------------------+
  4. | TFileOperator Component Version 1.02 / 1999 |
  5. +------------------------------------------------------------------------------+
  6. | Author: Ingo Eckel |
  7. | |
  8. | Based on the TFileOperator component written by Glen Why 1996 |
  9. | Enhancements: uses TStringList as operands, undo functionality implemented. |
  10. +------------------------------------------------------------------------------+
  11. | Description: |
  12. | This component encapsulates the ShFileOperation API of Microsoft Windows. |
  13. | Performs a copy, move, rename, or delete operation on a file system object. |
  14. | It also allows to undo the last operation, if a copy or move operation |
  15. | was performed. |
  16. +------------------------------------------------------------------------------+
  17. | Properties: |
  18. | |
  19. | OperandFrom: |
  20. | Stringlist, that contains the names of the source files, |
  21. | wildcard filename (*.*) is accepted. |
  22. | |
  23. | OperandTo: |
  24. | Stringlist that specifies the destination for the moved, |
  25. | copied or renamed file. Should be the target directory, when |
  26. | performing a copy or move operation. |
  27. | |
  28. | WantMappingHandle: True, if shFileOperation should create a filename- |
  29. | mapping of the processed files. This mapping is allocated by |
  30. | shFileOperation and will be automatically deallocated by the |
  31. | component. |
  32. | |
  33. | Operation: |
  34. | -foCopy Copies the files specified by OperandFrom to the location |
  35. | specified by OperandTo. |
  36. | -foDelete Deletes the files specified by OperandFrom (OperandTo |
  37. | ignored). |
  38. | -foMove Moves the files specified by OperandFrom to the location |
  39. | specified by OperandTo. |
  40. | -foRename Renames the files specified by OperandFrom. |
  41. | |
  42. | Options: |
  43. | -foAllowUndo Preserves undo information, if possible. |
  44. | -foConfirmMouse Not implemented. |
  45. | -foFilesOnly Performs the operation only on files if a wildcard |
  46. | filename (*.*) is specified. |
  47. | -foMultiDestFiles Indicates that the OperandTo member specifies multiple|
  48. | destination files (one for each source file) rather |
  49. | than one directory where all source files are |
  50. | to be deposited. |
  51. | Note: not compatible with undo operation. |
  52. | -foNoConfirmation Responds with "yes to all" for any dialog box that |
  53. | is displayed. |
  54. | -fofNoConfirmMkDir Does not confirm the creation of a new directory |
  55. | if the operation requires one to be created. |
  56. | -foRenameOnCollision Gives the file being operated on a new name |
  57. | (such as "Copy #1 of...") in a move, copy, |
  58. | or rename operation if a file of the target name |
  59. | already exists. |
  60. | Note: not compatible with undo operation. |
  61. | -foSilent Does not display a progress dialog box. |
  62. | -foSimpleProgress Displays a progress dialog box, but does not show |
  63. | the filenames. |
  64. | |
  65. | Title: String to use as the title for a progress dialog box. |
  66. | This member is used only if Options includes fofSimpleProgress. |
  67. | |
  68. | WantMappingHandle After execution should a file mapping be returned. |
  69. | Works only, when option foMultiDestFiles used. |
  70. | Note: don't know, how to use this. |
  71. | |
  72. +------------------------------------------------------------------------------+
  73. | Methods: |
  74. | |
  75. | Function Execute : Boolean; |
  76. | Performs the copy, move, rename, or delete operation. |
  77. | Returns zero if successful or nonzero value if an error occurs. |
  78. | |
  79. +------------------------------------------------------------------------------+
  80. | Events: |
  81. +------------------------------------------------------------------------------+
  82. }
  83. {==============================================================}
  84. interface
  85. {==============================================================}
  86. uses
  87. Windows, Classes, Forms, Controls, ShellAPI, BaseUtils, SysUtils;
  88. Type
  89. TFileOperation = ( foCopy, foDelete, foMove, foRename );
  90. TFileOperationFlag = ( foAllowUndo, foConfirmMouse, foFilesOnly,
  91. foMultiDestFiles, foNoConfirmation, foNoConfirmMkDir,
  92. foRenameOnCollision, foSilent, foSimpleProgress);
  93. TFileOperationFlags = set of TFileOperationFlag;
  94. {==============================================================}
  95. TFileOperator = class
  96. {==============================================================}
  97. private
  98. {==============================================================}
  99. FData : TShFileOpStruct;
  100. FFrom : TStringList;
  101. FTo : TStringList;
  102. fOwner : TWinControl;
  103. Procedure SetOperation( Value :TFileOperation );
  104. Function GetOperation :TFileOperation;
  105. Function GetWantMappingHandle :Boolean;
  106. Procedure SetWantMappingHandle ( Value :Boolean );
  107. Procedure SetFlags( Value :TFileOperationFlags );
  108. Function GetFlags :TFileOperationFlags;
  109. Function GetOperFlag( F :Cardinal ) :Boolean;
  110. Procedure SetOperFlag( F :Cardinal; V :Boolean );
  111. {==============================================================}
  112. public
  113. {==============================================================}
  114. Property OperandFrom : TStringList Read fFrom Write fFrom;
  115. Property OperandTo : TStringList Read FTo Write fTo;
  116. Constructor Create(Owner: TWinControl);
  117. Destructor Destroy; override;
  118. Function Execute : Boolean;
  119. {==============================================================}
  120. published
  121. {==============================================================}
  122. Property Operation : TFileOperation Read GetOperation Write SetOperation Stored false;
  123. Property Flags : TFileOperationFlags Read GetFlags Write SetFlags Stored false;
  124. Property WantMappingHandle :Boolean Read GetWantMappingHandle Write SetWantMappingHandle Stored false;
  125. end;
  126. const
  127. FileOperatorDefaultFlags = [foAllowUndo, foNoConfirmMkDir];
  128. {==============================================================}
  129. implementation
  130. {==============================================================}
  131. uses
  132. PasTools;
  133. { TFileOperator }
  134. procedure TFileOperator.SetOperation( Value :TFileOperation );
  135. begin
  136. with FData do
  137. case Value of
  138. foCopy : wFunc := FO_COPY;
  139. foDelete : wFunc := FO_DELETE;
  140. foRename : wFunc := FO_RENAME;
  141. foMove : wFunc := FO_MOVE;
  142. end;
  143. end; {SetOperation}
  144. function TFileOperator.GetOperation :TFileOperation;
  145. begin
  146. result := foCopy;
  147. case FData.wFunc of
  148. FO_COPY : result := foCopy;
  149. FO_DELETE : result := foDelete;
  150. FO_RENAME : result := foRename;
  151. FO_MOVE : result := foMove;
  152. end;
  153. end; {GetOperation}
  154. function TFileOperator.GetWantMappingHandle :Boolean;
  155. begin
  156. result := GetOperFlag( FOF_WANTMAPPINGHANDLE );
  157. end;
  158. procedure TFileOperator.SetWantMappingHandle ( Value :Boolean );
  159. begin
  160. SetOperFlag( FOF_WANTMAPPINGHANDLE, Value );
  161. end;
  162. procedure TFileOperator.SetFlags( Value :TFileOperationFlags );
  163. begin
  164. SetOperFlag( FOF_ALLOWUNDO, foAllowUndo in Value );
  165. SetOperFlag( FOF_CONFIRMMOUSE, foConfirmMouse in Value );
  166. SetOperFlag( FOF_FILESONLY, foFilesOnly in Value );
  167. SetOperFlag( FOF_MULTIDESTFILES, foMultiDestFiles in Value );
  168. SetOperFlag( FOF_NOCONFIRMATION, foNoConfirmation in Value );
  169. SetOperFlag( FOF_NOCONFIRMMKDIR, foNoConfirmMkDir in Value );
  170. SetOperFlag( FOF_RENAMEONCOLLISION, foRenameOnCollision in Value );
  171. SetOperFlag( FOF_SILENT, foSilent in Value );
  172. SetOperFlag( FOF_SIMPLEPROGRESS, foSimpleProgress in Value );
  173. end; {SetFlags}
  174. function TFileOperator.GetFlags :TFileOperationFlags;
  175. begin
  176. result := [];
  177. if GetOperFlag( FOF_ALLOWUNDO ) then include( result, foAllowUndo );
  178. if GetOperFlag( FOF_CONFIRMMOUSE ) then include( result, foConfirmMouse );
  179. if GetOperFlag( FOF_FILESONLY ) then include( result, foFilesOnly );
  180. if GetOperFlag( FOF_MULTIDESTFILES ) then include( result, foMultiDestFiles );
  181. if GetOperFlag( FOF_NOCONFIRMATION ) then include( result, foNoConfirmation );
  182. if GetOperFlag( FOF_NOCONFIRMMKDIR ) then include( result, foNoConfirmMkDir );
  183. if GetOperFlag( FOF_RENAMEONCOLLISION ) then include( result, foRenameOnCollision );
  184. if GetOperFlag( FOF_SILENT ) then include( result, foSilent );
  185. if GetOperFlag( FOF_SIMPLEPROGRESS ) then include( result, foSimpleProgress );
  186. end; {GetFlags}
  187. function TFileOperator.GetOperFlag( F :Cardinal ):boolean;
  188. begin
  189. result := ( FData.fFlags and F ) <> 0;
  190. end;
  191. procedure TFileOperator.SetOperFlag( F :Cardinal; V :Boolean );
  192. begin
  193. with FData do
  194. if V then
  195. fFlags := fFlags or F
  196. else fFlags := fFlags and ( not F );
  197. end;
  198. Constructor TFileOperator.Create(Owner: TWinControl);
  199. begin
  200. inherited Create;
  201. fFrom := TStringList.Create;
  202. fTo := TStringList.Create;
  203. fOwner := Owner;
  204. FData.fFlags := 0;
  205. Flags := FileOperatorDefaultFlags;
  206. end; {Create}
  207. function TFileOperator.Execute : Boolean;
  208. Var SFrom : String;
  209. sTo : String;
  210. Function ConvertOperand(List : TStringList) : String;
  211. Var i : Integer;
  212. Begin
  213. Result := '';
  214. For i := 0 to Pred(List.Count) Do
  215. Begin
  216. // SHFileOperation does not support long paths anyway
  217. Result := Result + ApiPath(List[i]);
  218. SetLength(Result, Succ(Length(Result)));
  219. Result[Length(Result)] := #0;
  220. End;
  221. SetLength(Result, Succ(Length(Result)));
  222. Result[Length(Result)] := #0;
  223. End; {ConvertOperand}
  224. begin {Execute}
  225. SFrom := ConvertOperand(FFrom);
  226. STo := ConvertOperand(FTo);
  227. FData.pFrom := PChar( SFrom );
  228. FData.pTo := PChar( STo );
  229. IF Assigned(fOwner) and fOwner.HandleAllocated Then
  230. FData.Wnd := fOwner.Handle
  231. Else
  232. FData.Wnd := Application.Handle;
  233. Try
  234. IF Assigned(FData.hNameMappings) Then
  235. shFreeNameMappings(THandle(FData.hNameMappings));
  236. Finally
  237. FData.hNameMappings := NIL;
  238. End;
  239. Try
  240. Try
  241. IF Operation = foRename Then
  242. Result := RenameFile(FFrom[0], FTo[0])
  243. Else
  244. Result := ShFileOperation( FData ) = 0;
  245. Finally
  246. FFrom.Clear;
  247. FTo.Clear;
  248. End;
  249. Except
  250. Result := False;
  251. End;
  252. end; {Execute}
  253. destructor TFileOperator.Destroy;
  254. begin
  255. IF Assigned(FFrom) Then
  256. FFrom.Free;
  257. IF Assigned(FTo) Then
  258. FTo.Free;
  259. IF Assigned(FData.hNameMappings) Then
  260. shFreeNameMappings(THandle(FData.hNameMappings));
  261. inherited Destroy;
  262. end; {Destroy}
  263. end.