mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
ADD: Shell folder file source (computer drive overview)
This commit is contained in:
Alexander Koblov
parent
a9842bc16d
commit
701100336d
17 changed files with 2117 additions and 8 deletions
|
|
@ -43,7 +43,7 @@
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(LazarusDir)\ide;$(ProjOutDir);..\sdk;..\units"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl;filesources\shellfolder"/>
|
||||
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
|
||||
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType);$(fpcsrcdir)\packages\fcl-base\src"/>
|
||||
</SearchPaths>
|
||||
|
|
@ -86,7 +86,7 @@
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(LazarusDir)\ide;$(ProjOutDir);..\sdk;..\units"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl;filesources\shellfolder"/>
|
||||
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
|
||||
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType);$(fpcsrcdir)\packages\fcl-base\src"/>
|
||||
</SearchPaths>
|
||||
|
|
@ -125,7 +125,7 @@
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(LazarusDir)\ide;$(ProjOutDir);..\sdk;..\units"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl;filesources\shellfolder"/>
|
||||
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
|
||||
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType);$(fpcsrcdir)\packages\fcl-base\src"/>
|
||||
</SearchPaths>
|
||||
|
|
@ -199,7 +199,7 @@ end;"/>
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(LazarusDir)\ide;$(ProjOutDir);..\sdk;..\units"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;..\components\DDetours\Source;filesources\gio\trash;filesources\winnet\wsl"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;..\components\DDetours\Source;filesources\gio\trash;filesources\winnet\wsl;filesources\shellfolder"/>
|
||||
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
|
||||
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType);$(fpcsrcdir)\packages\fcl-base\src"/>
|
||||
</SearchPaths>
|
||||
|
|
@ -310,7 +310,7 @@ end;"/>
|
|||
<PackageName Value="Image32"/>
|
||||
</Item13>
|
||||
</RequiredPackages>
|
||||
<Units Count="271">
|
||||
<Units Count="272">
|
||||
<Unit0>
|
||||
<Filename Value="doublecmd.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
|
@ -1985,6 +1985,11 @@ end;"/>
|
|||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="uHighlighters"/>
|
||||
</Unit270>
|
||||
<Unit271>
|
||||
<Filename Value="filesources\shellfolder\ushellfilesource.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="uShellFileSource"/>
|
||||
</Unit271>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
|
@ -1995,7 +2000,7 @@ end;"/>
|
|||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(LazarusDir)\ide;$(ProjOutDir);..\sdk;..\units"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl"/>
|
||||
<OtherUnitFiles Value="platform;platform\$(SrcOS);platform\$(SrcOS)\$(TargetOS);..\sdk;frames;fileviews;filesources;filesources\filesystem;filesources\multiarchive;filesources\multilist;filesources\searchresult;filesources\tempfilesystem;filesources\vfs;filesources\wcxarchive;filesources\wfxplugin;filesources\winnet;platform\unix\glib;platform\unix\mime;filesources\gio;rpc;rpc\sys\$(SrcOS);rpc\sys;filesources\recyclebin;filesources\gio\trash;filesources\winnet\wsl;filesources\shellfolder"/>
|
||||
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
|
||||
<SrcPath Value="$(LazarusDir)\lcl;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType);$(fpcsrcdir)\packages\fcl-base\src"/>
|
||||
</SearchPaths>
|
||||
|
|
|
|||
156
src/filesources/shellfolder/ushellcalcstatisticsoperation.pas
Normal file
156
src/filesources/shellfolder/ushellcalcstatisticsoperation.pas
Normal file
|
|
@ -0,0 +1,156 @@
|
|||
unit uShellCalcStatisticsOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ShlObj, ComObj, ActiveX,
|
||||
uFileSourceCalcStatisticsOperation,
|
||||
uFileSource,
|
||||
uShellFileSource,
|
||||
uFile,
|
||||
uGlobs, uLog;
|
||||
|
||||
type
|
||||
|
||||
TShellCalcStatisticsOperation = class(TFileSourceCalcStatisticsOperation)
|
||||
private
|
||||
FShellFileSource: IShellFileSource;
|
||||
FStatistics: TFileSourceCalcStatisticsOperationStatistics;
|
||||
|
||||
procedure ProcessFile(aFile: TFile);
|
||||
procedure ProcessSubDirs(AParent: IShellFolder2; AObject: PItemIDList);
|
||||
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
public
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
var theFiles: TFiles); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uShellFileSourceUtil, uShellFolder;
|
||||
|
||||
constructor TShellCalcStatisticsOperation.Create(
|
||||
aTargetFileSource: IFileSource;
|
||||
var theFiles: TFiles);
|
||||
begin
|
||||
FShellFileSource:= aTargetFileSource as IShellFileSource;
|
||||
inherited Create(aTargetFileSource, theFiles);
|
||||
end;
|
||||
|
||||
destructor TShellCalcStatisticsOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TShellCalcStatisticsOperation.Initialize;
|
||||
begin
|
||||
// Get initialized statistics; then we change only what is needed.
|
||||
FStatistics := RetrieveStatistics;
|
||||
end;
|
||||
|
||||
procedure TShellCalcStatisticsOperation.MainExecute;
|
||||
var
|
||||
CurrentFileIndex: Integer;
|
||||
begin
|
||||
for CurrentFileIndex := 0 to Files.Count - 1 do
|
||||
begin
|
||||
ProcessFile(Files[CurrentFileIndex]);
|
||||
CheckOperationState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellCalcStatisticsOperation.ProcessFile(aFile: TFile);
|
||||
var
|
||||
AObject: PItemIDList;
|
||||
AFolder: IShellFolder2;
|
||||
begin
|
||||
FStatistics.CurrentFile := aFile.FullPath;
|
||||
UpdateStatistics(FStatistics);
|
||||
|
||||
if aFile.IsDirectory then
|
||||
begin
|
||||
Inc(FStatistics.Directories);
|
||||
if Succeeded(FShellFileSource.FindFolder(AFile.Path, AFolder)) then
|
||||
begin
|
||||
if Succeeded(FShellFileSource.FindObject(AFolder, aFile.Name, AObject)) then
|
||||
try
|
||||
ProcessSubDirs(AFolder, AObject);
|
||||
finally
|
||||
CoTaskMemFree(AObject);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
Inc(FStatistics.Files);
|
||||
Inc(FStatistics.Size, aFile.Size);
|
||||
if aFile.ModificationTime < FStatistics.OldestFile then
|
||||
FStatistics.OldestFile := aFile.ModificationTime;
|
||||
if aFile.ModificationTime > FStatistics.NewestFile then
|
||||
FStatistics.NewestFile := aFile.ModificationTime;
|
||||
end;
|
||||
UpdateStatistics(FStatistics);
|
||||
end;
|
||||
|
||||
procedure TShellCalcStatisticsOperation.ProcessSubDirs(AParent: IShellFolder2; AObject: PItemIDList);
|
||||
var
|
||||
ASize: Int64;
|
||||
PIDL: PItemIDList;
|
||||
NumIDs: LongWord = 0;
|
||||
EnumIDList: IEnumIDList;
|
||||
AFolder: IShellFolder2;
|
||||
begin
|
||||
try
|
||||
OleCheck(AParent.BindToObject(AObject, nil, IID_IShellFolder2, Pointer(AFolder)));
|
||||
OleCheck(AFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_STORAGE or SHCONTF_INCLUDEHIDDEN, EnumIDList));
|
||||
|
||||
while EnumIDList.Next(1, PIDL, NumIDs) = S_OK do
|
||||
try
|
||||
if GetIsFolder(AParent, PIDL) then
|
||||
begin
|
||||
Inc(FStatistics.Directories);
|
||||
ProcessSubDirs(AFolder, PIDL);
|
||||
end
|
||||
else begin
|
||||
ASize:= GetDetails(AFolder, PIDL, SCID_FileSize);
|
||||
Inc(FStatistics.Size, ASize);
|
||||
Inc(FStatistics.Files);
|
||||
end;
|
||||
CheckOperationState;
|
||||
UpdateStatistics(FStatistics);
|
||||
finally
|
||||
CoTaskMemFree(PIDL);
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
LogMessage(E.Message, [log_errors], lmtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellCalcStatisticsOperation.LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
begin
|
||||
case logMsgType of
|
||||
lmtError:
|
||||
if not (log_errors in gLogOptions) then Exit;
|
||||
lmtInfo:
|
||||
if not (log_info in gLogOptions) then Exit;
|
||||
lmtSuccess:
|
||||
if not (log_success in gLogOptions) then Exit;
|
||||
end;
|
||||
|
||||
if logOptions <= gLogOptions then
|
||||
begin
|
||||
logWrite(Thread, sMessage, logMsgType);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
202
src/filesources/shellfolder/ushellcopyoperation.pas
Normal file
202
src/filesources/shellfolder/ushellcopyoperation.pas
Normal file
|
|
@ -0,0 +1,202 @@
|
|||
unit uShellCopyOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ShlObj, ComObj,
|
||||
uFileSourceOperation,
|
||||
uFileSourceCopyOperation,
|
||||
uFileSource,
|
||||
uFileSourceOperationTypes,
|
||||
uFileSourceOperationOptions,
|
||||
uFileSourceOperationOptionsUI,
|
||||
uFile,
|
||||
uShellFileSource,
|
||||
uShellFileOperation,
|
||||
uShellFileSourceUtil;
|
||||
|
||||
type
|
||||
|
||||
{ TShellCopyOperation }
|
||||
|
||||
TShellCopyOperation = class(TFileSourceCopyOperation)
|
||||
protected
|
||||
FFileOp: IFileOperation;
|
||||
FTargetFolder: IShellItem;
|
||||
FSourceFilesTree: TItemList;
|
||||
FShellFileSource: IShellFileSource;
|
||||
FStatistics: TFileSourceCopyOperationStatistics;
|
||||
|
||||
procedure ShowError(const sMessage: String);
|
||||
public
|
||||
constructor Create(aSourceFileSource: IFileSource;
|
||||
aTargetFileSource: IFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
{ TShellCopyInOperation }
|
||||
|
||||
TShellCopyInOperation = class(TShellCopyOperation)
|
||||
protected
|
||||
function GetID: TFileSourceOperationType; override;
|
||||
public
|
||||
procedure Initialize; override;
|
||||
end;
|
||||
|
||||
{ TShellCopyOutOperation }
|
||||
|
||||
TShellCopyOutOperation = class(TShellCopyOperation)
|
||||
protected
|
||||
function GetID: TFileSourceOperationType; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
ActiveX, DCConvertEncoding, uFileSourceOperationUI, uShellFolder, uGlobs, uLog;
|
||||
|
||||
procedure TShellCopyOperation.ShowError(const sMessage: String);
|
||||
begin
|
||||
if (log_cp_mv_ln in gLogOptions) and (log_errors in gLogOptions) then
|
||||
begin
|
||||
logWrite(Thread, sMessage, lmtError);
|
||||
end;
|
||||
|
||||
if AskQuestion(sMessage, '', [fsourSkip, fsourAbort],
|
||||
fsourSkip, fsourAbort) = fsourAbort then
|
||||
begin
|
||||
RaiseAbortOperation;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TShellCopyOperation.Create(aSourceFileSource: IFileSource;
|
||||
aTargetFileSource: IFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String);
|
||||
begin
|
||||
case GetID of
|
||||
fsoCopy, fsoCopyOut:
|
||||
FShellFileSource:= aSourceFileSource as IShellFileSource;
|
||||
fsoCopyIn:
|
||||
FShellFileSource:= aTargetFileSource as IShellFileSource;
|
||||
end;
|
||||
FFileOp:= CreateComObject(CLSID_FileOperation) as IFileOperation;
|
||||
inherited Create(aSourceFileSource, aTargetFileSource, theSourceFiles, aTargetPath);
|
||||
end;
|
||||
|
||||
destructor TShellCopyOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FSourceFilesTree);
|
||||
end;
|
||||
|
||||
procedure TShellCopyOperation.Initialize;
|
||||
var
|
||||
aFile: TFile;
|
||||
Index: Integer;
|
||||
AObject: PItemIDList;
|
||||
AFolder: IShellFolder2;
|
||||
begin
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
FSourceFilesTree:= TItemList.Create;
|
||||
try
|
||||
for Index := 0 to SourceFiles.Count - 1 do
|
||||
begin
|
||||
aFile:= SourceFiles[Index];
|
||||
CheckObject(FShellFileSource.FindObject(aFile.FullPath, AObject), aFile.FullPath);
|
||||
FSourceFilesTree.Add(AObject);
|
||||
end;
|
||||
case GetID of
|
||||
fsoCopy:
|
||||
begin
|
||||
CheckObject(FShellFileSource.FindFolder(TargetPath, AFolder), TargetPath);
|
||||
OleCheck(SHGetIDListFromObject(AFolder, AObject));
|
||||
try
|
||||
OleCheck(SHCreateItemFromIDList(AObject, IShellItem, FTargetFolder));
|
||||
finally
|
||||
CoTaskMemFree(AObject);
|
||||
end;
|
||||
end;
|
||||
fsoCopyOut:
|
||||
OleCheck(SHCreateItemFromParsingName(PWideChar(CeUtf8ToUtf16(TargetPath)), nil, IShellItem, FTargetFolder));
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellCopyOperation.MainExecute;
|
||||
var
|
||||
dwCookie: DWORD;
|
||||
siItemArray: IShellItemArray;
|
||||
ASink: TFileOperationProgressSink;
|
||||
begin
|
||||
ASink:= TFileOperationProgressSink.Create(@FStatistics, @UpdateStatistics);
|
||||
|
||||
FFileOp.SetOperationFlags(FOF_SILENT or FOF_NOCONFIRMMKDIR);
|
||||
|
||||
try
|
||||
FFileOp.Advise(ASink, @dwCookie);
|
||||
try
|
||||
OleCheck(SHCreateShellItemArrayFromIDLists(FSourceFilesTree.Count, PPItemIDList(FSourceFilesTree.List), siItemArray));
|
||||
OleCheck(FFileOp.CopyItems(siItemArray, FTargetFolder));
|
||||
OleCheck(FFileOp.PerformOperations);
|
||||
finally
|
||||
FFileOp.Unadvise(dwCookie);
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TShellCopyInOperation }
|
||||
|
||||
function TShellCopyInOperation.GetID: TFileSourceOperationType;
|
||||
begin
|
||||
Result:= fsoCopyIn;
|
||||
end;
|
||||
|
||||
procedure TShellCopyInOperation.Initialize;
|
||||
var
|
||||
aFile: TFile;
|
||||
Index: Integer;
|
||||
AObject: PItemIDList;
|
||||
AFolder: IShellFolder2;
|
||||
begin
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
FSourceFilesTree:= TItemList.Create;
|
||||
try
|
||||
for Index := 0 to SourceFiles.Count - 1 do
|
||||
begin
|
||||
aFile := SourceFiles[Index];
|
||||
AObject:= ILCreateFromPathW(PWideChar(CeUtf8ToUtf16(aFile.FullPath)));
|
||||
FSourceFilesTree.Add(AObject);
|
||||
end;
|
||||
CheckObject(FShellFileSource.FindFolder(TargetPath, AFolder), TargetPath);
|
||||
OleCheck(SHGetIDListFromObject(AFolder, AObject));
|
||||
OleCheck(SHCreateItemFromIDList(AObject, IShellItem, FTargetFolder));
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TShellCopyOutOperation }
|
||||
|
||||
function TShellCopyOutOperation.GetID: TFileSourceOperationType;
|
||||
begin
|
||||
Result:= fsoCopyOut;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
unit uShellCreateDirectoryOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceCreateDirectoryOperation,
|
||||
uShellFileSource,
|
||||
uFileSource;
|
||||
|
||||
type
|
||||
|
||||
{ TShellCreateDirectoryOperation }
|
||||
|
||||
TShellCreateDirectoryOperation = class(TFileSourceCreateDirectoryOperation)
|
||||
private
|
||||
FShellFileSource: IShellFileSource;
|
||||
public
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
aCurrentPath: String;
|
||||
aDirectoryPath: String); override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uFileSourceOperationUI, uGlobs, uLog, uLng;
|
||||
|
||||
{ TShellCreateDirectoryOperation }
|
||||
|
||||
constructor TShellCreateDirectoryOperation.Create(aTargetFileSource: IFileSource;
|
||||
aCurrentPath: String; aDirectoryPath: String);
|
||||
begin
|
||||
FShellFileSource := aTargetFileSource as IShellFileSource;
|
||||
inherited Create(aTargetFileSource, aCurrentPath, aDirectoryPath);
|
||||
end;
|
||||
|
||||
procedure TShellCreateDirectoryOperation.MainExecute;
|
||||
begin
|
||||
if FShellFileSource.CreateDirectory(AbsolutePath) then
|
||||
begin
|
||||
if (log_dir_op in gLogOptions) and (log_success in gLogOptions) then
|
||||
logWrite(Thread, Format(rsMsgLogSuccess + rsMsgLogMkDir, [AbsolutePath]), lmtSuccess);
|
||||
end
|
||||
else begin
|
||||
if (log_dir_op in gLogOptions) and (log_errors in gLogOptions) then
|
||||
logWrite(Thread, Format(rsMsgLogError + rsMsgLogMkDir, [AbsolutePath]), lmtError);
|
||||
|
||||
AskQuestion(Format(rsMsgErrForceDir, [AbsolutePath]), '', [fsourOk], fsourOk, fsourOk);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
120
src/filesources/shellfolder/ushelldeleteoperation.pas
Normal file
120
src/filesources/shellfolder/ushelldeleteoperation.pas
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
unit uShellDeleteOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ShlObj, ComObj,
|
||||
uFileSourceDeleteOperation,
|
||||
uShellFileSource,
|
||||
uFileSource,
|
||||
uShellFileOperation,
|
||||
uShellFileSourceUtil,
|
||||
uFileSourceOperationUI,
|
||||
uFile,
|
||||
uGlobs, uLog;
|
||||
|
||||
type
|
||||
|
||||
{ TShellDeleteOperation }
|
||||
|
||||
TShellDeleteOperation = class(TFileSourceDeleteOperation)
|
||||
protected
|
||||
FFileOp: IFileOperation;
|
||||
FSourceFilesTree: TItemList;
|
||||
FShellFileSource: IShellFileSource;
|
||||
FStatistics: TFileSourceDeleteOperationStatistics;
|
||||
|
||||
procedure ShowError(const sMessage: String);
|
||||
public
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
var theFilesToDelete: TFiles); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DCOSUtils, uLng, uShellFolder;
|
||||
|
||||
procedure TShellDeleteOperation.ShowError(const sMessage: String);
|
||||
begin
|
||||
if (log_errors in gLogOptions) and (log_delete in gLogOptions) then
|
||||
begin
|
||||
logWrite(Thread, sMessage, lmtError);
|
||||
end;
|
||||
|
||||
if AskQuestion(sMessage, '', [fsourSkip, fsourAbort],
|
||||
fsourSkip, fsourAbort) = fsourAbort then
|
||||
begin
|
||||
RaiseAbortOperation;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TShellDeleteOperation.Create(aTargetFileSource: IFileSource;
|
||||
var theFilesToDelete: TFiles);
|
||||
begin
|
||||
FShellFileSource:= aTargetFileSource as IShellFileSource;
|
||||
FFileOp:= CreateComObject(CLSID_FileOperation) as IFileOperation;
|
||||
inherited Create(aTargetFileSource, theFilesToDelete);
|
||||
end;
|
||||
|
||||
destructor TShellDeleteOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FSourceFilesTree);
|
||||
end;
|
||||
|
||||
procedure TShellDeleteOperation.Initialize;
|
||||
var
|
||||
aFile: TFile;
|
||||
Index: Integer;
|
||||
AObject: PItemIDList;
|
||||
begin
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
FSourceFilesTree:= TItemList.Create;
|
||||
|
||||
try
|
||||
for Index := 0 to FilesToDelete.Count - 1 do
|
||||
begin
|
||||
aFile := FilesToDelete[Index];
|
||||
CheckObject(FShellFileSource.FindObject(aFile.FullPath, AObject), aFile.FullPath);
|
||||
FSourceFilesTree.Add(AObject);
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellDeleteOperation.MainExecute;
|
||||
var
|
||||
dwCookie: DWORD;
|
||||
siItemArray: IShellItemArray;
|
||||
ASink: TFileOperationProgressSink;
|
||||
begin
|
||||
ASink:= TFileOperationProgressSink.Create(@FStatistics, @UpdateStatistics);
|
||||
|
||||
FFileOp.SetOperationFlags(FOF_SILENT or FOF_NOCONFIRMATION);
|
||||
try
|
||||
FFileOp.Advise(ASink, @dwCookie);
|
||||
try
|
||||
OleCheck(SHCreateShellItemArrayFromIDLists(FSourceFilesTree.Count, PPItemIDList(FSourceFilesTree.List), siItemArray));
|
||||
OleCheck(FFileOp.DeleteItems(siItemArray));
|
||||
OleCheck(FFileOp.PerformOperations);
|
||||
finally
|
||||
FFileOp.Unadvise(dwCookie);
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
105
src/filesources/shellfolder/ushellexecuteoperation.pas
Normal file
105
src/filesources/shellfolder/ushellexecuteoperation.pas
Normal file
|
|
@ -0,0 +1,105 @@
|
|||
unit uShellExecuteOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFile,
|
||||
uFileSource,
|
||||
uShellFileSource,
|
||||
uFileSourceExecuteOperation;
|
||||
|
||||
type
|
||||
|
||||
{ TShellExecuteOperation }
|
||||
|
||||
TShellExecuteOperation = class(TFileSourceExecuteOperation)
|
||||
private
|
||||
FShellFileSource: IShellFileSource;
|
||||
public
|
||||
{en
|
||||
@param(aTargetFileSource
|
||||
File source where the file should be executed.)
|
||||
@param(aExecutableFile
|
||||
File that should be executed.)
|
||||
@param(aCurrentPath
|
||||
Path of the file source where the execution should take place.)
|
||||
}
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
var aExecutableFile: TFile;
|
||||
aCurrentPath,
|
||||
aVerb: String); override;
|
||||
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Windows, ActiveX, ComObj, ShlObj, ShellAPI, DCOSUtils,
|
||||
DCConvertEncoding, fMain;
|
||||
|
||||
constructor TShellExecuteOperation.Create(aTargetFileSource: IFileSource;
|
||||
var aExecutableFile: TFile; aCurrentPath, aVerb: String);
|
||||
begin
|
||||
FShellFileSource := aTargetFileSource as IShellFileSource;
|
||||
inherited Create(aTargetFileSource, aExecutableFile, aCurrentPath, aVerb);
|
||||
end;
|
||||
|
||||
procedure TShellExecuteOperation.MainExecute;
|
||||
var
|
||||
PIDL: PItemIDList;
|
||||
Menu: IContextMenu;
|
||||
AFolder: IShellFolder2;
|
||||
cmici: TCMInvokeCommandInfo;
|
||||
AExecInfo: TShellExecuteInfoW;
|
||||
begin
|
||||
if Verb = 'properties' then
|
||||
try
|
||||
OleCheck(FShellFileSource.FindFolder(CurrentPath, AFolder));
|
||||
OleCheck(FShellFileSource.FindObject(AFolder, ExecutableFile.Name, PIDL));
|
||||
OleCheck(AFolder.GetUIObjectOf(frmMain.Handle, 1, PIDL, IID_IContextMenu, nil, Menu));
|
||||
if Assigned(Menu) then
|
||||
begin
|
||||
cmici:= Default(TCMInvokeCommandInfo);
|
||||
with cmici do
|
||||
begin
|
||||
cbSize := SizeOf(TCMInvokeCommandInfo);
|
||||
hwnd := frmMain.Handle;
|
||||
lpVerb := PAnsiChar(Verb);
|
||||
nShow := SW_SHOWNORMAL;
|
||||
end;
|
||||
OleCheck(Menu.InvokeCommand(cmici));
|
||||
end;
|
||||
except
|
||||
FExecuteOperationResult:= fseorError;
|
||||
end
|
||||
else if FShellFileSource.IsPathAtRoot(CurrentPath) then
|
||||
begin
|
||||
FResultString:= ExecutableFile.LinkProperty.LinkTo;
|
||||
FExecuteOperationResult:= fseorSymLink;
|
||||
end
|
||||
else begin
|
||||
AExecInfo:= Default(TShellExecuteInfoW);
|
||||
AExecInfo.cbSize:= SizeOf(TShellExecuteInfoW);
|
||||
|
||||
if Failed(FShellFileSource.FindObject(AbsolutePath, AExecInfo.lpIDList)) then
|
||||
FExecuteOperationResult:= fseorError
|
||||
else begin
|
||||
AExecInfo.fMask:= SEE_MASK_IDLIST;
|
||||
|
||||
if ShellExecuteExW(@AExecInfo) then
|
||||
FExecuteOperationResult:= fseorSuccess
|
||||
else begin
|
||||
FExecuteOperationResult:= fseorError;
|
||||
end;
|
||||
|
||||
CoTaskMemFree(AExecInfo.lpIDList);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
418
src/filesources/shellfolder/ushellfilesource.pas
Normal file
418
src/filesources/shellfolder/ushellfilesource.pas
Normal file
|
|
@ -0,0 +1,418 @@
|
|||
unit uShellFileSource;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Dialogs,
|
||||
Windows, ShlObj,
|
||||
uFileSourceProperty,
|
||||
uVirtualFileSource, uFileProperty, uFileSource,
|
||||
uFileSourceOperation, uFile, uFileSourceOperationTypes;
|
||||
|
||||
type
|
||||
|
||||
{ IShellFileSource }
|
||||
|
||||
IShellFileSource = interface(IVirtualFileSource)
|
||||
['{1E598290-5E66-423C-BB55-333E293106E8}']
|
||||
function CreateFolder(AParent: IShellFolder2; const Name: String): HRESULT;
|
||||
function FindFolder(const Path: String; out AValue: IShellFolder2): HRESULT;
|
||||
function FindObject(const AObject: String; out AValue: PItemIDList): HRESULT;
|
||||
function FindObject(AParent: IShellFolder2; const AName: String; out AValue: PItemIDList): HRESULT;
|
||||
end;
|
||||
|
||||
{ TShellFileSource }
|
||||
|
||||
TShellFileSource = class(TVirtualFileSource, IShellFileSource)
|
||||
private
|
||||
FDrives: PItemIDList;
|
||||
FDesktopFolder: IShellFolder;
|
||||
protected
|
||||
function SetCurrentWorkingDirectory(NewDir: String): Boolean; override;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
|
||||
class function IsSupportedPath(const Path: String): Boolean; override;
|
||||
class function CreateFile(const APath: String): TFile; override;
|
||||
class function GetMainIcon(out Path: String): Boolean; override;
|
||||
|
||||
class function RootName: String;
|
||||
|
||||
function CreateFolder(AParent: IShellFolder2; const Name: String): HRESULT;
|
||||
function FindFolder(const Path: String; out AValue: IShellFolder2): HRESULT;
|
||||
function FindObject(const AObject: String; out AValue: PItemIDList): HRESULT;
|
||||
function FindObject(AParent: IShellFolder2; const AName: String; out AValue: PItemIDList): HRESULT;
|
||||
|
||||
function CreateDirectory(const Path: String): Boolean; override;
|
||||
function FileSystemEntryExists(const Path: String): Boolean; override;
|
||||
|
||||
function GetOperationsTypes: TFileSourceOperationTypes; override;
|
||||
function GetSupportedFileProperties: TFilePropertiesTypes; override;
|
||||
function GetRootDir(sPath: String): String; override; overload;
|
||||
function GetProperties: TFileSourceProperties; override;
|
||||
|
||||
function CreateListOperation(TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; override;
|
||||
function CreateCreateDirectoryOperation(BasePath: String; DirectoryPath: String): TFileSourceOperation; override;
|
||||
function CreateExecuteOperation(var ExecutableFile: TFile; BasePath, Verb: String): TFileSourceOperation; override;
|
||||
function CreateMoveOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateCopyOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateCopyInOperation(SourceFileSource: IFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateCopyOutOperation(TargetFileSource: IFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateCalcStatisticsOperation(var theFiles: TFiles): TFileSourceOperation; override;
|
||||
function CreateSetFilePropertyOperation(var theTargetFiles: TFiles;
|
||||
var theNewProperties: TFileProperties): TFileSourceOperation; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
ActiveX, ComObj,DCConvertEncoding, uShellFolder, uShellListOperation,
|
||||
uShellCopyOperation, uShellFileOperation, uShellCreateDirectoryOperation,
|
||||
uShellExecuteOperation, uShellSetFilePropertyOperation, uShellFileSourceUtil,
|
||||
uShellDeleteOperation, uShellMoveOperation, UShellCalcStatisticsOperation,
|
||||
uLng, uShlObjAdditional;
|
||||
|
||||
{ TShellFileSource }
|
||||
|
||||
function TShellFileSource.SetCurrentWorkingDirectory(NewDir: String): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
constructor TShellFileSource.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
OleCheck(SHGetDesktopFolder(FDesktopFolder));
|
||||
OleCheck(SHGetFolderLocation(0, CSIDL_DRIVES, 0, 0, {%H-}FDrives));
|
||||
FOperationsClasses[fsoMove] := TShellMoveOperation.GetOperationClass;
|
||||
FOperationsClasses[fsoCopy] := TShellCopyOperation.GetOperationClass;
|
||||
FOperationsClasses[fsoCopyIn] := TShellCopyInOperation.GetOperationClass;
|
||||
FOperationsClasses[fsoCopyOut] := TShellCopyOutOperation.GetOperationClass;
|
||||
end;
|
||||
|
||||
destructor TShellFileSource.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
CoTaskMemFree(FDrives);
|
||||
end;
|
||||
|
||||
class function TShellFileSource.IsSupportedPath(const Path: String): Boolean;
|
||||
begin
|
||||
Result:= SameText(ExcludeTrailingBackslash(Path), PathDelim + PathDelim + PathDelim + rsVfsRecycleBin);
|
||||
end;
|
||||
|
||||
class function TShellFileSource.CreateFile(const APath: String): TFile;
|
||||
begin
|
||||
Result := TFile.Create(APath);
|
||||
with Result do
|
||||
begin
|
||||
AttributesProperty := TFileAttributesProperty.CreateOSAttributes;
|
||||
SizeProperty := TFileSizeProperty.Create;
|
||||
ModificationTimeProperty := TFileModificationDateTimeProperty.Create;
|
||||
CreationTimeProperty := TFileCreationDateTimeProperty.Create;
|
||||
LinkProperty := TFileLinkProperty.Create;
|
||||
CommentProperty := TFileCommentProperty.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TShellFileSource.GetMainIcon(out Path: String): Boolean;
|
||||
begin
|
||||
Result:= True;
|
||||
Path:= '%SystemRoot%\System32\shell32.dll,15';
|
||||
end;
|
||||
|
||||
class function TShellFileSource.RootName: String;
|
||||
var
|
||||
DrivesPIDL: PItemIDList;
|
||||
DesktopFolder: IShellFolder;
|
||||
begin
|
||||
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
|
||||
OleCheckUTF8(SHGetFolderLocation(0, CSIDL_DRIVES, 0, 0, {%H-}DrivesPIDL));
|
||||
Result:= GetDisplayName(DesktopFolder, DrivesPIDL, SHGDN_NORMAL);
|
||||
end;
|
||||
|
||||
function TShellFileSource.FindObject(const AObject: String; out
|
||||
AValue: PItemIDList): HRESULT;
|
||||
var
|
||||
APath: String;
|
||||
AFolder: IShellFolder2;
|
||||
AItemPIDL, AFolderPIDL: PItemIDList;
|
||||
begin
|
||||
APath:= ExtractFileDir(AObject);
|
||||
Result:= FindFolder(APath, AFolder);
|
||||
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
Result:= FindObject(AFolder, ExtractFileName(AObject), AItemPIDL);
|
||||
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
Result:= SHGetIDListFromObject(AFolder, AFolderPIDL);
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
AValue:= ILCombine(AFolderPIDL, AItemPIDL);
|
||||
CoTaskMemFree(AFolderPIDL);
|
||||
end;
|
||||
CoTaskMemFree(AItemPIDL);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TShellFileSource.FindObject(AParent: IShellFolder2;
|
||||
const AName: String; out AValue: PItemIDList): HRESULT;
|
||||
var
|
||||
AItemName: String;
|
||||
PIDL: PItemIDList;
|
||||
NumIDs: LongWord = 0;
|
||||
EnumIDList: IEnumIDList;
|
||||
begin
|
||||
Result:= AParent.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_STORAGE or SHCONTF_INCLUDEHIDDEN, EnumIDList);
|
||||
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
while EnumIDList.Next(1, PIDL, NumIDs) = S_OK do
|
||||
begin
|
||||
AItemName:= GetDisplayName(AParent, PIDL, SHGDN_NORMAL);
|
||||
if AName = AItemName then
|
||||
begin
|
||||
AValue:= PIDL;
|
||||
Exit(S_OK);
|
||||
end;
|
||||
CoTaskMemFree(PIDL);
|
||||
end;
|
||||
end;
|
||||
Result:= STG_E_FILENOTFOUND;
|
||||
end;
|
||||
|
||||
function TShellFileSource.FindFolder(const Path: String; out
|
||||
AValue: IShellFolder2): HRESULT;
|
||||
|
||||
function List(var AFolder: IShellFolder2; const AObject: String): HRESULT;
|
||||
var
|
||||
AName: String;
|
||||
PIDL: PItemIDList;
|
||||
NumIDs: LongWord = 0;
|
||||
AValue: IShellFolder2;
|
||||
EnumIDList: IEnumIDList;
|
||||
begin
|
||||
Result:= AFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_STORAGE or SHCONTF_INCLUDEHIDDEN, EnumIDList);
|
||||
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
while EnumIDList.Next(1, PIDL, NumIDs) = S_OK do
|
||||
try
|
||||
AName:= GetDisplayName(AFolder, PIDL, SHGDN_NORMAL);
|
||||
|
||||
if AName = AObject then
|
||||
begin
|
||||
Result:= AFolder.BindToObject(PIDL, nil, IID_IShellFolder2, Pointer(AValue));
|
||||
if Succeeded(Result) then AFolder:= AValue;
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
CoTaskMemFree(PIDL);
|
||||
end;
|
||||
end;
|
||||
Result:= STG_E_PATHNOTFOUND;
|
||||
end;
|
||||
|
||||
var
|
||||
Index: Integer;
|
||||
APath: TStringArray;
|
||||
begin
|
||||
Result:= FDesktopFolder.BindToObject(FDrives, nil, IID_IShellFolder2, Pointer(AValue));
|
||||
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
APath:= Path.Split([PathDelim], TStringSplitOptions.ExcludeEmpty);
|
||||
if Length(APath) > 0 then
|
||||
begin
|
||||
// Find subdirectory
|
||||
for Index:= 0 to High(APath) do
|
||||
begin
|
||||
Result:= List(AValue, APath[Index]);
|
||||
if Failed(Result) then Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateFolder(AParent: IShellFolder2;
|
||||
const Name: String): HRESULT;
|
||||
var
|
||||
AName: WideString;
|
||||
AParentItem: IShellItem;
|
||||
AFileOp: IFileOperation;
|
||||
AParentPIDL: PItemIDList;
|
||||
begin
|
||||
AName:= CeUtf8ToUtf16(Name);
|
||||
Result:= SHGetIDListFromObject(AParent, AParentPIDL);
|
||||
if Succeeded(Result) then
|
||||
try
|
||||
Result:= SHCreateItemFromIDList(AParentPIDL, IShellItem, AParentItem);
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
AFileOp:= CreateComObject(CLSID_FileOperation) as IFileOperation;
|
||||
Result:= AFileOp.NewItem(AParentItem, FILE_ATTRIBUTE_DIRECTORY, PWideChar(AName), nil, nil);
|
||||
if Succeeded(Result) then
|
||||
begin
|
||||
Result:= AFileOp.PerformOperations();
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
CoTaskMemFree(AParentPIDL);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateDirectory(const Path: String): Boolean;
|
||||
var
|
||||
AName: String;
|
||||
AParent: IShellFolder2;
|
||||
begin
|
||||
AName:= ExtractFileName(Path);
|
||||
Result:= Succeeded(FindFolder(ExtractFileDir(Path), AParent));
|
||||
if Result then
|
||||
begin
|
||||
Result:= Succeeded(CreateFolder(AParent, AName));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TShellFileSource.FileSystemEntryExists(const Path: String): Boolean;
|
||||
var
|
||||
AObject: PItemIDList;
|
||||
begin
|
||||
Result:= Succeeded(FindObject(Path, AObject));
|
||||
if Result then CoTaskMemFree(AObject);
|
||||
end;
|
||||
|
||||
function TShellFileSource.GetOperationsTypes: TFileSourceOperationTypes;
|
||||
begin
|
||||
Result := [fsoList, fsoExecute, fsoDelete, fsoCreateDirectory,
|
||||
fsoMove, fsoCopy, fsoCopyIn, fsoCopyOut, fsoSetFileProperty,
|
||||
fsoCalcStatistics];
|
||||
end;
|
||||
|
||||
function TShellFileSource.GetSupportedFileProperties: TFilePropertiesTypes;
|
||||
begin
|
||||
Result := inherited GetSupportedFileProperties
|
||||
+ [fpSize,
|
||||
fpAttributes,
|
||||
fpModificationTime,
|
||||
fpCreationTime,
|
||||
uFileProperty.fpLink,
|
||||
fpComment
|
||||
];
|
||||
end;
|
||||
|
||||
function TShellFileSource.GetRootDir(sPath: String): String;
|
||||
begin
|
||||
Result:= PathDelim;
|
||||
end;
|
||||
|
||||
function TShellFileSource.GetProperties: TFileSourceProperties;
|
||||
begin
|
||||
Result := [fspVirtual];
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateListOperation(TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result:= TShellListOperation.Create(TargetFileSource, TargetPath);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateDeleteOperation(var FilesToDelete: TFiles
|
||||
): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result:= TShellDeleteOperation.Create(TargetFileSource, FilesToDelete);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateCreateDirectoryOperation(BasePath: String;
|
||||
DirectoryPath: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result := TShellCreateDirectoryOperation.Create(TargetFileSource, BasePath, DirectoryPath);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateExecuteOperation(var ExecutableFile: TFile;
|
||||
BasePath, Verb: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result:= TShellExecuteOperation.Create(TargetFileSource, ExecutableFile, BasePath, Verb);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateMoveOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result := TShellMoveOperation.Create(TargetFileSource, SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateCopyOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
SourceFileSource: IFileSource;
|
||||
begin
|
||||
SourceFileSource := Self;
|
||||
Result:= TShellCopyOperation.Create(SourceFileSource, SourceFileSource, SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateCopyInOperation(SourceFileSource: IFileSource;
|
||||
var SourceFiles: TFiles; TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result:= TShellCopyInOperation.Create(SourceFileSource, TargetFileSource, SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateCopyOutOperation(TargetFileSource: IFileSource;
|
||||
var SourceFiles: TFiles; TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
SourceFileSource: IFileSource;
|
||||
begin
|
||||
SourceFileSource := Self;
|
||||
Result := TShellCopyOutOperation.Create(SourceFileSource, TargetFileSource, SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateCalcStatisticsOperation(var theFiles: TFiles
|
||||
): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result := TShellCalcStatisticsOperation.Create(TargetFileSource, theFiles);
|
||||
end;
|
||||
|
||||
function TShellFileSource.CreateSetFilePropertyOperation(
|
||||
var theTargetFiles: TFiles; var theNewProperties: TFileProperties
|
||||
): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: IFileSource;
|
||||
begin
|
||||
TargetFileSource := Self;
|
||||
Result := TShellSetFilePropertyOperation.Create(TargetFileSource, theTargetFiles, theNewProperties);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
385
src/filesources/shellfolder/ushellfilesourceutil.pas
Normal file
385
src/filesources/shellfolder/ushellfilesourceutil.pas
Normal file
|
|
@ -0,0 +1,385 @@
|
|||
unit uShellFileSourceUtil;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ActiveX, ShlObj, ComObj, ShlWAPI, ShellAPI,
|
||||
uShellFolder, uShellFileOperation, uFileSourceCopyOperation,
|
||||
uFileSourceDeleteOperation, uFileSourceSetFilePropertyOperation, uGlobs, uLog;
|
||||
|
||||
const
|
||||
SID_SYSTEM = '{B725F130-47EF-101A-A5F1-02608C9EEBAC}';
|
||||
SCID_FileSize: TSHColumnID = ( fmtid: SID_SYSTEM; pid: 12 );
|
||||
SCID_DateModified: TSHColumnID = ( fmtid: SID_SYSTEM; pid: 14 );
|
||||
SCID_DateCreated: TSHColumnID = ( fmtid: SID_SYSTEM; pid: 15 );
|
||||
|
||||
SID_COMPUTER = '{9B174B35-40FF-11D2-A27E-00C04FC30871}';
|
||||
SCID_Capacity: TSHColumnID = ( fmtid: SID_COMPUTER; pid: 3 );
|
||||
|
||||
type
|
||||
|
||||
{ TItemList }
|
||||
|
||||
TItemList = class(TFPList)
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TUpdateCopyStatisticsFunction = procedure(var NewStatistics: TFileSourceCopyOperationStatistics) of object;
|
||||
TUpdateDeleteStatisticsFunction = procedure(var NewStatistics: TFileSourceDeleteOperationStatistics) of object;
|
||||
TUpdateSetFilePropertyStatisticsFunction = procedure(var NewStatistics: TFileSourceSetFilePropertyOperationStatistics) of object;
|
||||
|
||||
{ TFileOperationProgressSink }
|
||||
|
||||
TFileOperationProgressSink = class(TInterfacedObject, IFileOperationProgressSink)
|
||||
private
|
||||
FCopyStatistics: PFileSourceCopyOperationStatistics;
|
||||
FUpdateCopyStatistics: TUpdateCopyStatisticsFunction;
|
||||
FDeleteStatistics: PFileSourceDeleteOperationStatistics;
|
||||
FUpdateDeleteStatistics: TUpdateDeleteStatisticsFunction;
|
||||
FUpdateSetFilePropertyStatistics: TUpdateSetFilePropertyStatisticsFunction;
|
||||
FSetFilePropertyStatistics: PFileSourceSetFilePropertyOperationStatistics;
|
||||
protected
|
||||
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
public
|
||||
constructor Create(AStatistics: PFileSourceCopyOperationStatistics; AUpdateStatistics: TUpdateCopyStatisticsFunction); reintroduce; overload;
|
||||
constructor Create(AStatistics: PFileSourceDeleteOperationStatistics; AUpdateStatistics: TUpdateDeleteStatisticsFunction); reintroduce; overload;
|
||||
constructor Create(AStatistics: PFileSourceSetFilePropertyOperationStatistics; AUpdateStatistics: TUpdateSetFilePropertyStatisticsFunction); reintroduce; overload;
|
||||
public
|
||||
function StartOperations: HResult; stdcall;
|
||||
function FinishOperations(hrResult: HResult): HResult; stdcall;
|
||||
function PreRenameItem(dwFlags: DWORD; psiItem: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
|
||||
function PostRenameItem(dwFlags: DWORD; psiItem: IShellItem; pszNewName: LPCWSTR; hrRename: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
function PreMoveItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
|
||||
function PostMoveItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrMove: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
function PreCopyItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
|
||||
function PostCopyItem(dwFlags: DWORD; psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; hrCopy: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
function PreDeleteItem(dwFlags: DWORD; psiItem: IShellItem): HResult; stdcall;
|
||||
function PostDeleteItem(dwFlags: DWORD; psiItem: IShellItem; hrDelete: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
function PreNewItem(dwFlags: DWORD; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
|
||||
function PostNewItem(dwFlags: DWORD; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD; hrNew: HRESULT; psiNewItem: IShellItem): HResult; stdcall;
|
||||
function UpdateProgress(iWorkTotal: UINT; iWorkSoFar: UINT): HResult; stdcall;
|
||||
function ResetTimer: HResult; stdcall;
|
||||
function PauseTimer: HResult; stdcall;
|
||||
function ResumeTimer: HResult; stdcall;
|
||||
end;
|
||||
|
||||
procedure CheckObject(Result: HResult; const AName: String); inline;
|
||||
|
||||
var
|
||||
SHCreateItemWithParent: function(pidlParent: PCIDLIST_ABSOLUTE; psfParent: IShellFolder;
|
||||
pidl: PCUITEMID_CHILD; const riid: REFIID; out ppvItem): HRESULT; stdcall;
|
||||
|
||||
SHGetIDListFromObject: function(punk: IUnknown; out ppidl): HRESULT; stdcall;
|
||||
|
||||
SHCreateItemFromIDList: function(pidl: PItemIDList; const riid: REFIID; out ppv): HRESULT; stdcall;
|
||||
|
||||
SHCreateItemFromParsingName: function(pszPath: LPCWSTR; const pbc: IBindCtx;
|
||||
const riid: TIID; out ppv): HRESULT; stdcall;
|
||||
|
||||
SHCreateShellItemArray: function(pidlParent: PCIDLIST_ABSOLUTE; psf: IShellFolder;
|
||||
cidl: UINT; ppidl: PPItemIDList; out ppsiItemArray): HRESULT; stdcall;
|
||||
|
||||
SHCreateShellItemArrayFromIDLists: function(cidl: UINT; rgpidl: PPItemIDList; out ppsiItemArray): HRESULT; stdcall;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
DCOSUtils, DCConvertEncoding, uLng;
|
||||
|
||||
var
|
||||
AModule: HMODULE;
|
||||
|
||||
procedure CheckObject(Result: HResult; const AName: String);
|
||||
begin
|
||||
if Failed(Result) then
|
||||
begin
|
||||
raise EOleError.Create(mbSysErrorMessage(Result) + LineEnding + AName);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TItemList }
|
||||
|
||||
destructor TItemList.Destroy;
|
||||
var
|
||||
AItem: PItemIDList;
|
||||
begin
|
||||
for AItem in Self do
|
||||
begin
|
||||
CoTaskMemFree(AItem);
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TFileOperationProgressSink }
|
||||
|
||||
procedure TFileOperationProgressSink.LogMessage(sMessage: String;
|
||||
logOptions: TLogOptions; logMsgType: TLogMsgType);
|
||||
begin
|
||||
case logMsgType of
|
||||
lmtError:
|
||||
if not (log_errors in gLogOptions) then Exit;
|
||||
lmtInfo:
|
||||
if not (log_info in gLogOptions) then Exit;
|
||||
lmtSuccess:
|
||||
if not (log_success in gLogOptions) then Exit;
|
||||
end;
|
||||
|
||||
if logOptions <= gLogOptions then
|
||||
begin
|
||||
logWrite(nil, sMessage, logMsgType);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFileOperationProgressSink.Create(
|
||||
AStatistics: PFileSourceCopyOperationStatistics;
|
||||
AUpdateStatistics: TUpdateCopyStatisticsFunction);
|
||||
begin
|
||||
FCopyStatistics:= AStatistics;
|
||||
FUpdateCopyStatistics:= AUpdateStatistics;
|
||||
end;
|
||||
|
||||
constructor TFileOperationProgressSink.Create(
|
||||
AStatistics: PFileSourceDeleteOperationStatistics;
|
||||
AUpdateStatistics: TUpdateDeleteStatisticsFunction);
|
||||
begin
|
||||
FDeleteStatistics:= AStatistics;
|
||||
FUpdateDeleteStatistics:= AUpdateStatistics;
|
||||
end;
|
||||
|
||||
constructor TFileOperationProgressSink.Create(
|
||||
AStatistics: PFileSourceSetFilePropertyOperationStatistics;
|
||||
AUpdateStatistics: TUpdateSetFilePropertyStatisticsFunction);
|
||||
begin
|
||||
FSetFilePropertyStatistics:= AStatistics;
|
||||
FUpdateSetFilePropertyStatistics:= AUpdateStatistics;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.StartOperations: HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.FinishOperations(hrResult: HResult
|
||||
): HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PreRenameItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
|
||||
var
|
||||
AFileName: PWideChar;
|
||||
begin
|
||||
if Succeeded(psiItem.GetDisplayName(SIGDN(SIGDN_DESKTOPABSOLUTEEDITING), @AFileName)) then
|
||||
begin
|
||||
FSetFilePropertyStatistics^.CurrentFile:= CeUtf16ToUtf8(AFileName);
|
||||
CoTaskMemFree(AFileName);
|
||||
end;
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PostRenameItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; pszNewName: LPCWSTR; hrRename: HRESULT;
|
||||
psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PreMoveItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR
|
||||
): HResult; stdcall;
|
||||
begin
|
||||
Result:= PreCopyItem(dwFlags, psiItem, psiDestinationFolder, pszNewName);
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PostMoveItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
|
||||
hrMove: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
begin
|
||||
if (log_cp_mv_ln in gLogOptions) then
|
||||
begin
|
||||
with FCopyStatistics^ do
|
||||
begin
|
||||
if Succeeded(hrMove) then
|
||||
begin
|
||||
LogMessage(Format(rsMsgLogSuccess + rsMsgLogMove, [CurrentFileFrom + ' -> ' + CurrentFileTo]),
|
||||
[log_cp_mv_ln], lmtSuccess);
|
||||
end
|
||||
else begin
|
||||
LogMessage(Format(rsMsgLogError + rsMsgLogMove, [CurrentFileFrom + ' -> ' + CurrentFileTo]),
|
||||
[log_cp_mv_ln], lmtError);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PreCopyItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR
|
||||
): HResult; stdcall;
|
||||
var
|
||||
AFileName: PWideChar;
|
||||
begin
|
||||
if Succeeded(psiItem.GetDisplayName(SIGDN(SIGDN_DESKTOPABSOLUTEEDITING), @AFileName)) then
|
||||
begin
|
||||
FCopyStatistics^.CurrentFileFrom:= CeUtf16ToUtf8(AFileName);
|
||||
CoTaskMemFree(AFileName);
|
||||
end;
|
||||
if Succeeded(psiDestinationFolder.GetDisplayName(SIGDN(SIGDN_DESKTOPABSOLUTEEDITING), @AFileName)) then
|
||||
begin
|
||||
with FCopyStatistics^ do
|
||||
begin
|
||||
CurrentFileTo:= CeUtf16ToUtf8(AFileName);
|
||||
CoTaskMemFree(AFileName);
|
||||
|
||||
if Assigned(pszNewName) and (pszNewName^ <> #0) then
|
||||
CurrentFileTo:= CurrentFileTo + CeUtf16ToUtf8(pszNewName)
|
||||
else begin
|
||||
CurrentFileTo:= CurrentFileTo + ExtractFileName(CurrentFileFrom);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FUpdateCopyStatistics(FCopyStatistics^);
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PostCopyItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
|
||||
hrCopy: HRESULT; psiNewlyCreated: IShellItem): HResult; stdcall;
|
||||
begin
|
||||
if (log_cp_mv_ln in gLogOptions) then
|
||||
begin
|
||||
with FCopyStatistics^ do
|
||||
begin
|
||||
if Succeeded(hrCopy) then
|
||||
begin
|
||||
LogMessage(Format(rsMsgLogSuccess + rsMsgLogCopy, [CurrentFileFrom + ' -> ' + CurrentFileTo]),
|
||||
[log_cp_mv_ln], lmtSuccess);
|
||||
end
|
||||
else begin
|
||||
LogMessage(Format(rsMsgLogError + rsMsgLogCopy, [CurrentFileFrom + ' -> ' + CurrentFileTo]),
|
||||
[log_cp_mv_ln], lmtError);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PreDeleteItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem): HResult; stdcall;
|
||||
var
|
||||
AFileName: PWideChar;
|
||||
begin
|
||||
if Succeeded(psiItem.GetDisplayName(SIGDN(SIGDN_DESKTOPABSOLUTEEDITING), @AFileName)) then
|
||||
begin
|
||||
FDeleteStatistics^.CurrentFile:= CeUtf16ToUtf8(AFileName);
|
||||
CoTaskMemFree(AFileName);
|
||||
end;
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PostDeleteItem(dwFlags: DWORD;
|
||||
psiItem: IShellItem; hrDelete: HRESULT; psiNewlyCreated: IShellItem
|
||||
): HResult; stdcall;
|
||||
var
|
||||
AText: String;
|
||||
sfgaoAttribs: SFGAOF = 0;
|
||||
begin
|
||||
if log_delete in gLogOptions then
|
||||
begin
|
||||
psiItem.GetAttributes(SFGAO_FOLDER, @sfgaoAttribs);
|
||||
if (sfgaoAttribs and SFGAO_FOLDER) = 0 then
|
||||
AText:= rsMsgLogDelete
|
||||
else begin
|
||||
AText:= rsMsgLogRmDir;
|
||||
end;
|
||||
with FDeleteStatistics^ do
|
||||
begin
|
||||
if Succeeded(hrDelete) then
|
||||
begin
|
||||
LogMessage(Format(rsMsgLogSuccess + AText, [CurrentFile]),
|
||||
[log_delete], lmtSuccess);
|
||||
end
|
||||
else begin
|
||||
LogMessage(Format(rsMsgLogError + AText, [CurrentFile]),
|
||||
[log_delete], lmtError);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PreNewItem(dwFlags: DWORD;
|
||||
psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PostNewItem(dwFlags: DWORD;
|
||||
psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
|
||||
pszTemplateName: LPCWSTR; dwFileAttributes: DWORD; hrNew: HRESULT;
|
||||
psiNewItem: IShellItem): HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.UpdateProgress(iWorkTotal: UINT;
|
||||
iWorkSoFar: UINT): HResult; stdcall;
|
||||
begin
|
||||
if Assigned(FCopyStatistics) then
|
||||
begin
|
||||
FCopyStatistics^.TotalBytes:= iWorkTotal;
|
||||
FCopyStatistics^.DoneBytes:= iWorkSoFar;
|
||||
|
||||
FUpdateCopyStatistics(FCopyStatistics^);
|
||||
end
|
||||
else if Assigned(FDeleteStatistics) then
|
||||
begin
|
||||
FDeleteStatistics^.TotalFiles:= iWorkTotal;
|
||||
FDeleteStatistics^.DoneFiles:= iWorkSoFar;
|
||||
|
||||
FUpdateDeleteStatistics(FDeleteStatistics^);
|
||||
end
|
||||
else if Assigned(FSetFilePropertyStatistics) then
|
||||
begin
|
||||
FSetFilePropertyStatistics^.TotalFiles:= iWorkTotal;
|
||||
FSetFilePropertyStatistics^.DoneFiles:= iWorkSoFar;
|
||||
|
||||
FUpdateSetFilePropertyStatistics(FSetFilePropertyStatistics^);
|
||||
end;
|
||||
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.ResetTimer: HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.PauseTimer: HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
function TFileOperationProgressSink.ResumeTimer: HResult; stdcall;
|
||||
begin
|
||||
Result:= S_OK;
|
||||
end;
|
||||
|
||||
initialization
|
||||
if (Win32MajorVersion > 5) then
|
||||
begin
|
||||
AModule:= GetModuleHandleW(Shell32);
|
||||
@SHGetIDListFromObject:= GetProcAddress(AModule, 'SHGetIDListFromObject');
|
||||
@SHCreateItemFromIDList:= GetProcAddress(AModule, 'SHCreateItemFromIDList');
|
||||
@SHCreateItemWithParent:= GetProcAddress(AModule, 'SHCreateItemWithParent');
|
||||
@SHCreateShellItemArray:= GetProcAddress(AModule, 'SHCreateShellItemArray');
|
||||
@SHCreateItemFromParsingName:= GetProcAddress(AModule, 'SHCreateItemFromParsingName');
|
||||
@SHCreateShellItemArrayFromIDLists:= GetProcAddress(AModule, 'SHCreateShellItemArrayFromIDLists');
|
||||
end;
|
||||
end.
|
||||
|
||||
188
src/filesources/shellfolder/ushelllistoperation.pas
Normal file
188
src/filesources/shellfolder/ushelllistoperation.pas
Normal file
|
|
@ -0,0 +1,188 @@
|
|||
unit uShellListOperation;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ShlObj, ComObj,
|
||||
uFileSourceListOperation,
|
||||
uShellFileSource,
|
||||
uFileSource;
|
||||
|
||||
type
|
||||
|
||||
{ TShellListOperation }
|
||||
|
||||
TShellListOperation = class(TFileSourceListOperation)
|
||||
private
|
||||
FShellFileSource: IShellFileSource;
|
||||
procedure ListFolder(AFolder: IShellFolder2; grfFlags: DWORD);
|
||||
procedure ListDrives;
|
||||
procedure ListDirectory;
|
||||
public
|
||||
constructor Create(aFileSource: IFileSource; aPath: String); override;
|
||||
procedure MainExecute; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
ActiveX, Variants, DCOSUtils, DCDateTimeUtils, ShellAPI,
|
||||
uFile, uShellFolder, uShlObjAdditional, uShowMsg, uShellFileSourceUtil;
|
||||
|
||||
{ TShellListOperation }
|
||||
|
||||
procedure TShellListOperation.ListFolder(AFolder: IShellFolder2; grfFlags: DWORD
|
||||
);
|
||||
var
|
||||
AFile: TFile;
|
||||
PIDL: PItemIDList;
|
||||
AValue: OleVariant;
|
||||
rgfInOut: LongWord;
|
||||
NumIDs: LongWord = 0;
|
||||
EnumIDList: IEnumIDList;
|
||||
begin
|
||||
OleCheckUTF8(AFolder.EnumObjects(0, grfFlags, EnumIDList));
|
||||
|
||||
while EnumIDList.Next(1, PIDL, NumIDs) = S_OK do
|
||||
try
|
||||
CheckOperationState;
|
||||
|
||||
aFile:= TShellFileSource.CreateFile(Path);
|
||||
|
||||
AFile.Name:= GetDisplayName(AFolder, PIDL, SHGDN_INFOLDER);
|
||||
AFile.LinkProperty.LinkTo:= GetDisplayName(AFolder, PIDL, SHGDN_FORPARSING);
|
||||
|
||||
rgfInOut:= SFGAO_HIDDEN or SFGAO_FOLDER;
|
||||
AFolder.GetAttributesOf(1, PIDL, rgfInOut);
|
||||
|
||||
if (rgfInOut and SFGAO_FOLDER <> 0) then
|
||||
begin
|
||||
AFile.Attributes:= FILE_ATTRIBUTE_DIRECTORY
|
||||
end;
|
||||
if (rgfInOut and SFGAO_HIDDEN <> 0) then
|
||||
begin
|
||||
AFile.Attributes:= AFile.Attributes or FILE_ATTRIBUTE_HIDDEN;
|
||||
end;
|
||||
|
||||
AValue:= GetDetails(AFolder, PIDL, SCID_FileSize);
|
||||
if AValue <> Unassigned then
|
||||
AFile.Size:= AValue
|
||||
else if AFile.IsDirectory then
|
||||
AFile.Size:= 0
|
||||
else begin
|
||||
AFile.SizeProperty.IsValid:= False;
|
||||
end;
|
||||
|
||||
AValue:= GetDetails(AFolder, PIDL, SCID_DateModified);
|
||||
if AValue <> Unassigned then
|
||||
AFile.ModificationTime:= AValue
|
||||
else begin
|
||||
AFile.ModificationTimeProperty.IsValid:= False;
|
||||
end;
|
||||
|
||||
AValue:= GetDetails(AFolder, PIDL, SCID_DateCreated);
|
||||
if AValue <> Unassigned then
|
||||
AFile.CreationTime:= AValue
|
||||
else begin
|
||||
AFile.CreationTimeProperty.IsValid:= False;
|
||||
end;
|
||||
|
||||
FFiles.Add(AFile);
|
||||
finally
|
||||
CoTaskMemFree(PIDL);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellListOperation.ListDrives;
|
||||
var
|
||||
AFile: TFile;
|
||||
PIDL: PItemIDList;
|
||||
rgfInOut: LongWord;
|
||||
AValue: OleVariant;
|
||||
NumIDs: LongWord = 0;
|
||||
AFolder: IShellFolder2;
|
||||
EnumIDList: IEnumIDList;
|
||||
DrivesPIDL: PItemIDList;
|
||||
DesktopFolder: IShellFolder;
|
||||
begin
|
||||
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
|
||||
OleCheckUTF8(SHGetFolderLocation(0, CSIDL_DRIVES, 0, 0, {%H-}DrivesPIDL));
|
||||
OleCheckUTF8(DesktopFolder.BindToObject(DrivesPIDL, nil, IID_IShellFolder2, Pointer(AFolder)));
|
||||
|
||||
OleCheckUTF8(AFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_STORAGE, EnumIDList));
|
||||
|
||||
while EnumIDList.Next(1, PIDL, NumIDs) = S_OK do
|
||||
try
|
||||
CheckOperationState;
|
||||
|
||||
aFile:= TShellFileSource.CreateFile(Path);
|
||||
|
||||
AFile.Name:= GetDisplayName(AFolder, PIDL, SHGDN_INFOLDER);
|
||||
AFile.LinkProperty.LinkTo:= GetDisplayName(AFolder, PIDL, SHGDN_FORPARSING);
|
||||
|
||||
AFile.ModificationTimeProperty.IsValid:= False;
|
||||
|
||||
AValue:= GetDetails(AFolder, PIDL, SCID_Capacity);
|
||||
if not (TVarData(AValue).vtype in [varEmpty, varNull]) then
|
||||
AFile.Size:= AValue
|
||||
else if AFile.IsDirectory then
|
||||
AFile.Size:= 0
|
||||
else begin
|
||||
AFile.SizeProperty.IsValid:= False;
|
||||
end;
|
||||
|
||||
rgfInOut:= SFGAO_FILESYSTEM or SFGAO_FOLDER;
|
||||
AFolder.GetAttributesOf(1, PIDL, rgfInOut);
|
||||
|
||||
if (SFGAO_FILESYSTEM and rgfInOut) <> 0 then
|
||||
begin
|
||||
AFile.Attributes:= FILE_ATTRIBUTE_VIRTUAL or FILE_ATTRIBUTE_REPARSE_POINT;
|
||||
end
|
||||
else if (rgfInOut and SFGAO_FOLDER <> 0) then
|
||||
begin
|
||||
AFile.Attributes:= FILE_ATTRIBUTE_DIRECTORY
|
||||
end;
|
||||
|
||||
FFiles.Add(AFile);
|
||||
finally
|
||||
CoTaskMemFree(PIDL);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellListOperation.ListDirectory;
|
||||
var
|
||||
AFolder: IShellFolder2;
|
||||
begin
|
||||
if Succeeded(FShellFileSource.FindFolder(ExcludeTrailingBackslash(Path), AFolder)) then
|
||||
begin
|
||||
ListFolder(AFolder, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TShellListOperation.Create(aFileSource: IFileSource;
|
||||
aPath: String);
|
||||
begin
|
||||
FFiles := TFiles.Create(aPath);
|
||||
FShellFileSource:= aFileSource as IShellFileSource;
|
||||
inherited Create(aFileSource, aPath);
|
||||
end;
|
||||
|
||||
procedure TShellListOperation.MainExecute;
|
||||
begin
|
||||
FFiles.Clear;
|
||||
try
|
||||
if Path = PathDelim then
|
||||
ListDrives
|
||||
else begin
|
||||
ListDirectory;
|
||||
end;
|
||||
except
|
||||
on E: Exception do msgError(Thread, E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
138
src/filesources/shellfolder/ushellmoveoperation.pas
Normal file
138
src/filesources/shellfolder/ushellmoveoperation.pas
Normal file
|
|
@ -0,0 +1,138 @@
|
|||
unit uShellMoveOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ShlObj, ComObj, ActiveX,
|
||||
uFileSourceOperation,
|
||||
uFileSourceMoveOperation,
|
||||
uFileSource,
|
||||
uFile,
|
||||
uShellFileSource,
|
||||
uShellFileOperation,
|
||||
uShellFileSourceUtil;
|
||||
|
||||
type
|
||||
|
||||
{ TShellMoveOperation }
|
||||
|
||||
TShellMoveOperation = class(TFileSourceMoveOperation)
|
||||
|
||||
protected
|
||||
FFileOp: IFileOperation;
|
||||
FTargetFolder: IShellItem;
|
||||
FSourceFilesTree: TItemList;
|
||||
FShellFileSource: IShellFileSource;
|
||||
FStatistics: TFileSourceMoveOperationStatistics;
|
||||
|
||||
procedure ShowError(const sMessage: String);
|
||||
public
|
||||
constructor Create(aFileSource: IFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String); virtual reintroduce;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
procedure Finalize; override;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uFileSourceOperationOptions, uFileSourceOperationUI, uShellFolder, uGlobs,
|
||||
uLog, uLng;
|
||||
|
||||
procedure TShellMoveOperation.ShowError(const sMessage: String);
|
||||
begin
|
||||
if (log_errors in gLogOptions) then
|
||||
begin
|
||||
logWrite(Thread, sMessage, lmtError);
|
||||
end;
|
||||
|
||||
if AskQuestion(sMessage, '', [fsourSkip, fsourAbort],
|
||||
fsourSkip, fsourAbort) = fsourAbort then
|
||||
begin
|
||||
RaiseAbortOperation;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TShellMoveOperation.Create(aFileSource: IFileSource;
|
||||
var theSourceFiles: TFiles; aTargetPath: String);
|
||||
begin
|
||||
FShellFileSource:= aFileSource as IShellFileSource;
|
||||
FFileOp:= CreateComObject(CLSID_FileOperation) as IFileOperation;
|
||||
inherited Create(aFileSource, theSourceFiles, aTargetPath);
|
||||
end;
|
||||
|
||||
destructor TShellMoveOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FSourceFilesTree);
|
||||
end;
|
||||
|
||||
procedure TShellMoveOperation.Initialize;
|
||||
var
|
||||
aFile: TFile;
|
||||
Index: Integer;
|
||||
AObject: PItemIDList;
|
||||
AFolder: IShellFolder2;
|
||||
begin
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
FSourceFilesTree:= TItemList.Create;
|
||||
try
|
||||
for Index := 0 to SourceFiles.Count - 1 do
|
||||
begin
|
||||
aFile := SourceFiles[Index];
|
||||
CheckObject(FShellFileSource.FindObject(aFile.FullPath, AObject), aFile.FullPath);
|
||||
FSourceFilesTree.Add(AObject);
|
||||
end;
|
||||
CheckObject(FShellFileSource.FindFolder(TargetPath, AFolder), TargetPath);
|
||||
OleCheck(SHGetIDListFromObject(AFolder, AObject));
|
||||
try
|
||||
OleCheck(SHCreateItemFromIDList(AObject, IShellItem, FTargetFolder));
|
||||
finally
|
||||
CoTaskMemFree(AObject);
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellMoveOperation.MainExecute;
|
||||
var
|
||||
dwCookie: DWORD;
|
||||
siItemArray: IShellItemArray;
|
||||
ASink: TFileOperationProgressSink;
|
||||
begin
|
||||
ASink:= TFileOperationProgressSink.Create(@FStatistics, @UpdateStatistics);
|
||||
|
||||
FFileOp.SetOperationFlags(FOF_SILENT or FOF_NOCONFIRMMKDIR);
|
||||
|
||||
try
|
||||
FFileOp.Advise(ASink, @dwCookie);
|
||||
try
|
||||
OleCheck(SHCreateShellItemArrayFromIDLists(FSourceFilesTree.Count, PPItemIDList(FSourceFilesTree.List), siItemArray));
|
||||
OleCheck(FFileOp.MoveItems(siItemArray, FTargetFolder));
|
||||
OleCheck(FFileOp.PerformOperations);
|
||||
finally
|
||||
FFileOp.Unadvise(dwCookie);
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellMoveOperation.Finalize;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
176
src/filesources/shellfolder/ushellsetfilepropertyoperation.pas
Normal file
176
src/filesources/shellfolder/ushellsetfilepropertyoperation.pas
Normal file
|
|
@ -0,0 +1,176 @@
|
|||
unit uShellSetFilePropertyOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceSetFilePropertyOperation,
|
||||
uFileSource,
|
||||
uFile,
|
||||
uFileProperty,
|
||||
uShellFileSource,
|
||||
uShellFileOperation,
|
||||
uShellFileSourceUtil;
|
||||
|
||||
type
|
||||
|
||||
{ TShellSetFilePropertyOperation }
|
||||
|
||||
TShellSetFilePropertyOperation = class(TFileSourceSetFilePropertyOperation)
|
||||
|
||||
private
|
||||
FFileOp: IFileOperation;
|
||||
FCurrentFileIndex: Integer;
|
||||
FSourceFilesTree: TItemList;
|
||||
FShellFileSource: IShellFileSource;
|
||||
FStatistics: TFileSourceSetFilePropertyOperationStatistics;
|
||||
|
||||
procedure ShowError(const sMessage: String);
|
||||
protected
|
||||
function SetNewProperty(aFile: TFile; aTemplateProperty: TFileProperty): TSetFilePropertyResult; override;
|
||||
|
||||
public
|
||||
constructor Create(aTargetFileSource: IFileSource;
|
||||
var theTargetFiles: TFiles;
|
||||
var theNewProperties: TFileProperties); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Windows, ActiveX, ShlObj, ComObj, DCConvertEncoding,
|
||||
uFileSourceOperationUI, uShellFolder, uGlobs, uLog, uLng;
|
||||
|
||||
procedure TShellSetFilePropertyOperation.ShowError(const sMessage: String);
|
||||
begin
|
||||
if (log_errors in gLogOptions) then
|
||||
begin
|
||||
logWrite(Thread, sMessage, lmtError);
|
||||
end;
|
||||
|
||||
if AskQuestion(sMessage, '', [fsourSkip, fsourAbort],
|
||||
fsourSkip, fsourAbort) = fsourAbort then
|
||||
begin
|
||||
RaiseAbortOperation;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TShellSetFilePropertyOperation.Create(aTargetFileSource: IFileSource;
|
||||
var theTargetFiles: TFiles;
|
||||
var theNewProperties: TFileProperties);
|
||||
begin
|
||||
FShellFileSource:= aTargetFileSource as IShellFileSource;
|
||||
FFileOp:= CreateComObject(CLSID_FileOperation) as IFileOperation;
|
||||
|
||||
inherited Create(aTargetFileSource, theTargetFiles, theNewProperties);
|
||||
|
||||
// Assign after calling inherited constructor.
|
||||
FSupportedProperties := [fpName];
|
||||
end;
|
||||
|
||||
destructor TShellSetFilePropertyOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FSourceFilesTree);
|
||||
end;
|
||||
|
||||
procedure TShellSetFilePropertyOperation.Initialize;
|
||||
var
|
||||
aFile: TFile;
|
||||
Index: Integer;
|
||||
AObject: PItemIDList;
|
||||
begin
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
FSourceFilesTree:= TItemList.Create;
|
||||
try
|
||||
for Index := 0 to TargetFiles.Count - 1 do
|
||||
begin
|
||||
aFile := TargetFiles[Index];
|
||||
CheckObject(FShellFileSource.FindObject(aFile.FullPath, AObject), aFile.FullPath);
|
||||
FSourceFilesTree.Add(AObject);
|
||||
end;
|
||||
except
|
||||
on E: Exception do ShowError(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TShellSetFilePropertyOperation.MainExecute;
|
||||
var
|
||||
aFile: TFile;
|
||||
dwCookie: DWORD;
|
||||
aTemplateFile: TFile;
|
||||
CurrentFileIndex: Integer;
|
||||
ASink: TFileOperationProgressSink;
|
||||
begin
|
||||
ASink:= TFileOperationProgressSink.Create(@FStatistics, @UpdateStatistics);
|
||||
|
||||
FFileOp.SetOperationFlags(FOF_SILENT or FOF_NOCONFIRMMKDIR);
|
||||
|
||||
FFileOp.Advise(ASink, @dwCookie);
|
||||
|
||||
for CurrentFileIndex := 0 to FSourceFilesTree.Count - 1 do
|
||||
begin
|
||||
FCurrentFileIndex:= CurrentFileIndex;
|
||||
AFile:= TargetFiles[FCurrentFileIndex];
|
||||
|
||||
if Assigned(TemplateFiles) and (FCurrentFileIndex < TemplateFiles.Count) then
|
||||
aTemplateFile := TemplateFiles[FCurrentFileIndex]
|
||||
else
|
||||
aTemplateFile := nil;
|
||||
|
||||
SetProperties(FCurrentFileIndex, aFile, aTemplateFile);
|
||||
|
||||
with FStatistics do
|
||||
begin
|
||||
DoneFiles := DoneFiles + 1;
|
||||
UpdateStatistics(FStatistics);
|
||||
end;
|
||||
|
||||
CheckOperationState;
|
||||
end;
|
||||
|
||||
FFileOp.Unadvise(dwCookie);
|
||||
end;
|
||||
|
||||
function TShellSetFilePropertyOperation.SetNewProperty(aFile: TFile;
|
||||
aTemplateProperty: TFileProperty): TSetFilePropertyResult;
|
||||
var
|
||||
PIDL: PItemIDList;
|
||||
AItem: IShellItem;
|
||||
begin
|
||||
Result := sfprSuccess;
|
||||
|
||||
PIDL:= PItemIDList(FSourceFilesTree[FCurrentFileIndex]);
|
||||
|
||||
if Failed(SHCreateItemFromIDList(PIDL, IShellItem, AItem)) then
|
||||
Exit(sfprError);
|
||||
|
||||
case aTemplateProperty.GetID of
|
||||
fpName:
|
||||
begin
|
||||
if (aTemplateProperty as TFileNameProperty).Value <> aFile.Name then
|
||||
begin
|
||||
if not Succeeded(FFileOp.RenameItem(AItem, PWideChar(CeUtf8ToUtf16((aTemplateProperty as TFileNameProperty).Value)), nil)) then
|
||||
Result := sfprError
|
||||
else if not Succeeded(FFileOp.PerformOperations()) then
|
||||
Result := sfprError
|
||||
end
|
||||
else
|
||||
Result := sfprSkipped;
|
||||
end
|
||||
else
|
||||
raise Exception.Create('Trying to set unsupported property');
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -13,6 +13,7 @@ uses
|
|||
|
||||
type
|
||||
|
||||
PFileSourceDeleteOperationStatistics = ^TFileSourceDeleteOperationStatistics;
|
||||
TFileSourceDeleteOperationStatistics = record
|
||||
CurrentFile: String;
|
||||
TotalFiles: Int64;
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@ type
|
|||
TSetFilePropertyResultFunction = procedure(Index: Integer; aFile: TFile;
|
||||
aTemplate: TFileProperty; Result: TSetFilePropertyResult) of object;
|
||||
|
||||
PFileSourceSetFilePropertyOperationStatistics = ^TFileSourceSetFilePropertyOperationStatistics;
|
||||
TFileSourceSetFilePropertyOperationStatistics = record
|
||||
CurrentFile: String;
|
||||
TotalFiles: Int64;
|
||||
|
|
|
|||
|
|
@ -134,6 +134,7 @@ uses
|
|||
, uDCReadRSVG, uFileSourceUtil, uGdiPlusJPEG, uListGetPreviewBitmap
|
||||
, Dialogs, Clipbrd, uDebug, JwaDbt, uThumbnailProvider, uShellFolder
|
||||
, uRecycleBinFileSource, uWslFileSource, uDCReadHEIF, uDCReadWIC
|
||||
, uShellFileSource
|
||||
{$IF DEFINED(DARKWIN)}
|
||||
, uDarkStyle
|
||||
{$ELSEIF DEFINED(LCLQT5)}
|
||||
|
|
@ -586,6 +587,11 @@ begin
|
|||
end;
|
||||
// Register network file source
|
||||
RegisterVirtualFileSource(rsVfsNetwork, TWinNetFileSource);
|
||||
// Register shell folder file source
|
||||
if (Win32MajorVersion > 5) then
|
||||
begin
|
||||
RegisterVirtualFileSource(TShellFileSource.RootName, TShellFileSource);
|
||||
end;
|
||||
// Register recycle bin file source
|
||||
if CheckWin32Version(5, 1) then
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -45,7 +45,9 @@ uses
|
|||
Classes, SysUtils, Graphics, syncobjs, uFileSorting, DCStringHashListUtf8,
|
||||
uFile, uIconTheme, uDrive, uDisplayFile, uGlobs, uDCReadPSD, uOSUtils,
|
||||
uVectorImage
|
||||
{$IF DEFINED(MSWINDOWS) and DEFINED(LCLQT5)}
|
||||
{$IF DEFINED(MSWINDOWS)}
|
||||
, ShlObj
|
||||
{$ELSEIF DEFINED(MSWINDOWS) and DEFINED(LCLQT5)}
|
||||
, fgl
|
||||
{$ELSEIF DEFINED(UNIX)}
|
||||
, DCFileAttributes
|
||||
|
|
@ -122,6 +124,7 @@ type
|
|||
FiEmblemOnline: PtrInt;
|
||||
FiEmblemOffline: PtrInt;
|
||||
FOneDrivePath: String;
|
||||
FDesktopFolder: IShellFolder;
|
||||
{$ELSEIF DEFINED(DARWIN)}
|
||||
FUseSystemTheme: Boolean;
|
||||
{$ELSEIF DEFINED(UNIX) AND NOT DEFINED(HAIKU)}
|
||||
|
|
@ -188,6 +191,7 @@ type
|
|||
{$ENDIF}
|
||||
|
||||
{$IF DEFINED(WINDOWS)}
|
||||
function GetShellFolderIcon(AFile: TFile): PtrInt;
|
||||
{en
|
||||
Checks if the AIconName points to an icon resource in a library, executable, etc.
|
||||
@param(AIconName
|
||||
|
|
@ -357,7 +361,7 @@ uses
|
|||
, uPixMapGtk, gdk2pixbuf, gdk2, glib2
|
||||
{$ENDIF}
|
||||
{$IFDEF MSWINDOWS}
|
||||
, CommCtrl, ShellAPI, Windows, DCFileAttributes, uBitmap, uGdiPlus,
|
||||
, ActiveX, CommCtrl, ShellAPI, Windows, DCFileAttributes, uBitmap, uGdiPlus,
|
||||
IntfGraphics, DCConvertEncoding, uShlObjAdditional, uShellFolder
|
||||
{$ELSE}
|
||||
, StrUtils, Types, DCBasicTypes
|
||||
|
|
@ -370,6 +374,11 @@ uses
|
|||
{$ENDIF}
|
||||
;
|
||||
|
||||
{$IF DEFINED(MSWINDOWS)}
|
||||
type
|
||||
TBitmap = Graphics.TBitmap;
|
||||
{$ENDIF}
|
||||
|
||||
{$IF DEFINED(MSWINDOWS) OR DEFINED(RabbitVCS)}
|
||||
const
|
||||
SystemIconIndexStart: PtrInt = High(PtrInt) div 2;
|
||||
|
|
@ -1330,6 +1339,46 @@ end;
|
|||
{$ENDIF}
|
||||
|
||||
{$IFDEF WINDOWS}
|
||||
function TPixMapManager.GetShellFolderIcon(AFile: TFile): PtrInt;
|
||||
const
|
||||
uFlags: UINT = SHGFI_SYSICONINDEX or SHGFI_PIDL;
|
||||
var
|
||||
PIDL: PItemIDList;
|
||||
pchEaten: ULONG = 0;
|
||||
AName: UnicodeString;
|
||||
FileInfo: TSHFileInfoW;
|
||||
dwAttributes: ULONG = 0;
|
||||
begin
|
||||
AName:= CeUtf8ToUtf16(AFile.LinkProperty.LinkTo);
|
||||
|
||||
if Succeeded(FDesktopFolder.ParseDisplayName(0, nil, PWideChar(AName),
|
||||
pchEaten, PIDL, dwAttributes)) then
|
||||
try
|
||||
if (SHGetFileInfoW(PWideChar(PIDL), 0, {%H-}FileInfo,
|
||||
SizeOf(FileInfo), uFlags) <> 0) then
|
||||
begin
|
||||
Result := FileInfo.iIcon + SystemIconIndexStart;
|
||||
{$IF DEFINED(LCLQT5)}
|
||||
FPixmapsLock.Acquire;
|
||||
try
|
||||
Result := CheckAddSystemIcon(Result);
|
||||
finally
|
||||
FPixmapsLock.Release;
|
||||
end;
|
||||
{$ENDIF}
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
CoTaskMemFree(PIDL);
|
||||
end;
|
||||
// Could not retrieve the icon
|
||||
if AFile.IsDirectory then
|
||||
Result := FiDirIconID
|
||||
else begin
|
||||
Result := FiDefaultIconID;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPixMapManager.GetIconResourceIndex(const IconPath: String; out IconFile: String; out IconIndex: PtrInt): Boolean;
|
||||
var
|
||||
iPos, iIndex: Integer;
|
||||
|
|
@ -1441,6 +1490,7 @@ begin
|
|||
iIconSize := SHIL_EXTRALARGE;
|
||||
end;
|
||||
|
||||
SHGetDesktopFolder(FDesktopFolder);
|
||||
FSysImgList := SHGetSystemImageList(iIconSize);
|
||||
{$ENDIF}
|
||||
|
||||
|
|
@ -1971,7 +2021,18 @@ begin
|
|||
if Result < 0 then Result := FiDirIconID;
|
||||
end;
|
||||
Exit;
|
||||
end
|
||||
{$IF DEFINED(MSWINDOWS)}
|
||||
else if (AFile.Attributes = (FILE_ATTRIBUTE_REPARSE_POINT or FILE_ATTRIBUTE_VIRTUAL)) and Assigned(AFile.LinkProperty) then
|
||||
begin
|
||||
if not LoadIcon then
|
||||
Result := -1
|
||||
else begin
|
||||
Result:= GetShellFolderIcon(AFile);
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
if IsDirectory or IsLinkToDirectory then
|
||||
|
|
|
|||
80
src/platform/win/ushellfileoperation.pas
Normal file
80
src/platform/win/ushellfileoperation.pas
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
unit uShellFileOperation;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Windows, ActiveX, ShlObj, ComObj, ShlWAPI, ShellAPI,
|
||||
uShellFolder;
|
||||
|
||||
const
|
||||
CLSID_FileOperation: TGUID = '{3ad05575-8857-4850-9277-11b85bdb8e09}';
|
||||
|
||||
type
|
||||
|
||||
IOperationsProgressDialog = IUnknown;
|
||||
|
||||
{ IObjectWithPropertyKey }
|
||||
|
||||
IObjectWithPropertyKey = interface(IUnknown)
|
||||
['{fc0ca0a7-c316-4fd2-9031-3e628e6d4f23}']
|
||||
function SetPropertyKey(key: REFPROPERTYKEY): HRESULT; stdcall;
|
||||
function GetPropertyKey(var pkey: PROPERTYKEY): HRESULT; stdcall;
|
||||
end;
|
||||
|
||||
{ IPropertyChange }
|
||||
|
||||
IPropertyChange = interface(IObjectWithPropertyKey)
|
||||
['{f917bc8a-1bba-4478-a245-1bde03eb9431}']
|
||||
function ApplyToPropVariant(propvarIn: REFPROPVARIANT; ppropvarOut: PPROPVARIANT): HRESULT; stdcall;
|
||||
end;
|
||||
|
||||
{ IPropertyChangeArray }
|
||||
|
||||
IPropertyChangeArray = interface(IUnknown)
|
||||
['{380f5cad-1b5e-42f2-805d-637fd392d31e}']
|
||||
function GetCount(pcOperations: PUINT): HRESULT; stdcall;
|
||||
function GetAt(iIndex: UINT; const riid: REFIID; out ppv): HRESULT; stdcall;
|
||||
function InsertAt(iIndex: UINT; ppropChange: IPropertyChange): HRESULT; stdcall;
|
||||
function Append(ppropChange: IPropertyChange): HRESULT; stdcall;
|
||||
function AppendOrReplace(ppropChange: IPropertyChange): HRESULT; stdcall;
|
||||
function RemoveAt(iIndex: UINT): HRESULT; stdcall;
|
||||
function IsKeyInArray(key: REFPROPERTYKEY): HRESULT; stdcall;
|
||||
end;
|
||||
|
||||
{ IFileOperation }
|
||||
|
||||
IFileOperation = interface(IUnknown)
|
||||
['{947aab5f-0a5c-4c13-b4d6-4bf7836fc9f8}']
|
||||
function Advise(pfops: IFileOperationProgressSink; pdwCookie: PDWORD): HRESULT; stdcall;
|
||||
function Unadvise(dwCookie: DWORD): HRESULT; stdcall;
|
||||
function SetOperationFlags(dwOperationFlags: DWORD): HRESULT; stdcall;
|
||||
function SetProgressMessage(pszMessage: LPCWSTR): HRESULT; stdcall;
|
||||
function SetProgressDialog(popd: IOperationsProgressDialog): HRESULT; stdcall;
|
||||
function SetProperties(pproparray: IPropertyChangeArray): HRESULT; stdcall;
|
||||
function SetOwnerWindow(hwndOwner: HWND): HRESULT; stdcall;
|
||||
function ApplyPropertiesToItem(psiItem: IShellItem): HRESULT; stdcall;
|
||||
function ApplyPropertiesToItems(punkItems: IUnknown): HRESULT; stdcall;
|
||||
function RenameItem(psiItem: IShellItem; pszNewName: LPCWSTR;
|
||||
pfopsItem: IFileOperationProgressSink): HRESULT; stdcall;
|
||||
function RenameItems(pUnkItems: IUnknown; pszNewName: LPCWSTR): HRESULT; stdcall;
|
||||
function MoveItem(psiItem: IShellItem; psiDestinationFolder: IShellItem;
|
||||
pszNewName: LPCWSTR; pfopsItem: IFileOperationProgressSink): HRESULT; stdcall;
|
||||
function MoveItems(punkItems: IUnknown; psiDestinationFolder: IShellItem): HRESULT; stdcall;
|
||||
function CopyItem(psiItem: IShellItem; psiDestinationFolder: IShellItem;
|
||||
pszCopyName: LPCWSTR; pfopsItem: IFileOperationProgressSink): HRESULT; stdcall;
|
||||
function CopyItems(punkItems: IUnknown; psiDestinationFolder: IShellItem): HRESULT; stdcall;
|
||||
function DeleteItem(psiItem: IShellItem; pfopsItem: IFileOperationProgressSink): HRESULT; stdcall;
|
||||
function DeleteItems(punkItems: IUnknown): HRESULT; stdcall;
|
||||
function NewItem(psiDestinationFolder: IShellItem; dwFileAttributes: DWORD;
|
||||
pszName: LPCWSTR; pszTemplateName: LPCWSTR; pfopsItem: IFileOperationProgressSink): HRESULT; stdcall;
|
||||
function PerformOperations(): HRESULT; stdcall;
|
||||
function GetAnyOperationsAborted(pfAnyOperationsAborted: PBOOL): HRESULT; stdcall;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -98,6 +98,7 @@ function GetKnownFolderPath(const rfid: TGUID; out APath: String): Boolean;
|
|||
|
||||
function MultiFileProperties(pdtobj: IDataObject; dwFlags: DWORD): HRESULT;
|
||||
|
||||
function GetIsFolder(AParent: IShellFolder; PIDL: PItemIDList): Boolean;
|
||||
function GetDisplayName(AFolder: IShellFolder; PIDL: PItemIDList; Flags: DWORD): String;
|
||||
function GetDetails(AFolder: IShellFolder2; PIDL: PItemIDList; const pscid: SHCOLUMNID): OleVariant;
|
||||
|
||||
|
|
@ -131,6 +132,15 @@ begin
|
|||
Result:= SHMultiFileProperties(pdtobj, dwFlags);
|
||||
end;
|
||||
|
||||
function GetIsFolder(AParent: IShellFolder; PIDL: PItemIDList): Boolean;
|
||||
var
|
||||
Flags: LongWord;
|
||||
begin
|
||||
Flags:= SFGAO_FOLDER;
|
||||
AParent.GetAttributesOf(1, PIDL, Flags);
|
||||
Result:= (SFGAO_FOLDER and Flags) <> 0;
|
||||
end;
|
||||
|
||||
function GetDisplayName(AFolder: IShellFolder; PIDL: PItemIDList;
|
||||
Flags: DWORD): String;
|
||||
var
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue