C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/FILESET/FILESET.PAS

Pascal/Delphi Source File | 1988-09-02 | 6KB | 229 lines

{$I-,R-,S-}

{
 Sets date, time and attribute of files
 Call with no parameters to see syntax

 Written by Kim Kokkonen, TurboPower Software
 1/88
 Released to the public domain
}

program FileSet;

uses
  dos,
  tpstring;

const
  NotUsed = MaxInt;
var
  FileMask : string;
  SetAttr : Integer;
  SetDateTime : DateTime;
  Frec : SearchRec;
  FilesSet : Integer;

  procedure FatalError(Msg : string);
    {-Report error and halt}

  begin                      {FatalError}
    WriteLn;
    WriteLn(Msg);
    Halt(1);
  end;                       {FatalError}

  function ParseDateTime(S : string; var Drec) : Boolean;
    {-Convert a string of form nn:nn:nn to part of a DateTime record}
  type
    ParseType = 1..3;
    ParseArray = array[ParseType] of Integer;
  var
    P : ParseArray absolute Drec;
    I : Integer;
    Pt : ParseType;
    Temp : string;
    TempInt : Integer;

  begin                      {ParseDateTime}
    ParseDateTime := False;
    Pt := 1;
    Temp := '';
    {Terminate string}
    S := S+'/';
    for I := 1 to Length(S) do
      case S[I] of
        '0'..'9' : Temp := Temp+S[I];
      else
        {Accept any other character as a delimiter}
        if not Str2Int(Temp, TempInt) then
          Exit;
        P[Pt] := TempInt;
        if Pt = 3 then begin
          {Record filled}
          ParseDateTime := True;
          Exit;
        end else
          Inc(Pt);
        Temp := '';
      end;

    ParseDateTime := True;
  end;                       {ParseDateTime}

  procedure Rearrange(var DT: DateTime);
    {-Put Y:M:D in correct order}
  var
    T:integer;

  begin     {Rearrange}
    with DT do begin
      T:=year;
      year:=day;
      day:=month;
      month:=T;
      if year < 1980 then
        inc(year,1900);
    end;
  end;      {Rearrange}

  procedure GetParameters;
    {-Analyze the command line parameters}
  var
    I : Word;
    Arg : string;
    GotOne : Boolean;

  begin                      {GetParameters}

    GotOne := False;
    FileMask := '';
    SetAttr := NotUsed;
    FillChar(SetDateTime, SizeOf(DateTime), 0);
    with SetDateTime do begin
      year := NotUsed;
      hour := NotUsed;
    end;

    I := 1;
    while I <= ParamCount do begin
      Arg := ParamStr(I);
      if (Length(Arg) = 2) and ((Arg[1] = '-') or (Arg[1] = '/')) then
        case Upcase(Arg[2]) of
          'A' : if I < ParamCount then begin
                  Inc(I);
                  if not Str2Int(ParamStr(I), SetAttr) then
                    FatalError('Invalid attribute specified');
                  GotOne := True;
                end else
                  FatalError('Attribute missing after A');

          'D' : if I < ParamCount then begin
                  Inc(I);
                  if not ParseDateTime(ParamStr(I), SetDateTime.year) then
                    FatalError('Invalid date specified');
                  Rearrange(SetDateTime);
                  GotOne := True;
                end else
                  FatalError('Date missing after D');

          'T' : if I < ParamCount then begin
                  Inc(I);
                  if not ParseDateTime(ParamStr(I), SetDateTime.hour) then
                    FatalError('Invalid time specified');
                  GotOne := True;
                end else
                  FatalError('Time missing after T');
        else
          FatalError('Unrecognized command line option '+Arg);
        end
      else if FileMask = '' then
        FileMask := Arg
      else
        FatalError('More than one file mask specified');
      Inc(I);
    end;

    if FileMask = '' then
      FatalError('No files specified');

    if not(GotOne) then
      {Use as a touch utility}
      with SetDateTime do begin
        getdate(year, month, day, I);
        gettime(hour, min, sec, I);
      end;

  end;                       {GetParameters}

  procedure SetAttributes(Name : string);
    {-Set the time/date/protection attributes for the named file}
  var
    F : file;
    GetDateTime : DateTime;
    GetAttr : Word;
    T : LongInt;

  begin                      {SetAttributes}

    Assign(F, Name);

    GetFattr(F, GetAttr);
    {Make file normal for a moment}
    SetFattr(F, 0);

    with SetDateTime do
      if (year <> NotUsed) or (hour <> NotUsed) then begin
        Reset(F, 1);
        if IoResult = 0 then begin
          {At least one of the two was changed}
          if (year = NotUsed) or (hour = NotUsed) then begin
            {At least one of the two was not changed, get the current}
            GetFTime(F, T);
            UnpackTime(T, GetDateTime);
            {Transfer in new values}
            if year <> NotUsed then
              Move(SetDateTime.year, GetDateTime.year, 6);
            if hour <> NotUsed then
              Move(SetDateTime.hour, GetDateTime.hour, 6);
          end else
            {Both were changed}
            GetDateTime := SetDateTime;
          {Pack it up}
          PackTime(GetDateTime, T);
          {Change the file}
          SetFtime(F, T);
          Close(F);
        end;
      end;

    if SetAttr <> NotUsed then
      GetAttr := SetAttr;
    SetFattr(F, GetAttr);

  end;                       {SetAttributes}

begin
  if ParamCount = 0 then begin
    WriteLn('Usage: FILESET FileNameMask -a Attr -d Date -t Time');
    FatalError('Example: FILESET *.PAS -a 0 -d 10-1-88 -t 4:02');
  end;

  GetParameters;

  {Scan all normal files in the current directory}
  FindFirst(FileMask, AnyFile, Frec);

  if DosError <> 0 then
    FatalError('No matching files found');

  FilesSet := 0;
  repeat
    Inc(FilesSet);
    SetAttributes(addbackslash(justpathname(FileMask))+Frec.Name);
    FindNext(Frec);
  until DosError <> 0;

  WriteLn('Files Set: ', FilesSet);
end.