Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/VDEL.ZIP/VDEL.PAS

Pascal/Delphi Source File | 1988-09-13 | 9.3 KB | 356 lines

PROGRAM VDel (InFileSpec, Options);

{$B-,D+,R-,S-,V-}

USES DOS, CRT;

CONST
  Bell       = #7;
  No         = False;
  Yes        = True;
  NL         = #13#10;

TYPE
  Line      = STRING[65];
  ShortLine = STRING[4];

VAR
  InFile      : FILE;
  InFileSpec  : Line;
  InPath      : Line;
  Version     : Line;
  Verify      : BOOLEAN;
  Test        : BOOLEAN;
  AllFiles    : BOOLEAN;
  NumDel      : WORD;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Usage                                    │
└────────────────────────────────────────────────────┘
}
PROCEDURE Usage;

BEGIN
  WRITELN (Output,Bell,
'A file deletion program that asks confirmation for each delete.  VDEL works',NL,
'very much like the DOS "DEL" command, except that it prompts the user on a',NL,
'file-by-file basis as to whether each file should be deleted.  ',NL,
'',NL,
'USAGE:     VDEL {path}[filename] /N /A /T',NL,
'',NL,
'           Wildcards (* and ?) may be used.',NL,
'',NL,
'           /N - No verification',NL,
'           /A - All files: include read only, system, and hidden files',NL,
'           /T - Test; shows only the files that would be selected, but does',NL,
'                not delete any files.',NL);

  Halt;
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Beep                                     │
└────────────────────────────────────────────────────┘
}

PROCEDURE Beep (message : STRING);

BEGIN
  WRITELN (Output, NL, message, NL);
  SOUND (560);
  DELAY (50);
  NOSOUND;
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Error_Message                            │
└────────────────────────────────────────────────────┘
}

PROCEDURE Error_Message (message : STRING);

BEGIN
  WRITELN (Output, Bell, NL, message, NL);      { ding bell & write message }
  HALT;
END;

{
┌────────────────────────────────────────────────────┐
│ FUNCTION Format_Num                                │
└────────────────────────────────────────────────────┘
}

FUNCTION Format_Num (Num : LONGINT) : Line;

VAR
  NumStr : Line;

BEGIN
  STR (Num, NumStr);
  IF (LENGTH (NumStr) > 6) THEN                  { Insert millions comma    }
    INSERT (',',NumStr,(LENGTH(NumStr) - 5));

  IF (LENGTH (NumStr) > 3) THEN                  { Insert thousands comma   }
    INSERT (',',NumStr,(LENGTH(NumStr) - 2));

  Format_Num := NumStr;
END;

{
┌────────────────────────────────────────────────────┐
│ FUNCTION Pad                                       │
└────────────────────────────────────────────────────┘
}

FUNCTION Pad (Num : INTEGER) : Line;

VAR
  StrV : Line;

BEGIN
  STR (Num, StrV);
  IF LENGTH (StrV) = 1 THEN
    StrV := '0' + StrV;
  IF LENGTH (StrV) > 2 THEN                  {gets last 2 digits of Year}
    Pad := StrV[3] + StrV[4]
  ELSE
    Pad := StrV;
END;

{
┌────────────────────────────────────────────────────┐
│ FUNCTION Meridian                                  │
└────────────────────────────────────────────────────┘
}

FUNCTION Meridian (Hour, Min : INTEGER) : Line;

BEGIN
  IF Hour > 12 THEN
    BEGIN
      DEC (Hour,12);
      Meridian := Pad (Hour) + ':' + Pad (Min) + ' pm';
    END
  ELSE
    Meridian := Pad (Hour) + ':' + Pad (Min) + ' am';
END;

{
┌────────────────────────────────────────────────────┐
│ FUNCTION Get_Attr                                  │
└────────────────────────────────────────────────────┘
}

FUNCTION Get_Attr (AttrV : BYTE) : ShortLine;

VAR
  Attr : Line;

BEGIN
  Attr := 'N   ';
  IF AttrV AND ARCHIVE <> 0 THEN
    Attr[1] := 'A';
  IF AttrV AND READONLY <> 0 THEN
    Attr[2] := 'R';
  IF AttrV AND HIDDEN <> 0 THEN
    Attr[3] := 'H';
  IF AttrV AND SYSFILE <> 0 THEN
    Attr[4] := 'S';
  Get_Attr := Attr;
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE DelFile                                  │
└────────────────────────────────────────────────────┘
}

PROCEDURE DelFile (AllFilesV : BOOLEAN; NameV : Line; message : Line);

VAR
  DelFile : File;

BEGIN
  ASSIGN (DelFile, NameV);
  IF AllFilesV THEN
    SetFAttr (DelFile, Archive);
  ERASE (DelFile);
  WRITELN (Output, message);
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Test_for_Del                             │
└────────────────────────────────────────────────────┘
}

PROCEDURE Test_for_Del (InFileSpecV, InPathV : Line;
                        VerifyV, TestV, AllFilesV : BOOLEAN;
                        VAR NumDelV : WORD);

