{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvSHFileOp.PAS, released on 2002-05-26. The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net] Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Description: A wrapper component for the SHFileOperation function Known Issues: fofConfirmMouse does nothing -----------------------------------------------------------------------------} // $Id: JvSHFileOperation.pas 11963 2008-10-16 09:12:52Z obones $ unit JvSHFileOperation; {$I jvcl.inc} {$I windowsonly.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} {$IFDEF MSWINDOWS} Windows, ShellAPI, {$ENDIF MSWINDOWS} SysUtils, Classes, Controls, JvBaseDlg, JvWin32; type // type of operation to perform TJvShFileMappingEvent = procedure(Sender: TObject; const OldFileName, NewFileName: string) of object; TJvSHFileOpType = (foCopy, foDelete, foMove, foRename); TJvSHFileOption = (fofAllowUndo, fofConfirmMouse, fofFilesOnly, fofMultiDestFiles, fofNoConfirmation, fofNoConfirmMkDir, fofRenameOnCollision, fofSilent, fofSimpleProgress, fofWantMappingHandle, fofNoErrorUI, fofNoCopySecurityAttributes, fofNoRecursion, fofNoConnectedElements, fofNoRecurseParse, fofWantNukeWarning); TJvSHFileOptions = set of TJvSHFileOption; TJvSHFileOperation = class(TJvCommonDialog) private FSourceFiles: TStringList; FDestFiles: TStringList; FOperation: TJvSHFileOpType; FOptions: TJvSHFileOptions; FTitle: string; FLastErrorMsg: string; FOnFileMapping: TJvShFileMappingEvent; function GetSourceFiles: TStrings; function GetDestFiles: TStrings; procedure SetSourceFiles(Value: TStrings); procedure SetDestFiles(Value: TStrings); protected // returns a Handle to the window that owns this dialog function GetWinHandle: THandle; virtual; procedure DoFileMapping(const OldFileName, NewFileName: string); virtual; public // performs the Operation and returns True if no errors occurred function Execute: Boolean; override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; published // the files to perform the operation on (one file on each row). // Filenames can contain wildcards property SourceFiles: TStrings read GetSourceFiles write SetSourceFiles; // A list of destination filenames. If this is a folder, only need to add folder once // Otherwise, destfiles should match sourcefiles exactly property DestFiles: TStrings read GetDestFiles write SetDestFiles; // the operation to perform when Execute is called property Operation: TJvSHFileOpType read FOperation write FOperation default foCopy; /// Options for the Operation property Options: TJvSHFileOptions read FOptions write FOptions default [fofAllowUndo, fofFilesOnly]; // Title of the progress dialog property Title: string read FTitle write FTitle; // Called when a file was renamed (but only if fofRenameOnCollision and fofWantMappingHandle are both True) property OnFileMapping: TJvShFileMappingEvent read FOnFileMapping write FOnFileMapping; //HA 090709 // Saves the errormessage if Execution fails property LastErrorMsg: string read FLastErrorMsg; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_37_PREPARATION/run/JvSHFileOperation.pas $'; Revision: '$Revision: 11963 $'; Date: '$Date: 2008-10-16 11:12:52 +0200 (jeu., 16 oct. 2008) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses JvConsts, JvResources, JvTypes; type // helper object for file mappings PShHandleToMappings = ^TShHandleToMappings; TShHandleToMappings = packed record Count: UINT; PNameMappings: PSHNameMapping; end; constructor TJvSHFileOperation.Create(AOwner: TComponent); begin inherited Create(AOwner); FSourceFiles := TStringList.Create; FDestFiles := TStringList.Create; FOperation := foCopy; FOptions := [fofAllowUndo, fofFilesOnly]; end; destructor TJvSHFileOperation.Destroy; begin FSourceFiles.Free; FDestFiles.Free; inherited Destroy; end; {** returns True if no error occurred and user didn't abort } function TJvSHFileOperation.Execute: Boolean; const AOperation: array [TJvSHFileOpType] of UINT = (FO_COPY, FO_DELETE, FO_MOVE, FO_RENAME); AOption: array [TJvSHFileOption] of Word = (FOF_ALLOWUNDO, FOF_CONFIRMMOUSE, FOF_FILESONLY, FOF_MULTIDESTFILES, FOF_NOCONFIRMATION, FOF_NOCONFIRMMKDIR, FOF_RENAMEONCOLLISION, FOF_SILENT, FOF_SIMPLEPROGRESS, FOF_WANTMAPPINGHANDLE, FOF_NOERRORUI, FOF_NOCOPYSECURITYATTRIBS, FOF_NORECURSION, FOF_NO_CONNECTED_ELEMENTS, FOF_NORECURSEREPARSE, FOF_WANTNUKEWARNING); var SFOS: TShFileOpStruct; I: TJvSHFileOption; J: Integer; ppFrom, ppTo: string; PNameMapping: PSHNameMapping; PNameCount: UINT; S, D: string; begin if Length(FSourceFiles.Text) = 0 then EJVCLException.CreateRes(@RsENoFilesSpecifiedToTJvSHFileOperatio); FillChar(SFOS, SizeOf(TShFileOpStruct), #0); with SFOS do begin fAnyOperationsAborted := False; fFlags := 0; for I := Low(TJvSHFileOption) to High(TJvSHFileOption) do // Iterate if I in FOptions then fFlags := fFlags or AOption[I]; hNameMappings := nil; // this is never used ??? lpszProgressTitle := PChar(FTitle); ppFrom := ''; ppTo := ''; for J := 0 to FSourceFiles.Count - 1 do ppFrom := ppFrom + ExpandUNCFilename(FSourceFiles[J]) + #0; ppFrom := ppFrom + #0; pFrom := PChar(ppFrom); for J := 0 to FDestFiles.Count - 1 do ppTo := ppTo + ExpandUNCFilename(FDestFiles[J]) + #0; ppTo := ppTo + #0; pTo := PChar(ppTo); wFunc := AOperation[FOperation]; Wnd := GetWinHandle; // (Owner as TForm).Handle; end; //HA 090709 Clear last saved error message FLastErrorMsg := EmptyStr; Result := SHFileOperation(SFOS) = 0; //HA 090709 if SHFileOperation fails save error message if not Result then FLastErrorMsg := SysErrorMessage(GetLastError); Result := Result and not SFOS.fAnyOperationsAborted; PNameMapping := Pointer(SFOS.hNameMappings); if PNameMapping <> nil then begin PNameCount := PShHandleToMappings(PNameMapping)^.Count; PNameMapping := PShHandleToMappings(PNameMapping)^.PNameMappings; while PNameCount > 0 do begin if (PNameMapping.cchOldPath > 0) and (PNameMapping.cchNewPath > 0) then begin if Win32Platform = VER_PLATFORM_WIN32_NT then SetLength(S, PNameMapping.cchOldPath * 2) else SetLength(S, PNameMapping.cchOldPath); Move(PNameMapping.pszOldPath[0], S[1], Length(S) * SizeOf(Char)); if Win32Platform = VER_PLATFORM_WIN32_NT then SetLength(D, PNameMapping.cchNewPath * 2) else SetLength(D, PNameMapping.cchNewPath); Move(PNameMapping.pszNewPath[0], D[1], Length(D) * SizeOf(Char)); if Win32Platform = VER_PLATFORM_WIN32_NT then begin // (p3) ShFileOp returns widechars on NT platforms {$WARNINGS OFF} S := WideCharToString(PWideChar(S + #0)); D := WideCharToString(PWideChar(D + #0)); {$WARNINGS ON} end; DoFileMapping(S, D); end; Inc(PNameMapping); Dec(PNameCount); end; ShFreeNameMappings(Cardinal(SFOS.hNameMappings)); end; end; function TJvSHFileOperation.GetSourceFiles: TStrings; begin Result := FSourceFiles; end; function TJvSHFileOperation.GetDestFiles: TStrings; begin Result := FDestFiles; end; procedure TJvSHFileOperation.SetSourceFiles(Value: TStrings); begin FSourceFiles.Assign(Value); end; procedure TJvSHFileOperation.SetDestFiles(Value: TStrings); begin FDestFiles.Assign(Value); end; function TJvSHFileOperation.GetWinHandle: THandle; begin if Owner is TWinControl then Result := TWinControl(Owner).Handle else Result := GetForegroundWindow; end; procedure TJvSHFileOperation.DoFileMapping(const OldFileName, NewFileName: string); begin if Assigned(FOnFileMapping) then FOnFileMapping(Self, OldFileName, NewFileName); end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.