Änderungsdatum mit IFileOperation SetProperties

[eholzer]

Ich versuche gerade mit Hilfe von IFileOperation das Änderungsdatum einer Datei zu ändern.
Leider bekomme ich immer nur eine Meldung "Dateizugriff wurde verweigert" (Delphi 10.2 und Windows 10).
Hier ist mein Versuch

Code:

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.

Vielleich hat jemand eine Idee was in dem Beispiel falsch ist?

Danke,
Eric

[Assarbad]

An exakt welcher Stelle stellt sich denn der besagte Fehler ein? Ich sehe da viele Bedingungen im Code, aber der Fehler könnte ja bei jedem einzelnen Schritt auftreten.

Im Grunde solltest du einen Zähler o.ä. benutzen um festzustellen bis zu welchem "Succeeded()" du kommst.