home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / CHMOD.ZIP / CHMOD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  8.1 KB  |  225 lines
  1. program ChMod;
  2.  
  3. (*--------------------------------------------------------------------*)
  4. (*    This program changes the attribute of a file(s).  It will       *)
  5. (*    accept drive, path and wildcard characters in the filename.     *)
  6. (*                                                                    *)
  7. (*    Users of the incremental back-up method for hard disks may      *)
  8. (*    find this program especially useful when a number of files      *)
  9. (*    have been updated since the last back-up but are not wanted     *)
  10. (*    to be backed-up.  The author is a user of Symphony and updates  *)
  11. (*    a number of .PIC files weekly but does not want them backed-    *)
  12. (*    up when doing his incremental back-up.  Thus by executing       *)
  13. (*    CHMOD C:\SYMPHONY\*.PIC N  turns off the archive bit in all     *)
  14. (*    of the .PIC files' attributes.                                  *)
  15. (*                                                                    *)
  16. (*    Usage :                                                         *)
  17. (*       ALTER FILENAME Attributes ');                                *)
  18. (*             FILENAME - will accept drive,path & wildcard characters*)
  19. (*             Attributes -  R : Read only                            *)
  20. (*                        -  S : System                               *)
  21. (*                        -  H : Hidden                               *)
  22. (*                        -  A : Archive                              *)
  23. (*                        -  N : Normal(turns off all bits)           *)
  24. (*       ==>   Use spaces to delimit filename and attributes          *)
  25. (*             EXAMPLE :   ChMod C:\DOG\DOG.* R H                     *)
  26. (*       ==>   If no attributes are passed then file(s) attributes    *)
  27. (*             will be listed.                                        *)
  28. (*       ==>   If no filename or invalid syntax is passed, a usage    *)
  29. (*             message is displayed(similiar to above format).        *)
  30. (*                                                                    *)
  31. (*    This program may be freely distributed and changed to fit       *)
  32. (*    your needs.  If you make changes and subsequently distribute    *)
  33. (*    ChMod, please make note of your changes in this program.        *)
  34. (*                                                                    *)
  35. (*    A product of DOGWARE by DR. DOG - 1985.                         *)
  36. (*--------------------------------------------------------------------*)
  37.  
  38. Label Quit;
  39.  
  40. type
  41.    RegPack = Record
  42.       ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  43.    End;
  44.  
  45. type
  46.    FILREC = Record                     (* DTA layout        *)
  47.       ForD   : array[1..21]of byte;    (* reserved for DOS  *)
  48.       Attr   : byte;                   (* file attribute    *)
  49.       Time   : array[1..2] of Byte;    (* file time         *)
  50.       Date   : array[1..2] of Byte;    (* file date         *)
  51.       Size   : array[1..4] of byte;    (* file size         *)
  52.       Name   : array[1..13] of Char;   (* file name         *)
  53.       Fill   : array[1..85] of byte;   (* filler - ?????    *)
  54.    End;
  55.  
  56. var
  57.    CmdLine : string[80] absolute Cseg:$80;        (* input to ChMod *)
  58.    ASC     : String[80];                          (* ASCIIZ string  *)
  59.    FIL     : FILREC;
  60.    Regs    : RegPack;
  61.    ATR     : byte;
  62.    I       : integer;
  63.    Drive   : string[2];          (* Drive + ':' *)
  64.    Path    : string[80];         (* path        *)
  65.    DSN     : string[80];         (* filename    *)
  66.    List    : Boolean;
  67.  
  68. Procedure ParseFileName;       (* scan for drive and path  *)
  69. Label Exit;
  70.   Begin
  71.    Drive := '';
  72.    Path := '';
  73.    If pos(':',ASC) = 2 then Drive := Copy(ASC,1,2) else goto Exit;
  74.    If pos('\',ASC) <> 0 then
  75.       Begin
  76.         Path := ASC;
  77.         Delete(Path,1,2);    (* get rid of drive: *)
  78.         I := Length(Path);
  79.         Repeat
  80.           delete(Path,I,1);
  81.           I := I -1;
  82.         until (Path[I] = '\') or (I = 0);
  83.       end;
  84.   Exit:
  85.   End;
  86.  
  87. Procedure DTA;          (* set DTA transfer address *)
  88.   Begin
  89.    Regs.Ax := $1A00;
  90.    Regs.DX := ofs(fil);
  91.    Regs.DS := Dseg;
  92.    Intr($21,regs);
  93.   End;
  94.  
  95. Procedure GetFirst;    (* search for 1st matching enter *)
  96.   Begin
  97.    Regs.Ax := $4E00;
  98.    Regs.Cx := $37;
  99.    Regs.DX := ofs(ASC) + 1;
  100.    Regs.DS := Dseg;
  101.    Intr($21,regs);
  102.   End;
  103.  
  104. Procedure SetAttr;     (* set file attribute *)
  105.  Begin
  106.     DSN := Drive + Path;
  107.     I := 1;
  108.     repeat
  109.        DSN := DSN + Fil.Name[I];
  110.        I := I + 1;
  111.     until (Fil.Name[I] = #$00) or (I = 14);
  112.     DSN[length(DSN)+1] := Chr($0);
  113.     if not list then Regs.Ax := $4301 else Regs.Ax := $4300;
  114.     Regs.Cx := ATR;
  115.     Regs.Dx := Ofs(dsn) + 1;
  116.     Regs.DS := Dseg;
  117.     Intr($21,regs);
  118.  End;
  119.  
  120. Procedure GetNext;        (* get next matching entry *)
  121.  Begin
  122.    Regs.ax := $4f00;
  123.    Intr($21,regs);
  124.  End;
  125.  
  126. Procedure SyntaxErr;     (* syntax/help *)
  127.  Begin
  128.    Writeln('ChMod FILENAME Attributes ');
  129.    Writeln('      FILENAME - will accept drive, path and wildcard characters');
  130.    Writeln('      Attributes -  R : Read only');
  131.    Writeln('                 -  S : System');
  132.    Writeln('                 -  H : Hidden');
  133.    Writeln('                 -  A : Archive');
  134.    Writeln('                 -  N : Normal(turns off all bits)');
  135.    Writeln('use spaces to delimit filename and attributes');
  136.    Writeln('EXAMPLE :   ChMod C:\DOG\DOG.* R H');
  137.    Writeln('If no attributes are passed then file(s) attributes will be listed');
  138.  End;
  139.  
  140. Begin                     (* Main driver starts here *)
  141.    gotoxy(1,25);
  142.    Writeln('               DogWare by Dr. Dog  -  1985');
  143.    Writeln(' ');
  144.    If (length(cmdline) = 0) or (Pos(' ',cmdline) = 0) then
  145.     Begin
  146.       SyntaxErr;
  147.       goto Quit;
  148.     end;
  149.    repeat
  150.     delete(cmdline,1,1);
  151.    until (pos(' ',cmdline) <> 1) or (length(cmdline) = 0);
  152.    If pos(' ',cmdline) <> 0  then
  153.       Begin
  154.          ASC := Copy(cmdline,1,(pos(' ',cmdline)-1));
  155.          Delete(cmdline,1,length(ASC) + 1);
  156.          List := False
  157.       End
  158.       Else
  159.       Begin
  160.          ASC := Cmdline;
  161.          List := True;
  162.       End;
  163.    ASC[length(ASC)+1] := chr($0);
  164.    Atr := $0;
  165.    I := length(cmdline);
  166.    If not List then
  167.       Begin
  168.         Repeat
  169.           If cmdline[I] <> ' ' then
  170.              Begin
  171.                Case upcase(CmdLine[I]) of
  172.                     'R' : Atr := Atr OR $01;
  173.                     'H' : Atr := Atr OR $02;
  174.                     'S' : Atr := Atr OR $04;
  175.                     'A' : Atr := Atr OR $20;
  176.                     'N' : Atr := Atr OR $FF;
  177.                     else
  178.                     Begin
  179.                       SyntaxErr;
  180.                       goto Quit;
  181.                    End;
  182.               End;
  183.             End;
  184.         I := I - 1;
  185.         until I = 0;
  186.       End;
  187.    If Atr = $0 then List := True;
  188.    If Atr = $FF then Atr := $0;
  189.    ParseFileName;
  190.    DTA;
  191.    GetFirst;
  192.    If Lo(Regs.AX) <> 0 then
  193.      Begin
  194.         Writeln(ASC,' not found');
  195.         goto Quit;
  196.      End;
  197.    Repeat
  198.      If Fil.name[1] = '.' then repeat GetNext until Fil.Name[1] <> '.';
  199.      SetAttr;
  200.      If not list then
  201.         Begin      (* NOTE: Carry flag MUST be checked in DOS 3.0! *)
  202.            Regs.flags := Regs.Flags AND $0001;   (* get carry flag *)
  203.            if (lo(regs.ax) in [0,255]) or (Regs.Flags = 0) then
  204.               Writeln(DSN,' attribute changed')
  205.                       else
  206.               Writeln(DSN,' attribute NOT CHANGED, return code = ',lo(regs.ax));
  207.         End
  208.         Else
  209.         Begin
  210.             Write(DSN,' attribute is ');
  211.             If Regs.CX = 0 then Write('Normal ');
  212.             If Regs.CX AND $20 <> 0 then Write('Archive ');
  213.             If Regs.CX AND $10 <> 0 then Write('Sub-Directory ');
  214.             If Regs.CX AND $08 <> 0 then Write('Label  ');
  215.             If Regs.CX AND $04 <> 0 then Write('System ');
  216.             If Regs.CX AND $02 <> 0 then Write('Hidden ');
  217.             If Regs.CX AND $01 <> 0 then Write('Read-Only ');
  218.             Writeln(' ');
  219.         End;
  220.      GetNext;
  221.    until lo(regs.ax) <> 0;
  222.    Quit:
  223.    Writeln('ChMod Program terminated');
  224.    End.
  225.