[fpc-pascal] SetFileTime

[José Mejuto]

El 03/05/2023 a las 8:48, Carsten Bager via fpc-pascal escribió:
 > I am trying to change the file date on a SYMLINK (not the file that  the
 > link points to).
 > Does anyone know if there is a method for this under Windows.
 > Carsten


Hello,

Attached is a dirty implementation of "touch" for junctions that I need 
in the past. I think it can help you to do the same over other kind of 
links.

Have a nice day.
-------------- next part --------------
program touchjunction;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, windows, CustApp
  { you can add units after this };

const
   FILE_FLAG_OPEN_REPARSE_POINT=DWORD($00200000);
   FileTimeBase      = -109205.0;
   FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day

type

  { TTouchJunction }

  TTouchJunction = class(TCustomApplication)
  protected
    procedure DoRun; override;
    function DateTimeToFileTime(DateTime: TDateTime): TFileTime;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

{ TTouchJunction }

function TTouchJunction.DateTimeToFileTime(DateTime: TDateTime): TFileTime;
var sysTime: TSYSTEMTIME;
    temp: TFILETIME;
begin
  DateTimeToSystemTime(DateTime,sysTime);
  SystemTimeToFileTime(@sysTime, at temp);
  LocalFileTimeToFileTime(@temp, at result);
end;
procedure TTouchJunction.DoRun;
var
  ErrorMsg: String;
  TheDate,TheTime: string;
  TheFile: UTF8String;
  TheFileW: WideString;
  ParamList: TStringList=nil;
  TheHandle: THandle=INVALID_HANDLE_VALUE;
  FT: TFormatSettings;
  TheFileModify: TDateTime;
  lCreationTime, lAccessTime, lModificationTime: FILETIME;
  Arroba: Boolean=false;
  F: TFileStream;
  B: String;
  U: UnicodeString;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h', 'help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h', 'help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  if ParamCount=0 then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  { add your program here }

  TheFile:=ParamStr(1);
  TheDate:=ParamStr(2);
  TheTime:=ParamStr(3);

  if TheFile<>'' then begin
    if TheFile[1]='"' then begin
      TheFile:=copy(TheFile,2);
    end;
    if TheFile[1]='@' then begin
      TheFile:=copy(TheFile,2);
      Arroba:=true;
    end;
    if TheFile[1]='"' then begin
      TheFile:=copy(TheFile,2);
    end;
    if TheFile[length(TheFile)]='"' then begin
      TheFile:=copy(TheFile,1,Length(TheFile)-1);
    end;

    if Arroba then begin
      if not FileExists(TheFile) then begin
        writeln('File "',TheFile,'" does not exists.');
        Terminate(1);
        exit;
      end;

      //Each line is a parameter
      //so

      //Junction Name
      //2020-01-01
      //19:23:00

      ParamList:=TStringList.Create;
      try
        F:=TFileStream.Create(TheFile,fmOpenRead or fmShareDenyNone);
        SetLength(B,F.Size);
        F.Read(B[1],F.Size);
        FreeAndNil(F);
        ParamList.Text:=B;
        TheFile:=Utf8String(Utf8decode(ParamList[0]));
        TheDate:=ParamList[1];
        TheTime:=ParamList[2];
      finally
        FreeAndNil(ParamList);
      end;
    end;
  end;


  FT:=DefaultFormatSettings;

  FT.DateSeparator:='-';
  FT.LongDateFormat:='YYYY-MM-DD';
  FT.ShortDateFormat:='YYYY-MM-DD HH:mm:SS';

  TheFileModify:=StrToDateTime(TheDate+' '+TheTime,FT);

  TheFileW:=WideString(TheFile);

  TheHandle:=CreateFileW(@TheFileW[1], GENERIC_READ or GENERIC_WRITE,
                                 FILE_SHARE_READ or FILE_SHARE_WRITE,
                                 Nil, OPEN_EXISTING,
                                 FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT or FILE_ATTRIBUTE_REPARSE_POINT, INVALID_HANDLE_VALUE);
  if TheHandle<>INVALID_HANDLE_VALUE then begin
    if GetFileTime(TheHandle, at lCreationTime, at lAccessTime, at lModificationTime) then begin
      lModificationTime:=DateTimeToFileTime(TheFileModify);
      if not SetFileTime(TheHandle,lCreationTime,lAccessTime,lModificationTime) then begin
        writeln('SetFileTime Last Error: ',GetLastError());
        CloseHandle(TheHandle);
        Terminate(3);
        exit;
      end else begin
        CloseHandle(TheHandle);
        writeln ('Touched "'+TheFile+'" with '+DateTimeToStr(TheFileModify));
        Terminate(0);
        exit;
      end;
    end else begin
      writeln('GetFileTime Last Error: ',GetLastError());
      Terminate(2);
      exit;
    end;
  end else begin
    writeln('CreateFileW Last Error: ',GetLastError());
    Terminate(5);
    exit;
  end;

  // stop program loop
  Terminate(0);
end;

constructor TTouchJunction.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

destructor TTouchJunction.Destroy;
begin
  inherited Destroy;
end;

procedure TTouchJunction.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ', ExeName, ' junctionname YYYY-MM-DD HH:MM:SS [-h]');
  writeln('Or');
  writeln('Usage: ', ExeName, ' @Params-utf8.txt [-h]');
end;

var
  Application: TTouchJunction;
begin
  Application:=TTouchJunction.Create(nil);
  Application.Title:='TouchJunction';
  Application.Run;
  Application.Free;
end.