unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages,
Winapi.Propsys,
Winapi.ActiveX,
Winapi.ShlObj,
Winapi.Propkey,
System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
DateUtils;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function DateTimeToFileTime(FileTime: TDateTime): TFileTime;
var
LocalFileTime, Ft: TFileTime;
SystemTime: TSystemTime;
begin
Result.dwLowDateTime := 0;
Result.dwHighDateTime := 0;
DateTimeToSystemTime(FileTime, SystemTime);
SystemTimeToFileTime(SystemTime, LocalFileTime);
LocalFileTimeToFileTime(LocalFileTime, Ft);
Result := Ft;
end;
function ShellItemGetPropertyChangeArray(var propertyChangeArray: IPropertyChangeArray ): HRESULT;
var
shResult: HRESULT;
rgpropkey:
WinApi.ActiveX.PROPERTYKEY;
rgflags: TPKAFlags;
rgpropvar: TPropVariant;
begin
propertyChangeArray := nil;
result := PSCreatePropertyChangeArray(rgpropkey, rgflags,
rgpropvar, 0, IID_IPropertyChangeArray, Pointer(propertyChangeArray));
end;
function ShellItemSetTimestamp(const hWnd:HWND; const filePath: string;
lastWriteDT : TDateTime; var operationErrorMsg: string): boolean;
var fileOperation: IFileOperation;
psiShellItem:
Winapi.ShlObj.IShellItem;
shResult: HRESULT;
operationAborted: LongBool;
rgpropkey:
WinApi.ActiveX.PROPERTYKEY;
rgflags: TPKAFlags;
rgpropvar: TPropVariant;
propertyChange: IPropertyChange;
propertyChangesArray: IPropertyChangeArray;
fileTime: TFileTime;
flags: dword;
n: cardinal;
i: integer;
begin
operationErrorMsg := '';
shResult := CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE);
if Succeeded(shResult) then
try
shResult := CoCreateInstance(CLSID_FileOperation, nil, CLSCTX_ALL, IID_IFileOperation, fileOperation);
if Succeeded(shResult) then
try
shResult := fileOperation.SetOwnerWindow(hWnd);
if Succeeded(shResult) then begin
flags := FOFX_REQUIREELEVATION or $00040000; //FOFX_SHOWELEVATIONPROMPT (0x00040000)
shResult := fileOperation.SetOperationFlags(flags);
if Succeeded(shResult) then begin
shResult := SHCreateItemFromParsingName(PWideChar(filePath), nil, IID_IShellItem, psiShellItem);
if Succeeded(shResult) then begin
rgpropkey := PKEY_DateModified ;
rgflags := PKA_SET;
fileTime := DateTimeToFileTime(lastWriteDT );
shResult := InitPropVariantFromFileTime( @fileTime, rgpropvar);
if Succeeded(shResult) then begin
shResult := ShellItemGetPropertyChangeArray(propertyChangesArray);
if Succeeded(shResult) then begin
propertyChangesArray.GetCount(n);
for i := 0 to n-1 do
propertyChangesArray.RemoveAt(i);
shResult := PSCreateSimplePropertyChange(rgflags, rgpropkey,
rgpropvar, IID_IPropertyChange, Pointer(propertyChange));
if Succeeded(shResult) then begin
shResult := propertyChangesArray.Append( propertyChange);
if Succeeded(shResult) then begin
shResult := fileOperation.SetProperties(propertyChangesArray);
if Succeeded(shResult) then begin
shResult := fileOperation.ApplyPropertiesToItem(psiShellItem);
if Succeeded(shResult) then begin
shResult := fileOperation.PerformOperations;
if Succeeded(shResult) then begin
shResult := fileOperation.GetAnyOperationsAborted(operationAborted);
if Succeeded(shResult) then begin
if operationAborted then
shResult := 1
else
exit (true);
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
finally
psiShellItem := nil;
fileOperation := nil;
end;
finally
CoUninitialize;
end;
operationErrorMsg := 'Error: 0x'+ IntToHex(shResult, 8) + #13#10+ SysErrorMessage(shResult);
result := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
var errorMsg: string;
begin
if ShellItemSetTimestamp(self.WindowHandle, Edit1.Text,
EncodeDateTime(2018, 01, 01, 11, 11, 11, 0), errorMsg ) then
ShowMessage('Success!')
else
ShowMessage('Operation failed' + #13#10 + errorMsg);
end;
end.