VAR
  FileV     : SearchRec;
  Ch        : CHAR;
  SearchV   : WORD;
  DateTimeV : DateTime;
  DT_Str    : Line;

BEGIN
  NumDelV := 0;

  IF AllFilesV THEN
    SearchV := $27  {normal files plus archive, RO, sys, hidden files}
  ELSE
    SearchV := $20; {normal plus archive files}

  WRITELN (Output, 'Presenting selected files in ',InPathV, NL);
  WRITELN (Output, 'File Name    Attrs.      Size  Date      Time        Action (Q to quit)');
  WRITELN (Output, '───────────────────────────────────────────────────────────────────────');

  FindFirst (InFileSpecV, SearchV, FileV);
  IF DosError <> 0 THEN
    WRITELN (Output, ' -- Matching file not found')
  ELSE
    WHILE DosError = 0 DO
      BEGIN
        IF AllFilesV OR (NOT AllFiles AND (FileV.Attr <> $01)) THEN
                        {this test is here because TP4.0 FindFirst does}
                        {NOT ignore ReadOnly files when Attr is 00H or }
                        {20H                                           }
          BEGIN
            UnPackTime (FileV.Time, DateTimeV);
            DT_Str := PAD(DateTimeV.Month) + '-' + PAD(DateTimeV.Day) + '-' +
                      PAD(DateTimeV.Year) + '  ' +
                      MERIDIAN(DateTimeV.Hour, DateTimeV.Min);
            WRITE (Output, FileV.Name, '':14 - LENGTH (FileV.Name),
                   Get_Attr (FileV.Attr),'  ', Format_Num (FileV.Size):9,
                   '  ', DT_Str);
            IF Test THEN
              WRITELN (Output, ' -- NOT deleted')
            ELSE
              IF Verify THEN
                BEGIN
                  WRITE (Output, ' -- Delete?  (Y or N) ');
                  Ch := ReadKey;
                  CASE Ch OF
                     'y','Y' : BEGIN
                                 DelFile (AllFilesV, InPathV + FileV.Name,'√');
                                 INC (NumDelV);
                               END;
                     'q','Q',
                     'x','X',
                     #27     : BEGIN
                                 WRITELN (Output,NL);
                                 Exit;
                               END;
                  ELSE
                     WRITELN (Output)
                  END {case};
                END
              ELSE
                DelFile (AllFilesV, InPathV + FileV.Name,' -- File deleted');
          END;
        FindNext (FileV);
      END;

  IF Test THEN
    WRITELN (Output,NL,'Test specified -- directory files not deleted');

END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Read_Params                              │
└────────────────────────────────────────────────────┘
}

PROCEDURE Read_Params (VAR InFileSpecV : Line;
                       VAR InPathV     : Line;
                       VAR VerifyV     : BOOLEAN;
                       VAR TestV       : BOOLEAN;
                       VAR AllFiles    : BOOLEAN);

    {
    ┌────────────────────────────────────────────────────┐
    │ SUB FUNCTION UpStr                                 │
    └────────────────────────────────────────────────────┘
    }
    FUNCTION UpStr (Str : Line) : Line;
    VAR
      i : WORD;
    BEGIN
      FOR i := 1 TO LENGTH (Str) DO
        Str[i] := UPCASE(Str[i]);
      UpStr := Str;
    END;

VAR
  Param2 : Line;
  i      : INTEGER;

BEGIN
  VerifyV     := Yes;
  TestV       := No;
  AllFiles    := No;
  i           := 0;

  IF (ParamCount = 0) OR (ParamStr(1) = '?') OR (ParamStr(1) = '/?') THEN
    Usage
  ELSE
    BEGIN
      InFileSpecV   := UpStr (ParamStr(1));
      WHILE InFileSpecV [LENGTH (InFileSpecV) - i] <> '\' DO
        INC (i);
      InPathV := COPY (InFileSpecV, 1, LENGTH (InFileSpecV) - i);
      IF LENGTH (InPathV) = 0 THEN
        BEGIN
          GETDIR (0,InPathV);
          IF LENGTH (InPathV) <> 3 THEN
            InPathV := InPathV + '\';
        END;

      FOR i := 2 TO ParamCount DO
        BEGIN
          Param2 := UpStr (ParamStr(i));
          IF Param2[1] = '/' THEN
            CASE Param2[2] OF
              'N' :  VerifyV  := No;
              'T' :  TestV    := Yes;
              'A' :  AllFiles := Yes;
            END
        END;
    END;
END;

{
┌────────────────────────────────────────────────────┐
│ MAIN PROGRAM                                       │
└────────────────────────────────────────────────────┘
}

BEGIN

  Version := 'Version 1.1, 9-13-88 -- Public Domain by John Land';

  ASSIGN (Output,'');
  REWRITE (Output);

  Read_Params (InFileSpec, InPath, Verify, Test, AllFiles);

  ClrScr;

  WRITELN (Output);

  Test_for_Del (InFileSpec, InPath, Verify, Test, AllFiles, NumDel);

  WRITELN (Output, NL,'Number of files deleted: ', NumDel);

  Beep ('Processing done.');

  CLOSE (Output);

END.