{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples  Version 1.10            █}
{█      TOUCH command line utility.                      █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995-96 fPrint UK Ltd              █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{$I-,D-}

{ Changes the date and time of selected files to the date }
{ and time at which the program is run.                   }

program Touch;

{$D Virtual Pascal TOUCH utility}

{&PMTYPE VIO}

uses Dos, Use32;

{$IFDEF VPDEMO}
  {$Dynamic VP11Demo.Lib}
{$ENDIF}

var
  Time: Longint;
  I: Integer;

{ Reports an error, halts program execution }

procedure Error(const ErrStr: String);
begin
  WriteLn('**Error**  ', ErrStr);
{  Halt(2); }
end;

{ Returns current date & time in the packed file format }

function GetDateTime: Longint;
var
  DT: DateTime;
  DayOfWeek,Sec100: Word;
  Time: Longint;
begin
  GetDate(DT.Year, DT.Month, DT.Day, DayOfWeek);
  GetTime(DT.Hour, DT.Min  , DT.Sec, Sec100);
  PackTime(DT, Time);
  GetDateTime := Time;
end;

{ Touches file(s) specified by a given file name (wildcard) }

procedure DoTouch(const Wild: String);
var
  SR: SearchRec;
  F: File;
  FName: PathStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(Wild, Dir, Name, Ext);
  FindFirst(Wild, 0, SR);
  if DosError <> 0 then Error('Cannot locate file ' + Wild)
 else
  while DosError = 0 do
  begin
    FName := Dir + SR.Name;
    Assign(F, FName);
    { OS/2: Write only, deny read-write, fail on error }
    { DOS: Write only }
    FileMode := {$IFDEF OS2} $2011 {$ELSE} 1 {$ENDIF};
    Reset(F);
    if IOResult <> 0 then Error('Unable to open file ' + FName);
    SetFTime(F, Time);
    if DosError <> 0 then Error('Unable to change file date and time: ' + FName);
    Close(F); InOutRes := 0;
    FindNext(SR);
  end;
{$IFDEF OS2}
  FindClose(SR);
{$ENDIF}
end;

begin
  WriteLn('Virtual Pascal Touch  Version 1.10 Copyright (C) 1995-96 fPrint UK Ltd');
  if ParamCount = 0 then
  begin
    WriteLn('Syntax: TOUCH Arg1 [Arg2..Argn]');
    WriteLn('where ArgX are file names or wildcards.');
    Halt(1);
  end;
  Time := GetDateTime;
  for I := 1 to ParamCount do DoTouch(ParamStr(I));
end.