Einzelnen Beitrag anzeigen

eholzer

Registriert seit: 22. Okt 2009
51 Beiträge
 
#1

Änderungsdatum mit IFileOperation SetProperties

  Alt 17. Nov 2018, 21:58
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
  Mit Zitat antworten Zitat