home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB125 / attrib.pas < prev    next >
Pascal/Delphi Source File  |  1995-06-04  |  26KB  |  1,165 lines
  1. PROGRAM FileAttributes;
  2.  
  3. {$G128,P128,D-}                             {010,001}
  4.  
  5. CONST
  6.  
  7.     ProgramVersion = '1.0';
  8.  
  9. (***********************************************************************
  10.  
  11.      This software has been placed into the public domain by Digital
  12.              Equipment Corporation.
  13.  
  14.  
  15. DISCLAIMER:
  16.  
  17. The information herein is subject to change without  notice  and  should
  18. not be construed as a commitment by Digital Equipment Corporation.
  19.  
  20. Digital Equipment Corporation assumes no responsibility for the  use  or
  21. reliability  of  this  software.   This  software  is  provided "as is,"
  22. without any warranty of any kind, express or implied.  Digital Equipment
  23. Corporation  will  not    be liable in any event for any damages including
  24. any loss of data, profit, or savings, claims against  the  user  by  any
  25. other  party,  or  any other incidental or consequential damages arising
  26. out of the use of, or inability to use, this software, even  if  Digital
  27. Equipment Corporation is advised of the possibility of such damage.
  28.  
  29. DEFECT REPORTING AND SUGGESTIONS:
  30.  
  31. Please send reports of defects or suggestions for  improvement    directly
  32. to the author:
  33.  
  34.     Brian Hetrick
  35.     Digital Equipment Corporation
  36.     110 Spit Brook Road  ZKO1-3/J10
  37.     Nashua NH  03062-2698
  38.  
  39. Do NOT file a Software Performance Report on  this  software,  call  the
  40. Telephone  Support  Center regarding this software, contact your Digital
  41. Field Office  regarding  this  software,  or  use  any    other  mechanism
  42. provided for Digital's supported and warranted software.
  43.  
  44.  
  45. FACILITY:
  46.  
  47.     MS-DOS user utilities
  48.  
  49. ABSTRACT:
  50.  
  51.     Manipulates attributes of files
  52.  
  53. ENVIRONMENT:
  54.  
  55.     MS-DOS V2.0 or later compiled  with  Borland  International's  TURBO
  56.     Pascal V3.0 or later
  57.  
  58. AUTHOR: Brian Hetrick, CREATION DATE: 24 November 1986.
  59.  
  60. MODIFIED BY:
  61.  
  62.     Brian Hetrick, 24-Nov-86: Version Y1.0-0
  63.   000 - Original creation of module.
  64.     Released to selected Easynet sites for beta test on 24    November
  65.     1986.
  66.  
  67.     Brian Hetrick, 02-Dec-86: Version Y1.0-8
  68.   001 - Add Gn, Pn compiler directives for compilation on IBM PC clones.
  69.   002 - Modify IsPrefix routine to PrefixLength for  command  qualifiers
  70.     starting with same letter.
  71.   003 - Parse command qualifiers before and after parsing file spec,  as
  72.     bad  command  qualifier  with no file spec prompts for file spec
  73.     before detecting bad command qualifer.
  74.   004 - Add /CLEAR and /REMOVE synonyms for /RESET.
  75.   005 - Add help message if no command line given.
  76.   006 - Allow multiple wild card specs.
  77.   007 - Make path specifications absolute before reporting.
  78.   008 - List file names on left side of display.
  79.     Released to selected Easynet sites for beta test on  2    December
  80.     1986.
  81.  
  82.     Brian Hetrick, 16-Dec-86: Version Y1.0-14
  83.   009 - Use CtlCTrap package to trap CTRL/C, as  TURBO    Pascal's  CTRL/C
  84.     is  not  as desired.  The undesired behavior (waiting for a Read
  85.     or ReadLn to abort the program) appears to occur only on  MS-DOS
  86.     or  PC-DOS  V2.x.  The PC-DOS specific TURBO Pascal had this un-
  87.     desired behavior all along, but MS-DOS generic TURBO Pascals be-
  88.     fore version 3.02A did not have this  behavior    on  the  Rainbow
  89.     (due to a bug in how the TURBO CTRL/C handler was set up), where
  90.     most testing occurred.    The undesired behavior was noticed by  a
  91.     beta  test  site using ATTRIB Y1.0-8, the first release compiled
  92.     with TURBO Pascal 3.02A, when it was impossible to CTRL/C out of
  93.     listings  that were hit with the performance bug handled in edit
  94.     011.
  95.   010 - Construct print lines as a whole and omit trailing spaces.   Add
  96.     the D- compiler directive and Flush (Output) to speed things up.
  97.     This also makes all program-generated text finally go to the MS-
  98.     -DOS standard output:  even with Pn, TURBO will use IBM  PC  ROM
  99.     BIOS calls if the standard output is the console.
  100.   011 - Retain attribute  from    wild  card  lookup.   This  considerably
  101.     improves performance in highly fragmented directories.
  102.   012 - CTRL/C entered in response to the ReadLn in CLA.PAS  does  *NOT*
  103.     abort  the  program  at  least    under PC-DOS V2.10.  Apparently,
  104.     using the Gn,Pn,D- set of compiler directives  entirely  defeats
  105.     ^C detection.  So use the ^C package even for command line pars-
  106.     ing.
  107.   013 - Detect CTRL/Z entered in response to ReadLn in CLA.PAS.
  108.   014 - Reorder attributes in listing to put Arc and Dir, the most  pop-
  109.     ular attributes, first.
  110.     Released to selected Easynet sites for beta test on 17    December
  111.     1986.
  112.  
  113.     Brian Hetrick, 30-Jan-87: Version Y1.0-16
  114.   015 - Introduce /HELP switch to give long help message;  if no command
  115.     line given, give short message and assume *.*.    Remove prompting
  116.     for command parameters as there is now a 'reasonable' default.
  117.   016 - Make help text less dense, as it is now explicitly requested and
  118.     the user is presumably ready to deal with it.
  119.  
  120.     Brian Hetrick, 30-Jan-87: Version 1.0
  121.   017 - Delete internal use only notice, copyright notice, etc., and set
  122.     version  number to have no prefix or edit suffix, as will be re-
  123.     leased to DECUS Program Library.
  124.     Released to Easynet sites and DECUS Program Library  30  January
  125.     1987.
  126.  
  127. ***********************************************************************)
  128. {.PA}
  129. (*
  130.  *  INCLUDE FILES:
  131.  *)
  132.  
  133. {$I CtlCTrap.Pas}                            {009}
  134. {$I CLA.PAS}
  135. {$I WildExpa.Pas}
  136. {$I MakeAbs.Pas}                            {007}
  137. {$I BaseName.Pas}                            {008}
  138.  
  139. (*
  140.  *  LABEL DECLARATIONS:
  141.  *)
  142.  
  143. (*
  144.  *  CONSTANT DECLARATIONS:
  145.  *)
  146.  
  147. CONST
  148.  
  149.     AttrMaskReadOnly     = 1;
  150.     AttrMaskHidden     = 2;
  151.     AttrMaskSystem     = 4;
  152.     AttrMaskSubDirectory = 16;
  153.     AttrMaskArchive     = 32;
  154.  
  155. (*
  156.  *  TYPE DECLARATIONS:
  157.  *)
  158.  
  159. TYPE
  160.  
  161.     PathSpec = WildExpandPathSpec;                    {011}
  162.  
  163. (*
  164.  *  OWN STORAGE:
  165.  *)
  166.  
  167. VAR
  168.  
  169.     Logging        : BOOLEAN;
  170.     HelpDesired     : BOOLEAN;                        {015}
  171.     OptionSpecified : BOOLEAN;                        {005}
  172.     ResetMask        : INTEGER;
  173.     SetMask        : INTEGER;
  174.  
  175. (*
  176.  *  TABLE OF CONTENTS:
  177.  *)
  178. {.PA}
  179. PROCEDURE PrintHelp;                            {005}
  180.  
  181. (***********************************************************************{005}
  182.  
  183. FUNCTIONAL DESCRIPTION:                         {005}
  184.  
  185.     Writes a description of the program on the standard output.     {005}
  186.  
  187. FORMAL PARAMETERS:                            {005}
  188.  
  189.     None.                                {005}
  190.  
  191. RETURN VALUE:                                {005}
  192.  
  193.     None.                                {005}
  194.  
  195. IMPLICIT INPUTS:                            {005}
  196.  
  197.     None.                                {005}
  198.  
  199. IMPLICIT OUTPUTS:                            {005}
  200.  
  201.     None.                                {005}
  202.  
  203. SIDE EFFECTS:                                {005}
  204.  
  205.     None.                                {005}
  206.  
  207. ***********************************************************************){005}
  208.  
  209.     BEGIN                                {005}
  210.  
  211.     WriteLn;                                         {016}
  212.     WriteLn ('Command line:   ATTRIB filespec [qualifier]...');              {005}
  213.     WriteLn;                                         {016}
  214.     WriteLn ('''filespec'' is a path specification possibly with wild card characters'); {005}
  215.     WriteLn ('   in the last component');                         {005}
  216.     WriteLn;                                         {016}
  217.     WriteLn ('''qualifier'' is one of /[NO]HELP, /[NO]LOG, /SET:value, /RESET:value,');  {005}
  218.     WriteLn ('   /CLEAR:value, /REMOVE:value');                      {005}
  219.     WriteLn;                                         {016}
  220.     WriteLn ('   /SET grants attributes');                         {016}
  221.     WriteLn ('   /RESET, /CLEAR, and /REMOVE remove attributes');             {016}
  222.     WriteLn;                                         {016}
  223.     WriteLn ('''value'' is either name or (name[,name]...)');                 {005}
  224.     WriteLn;                                         {016}
  225.     WriteLn ('''name'' is one of ARCHIVE, HIDDEN, SYSTEM, READ_ONLY');             {005}
  226.     WriteLn;                                         {016}
  227.     WriteLn ('All keywords may be uniquely abbreviated')                 {005}
  228.  
  229.     END;                                {005}
  230. {.PA}
  231. FUNCTION PrefixLength                            {002}
  232.    (    Str1 : PathSpec;
  233.     Str2 : PathSpec) : INTEGER;                    {002}
  234.  
  235. (***********************************************************************
  236.  
  237. FUNCTIONAL DESCRIPTION:
  238.  
  239.     Determines whether one string is a prefix of another,  ignoring  the
  240.     case of letters.
  241.  
  242. FORMAL PARAMETERS:
  243.  
  244.     TestString.rt.v - The string which may be a prefix of TargetString.
  245.     TargetString.rt.v - The string of which TestString may be a prefix.
  246.  
  247. RETURN VALUE:
  248.  
  249.     Zero: TestString is not a prefix of TargetString.            {002}
  250.     n>0:  TestString is a prefix of TargetString and has n characters.    {002}
  251.  
  252. IMPLICIT INPUTS:
  253.  
  254.     None.
  255.  
  256. IMPLICIT OUTPUTS:
  257.  
  258.     None.
  259.  
  260. SIDE EFFECTS:
  261.  
  262.     None.
  263.  
  264. ***********************************************************************)
  265.  
  266.     VAR
  267.     Chr1  : CHAR;
  268.     Chr2  : CHAR;
  269.     Index : INTEGER;
  270.  
  271.     BEGIN
  272.  
  273.     IF Length (Str1) <= Length (Str2)
  274.     THEN
  275.     BEGIN
  276.  
  277.     (*
  278.      *  Test string is no longer than target string, so check char-
  279.      *  acters
  280.      *)
  281.  
  282.     PrefixLength := Length (Str1);                    {002}
  283.  
  284.     FOR Index := 1 TO Length (Str1)
  285.     DO
  286.         BEGIN
  287.  
  288.         Chr1 := UpCase (Str1 [Index]);
  289.         Chr2 := UpCase (Str2 [Index]);
  290.         IF Chr1 <> Chr2
  291.         THEN
  292.         BEGIN                            {002}
  293.  
  294.         (*
  295.          *  A mismatch was found, test string is not a prefix of
  296.          *  target string
  297.          *)
  298.  
  299.         PrefixLength := 0;                    {002}
  300.         Exit                            {002}
  301.  
  302.         END                            {002}
  303.         END
  304.  
  305.     END
  306.  
  307.     ELSE
  308.  
  309.     (*
  310.      *  Test string is longer than target string and so cannot be a
  311.      *  prefix
  312.      *)
  313.  
  314.     PrefixLength := 0                        {002}
  315.  
  316.     END;
  317. {.PA}
  318. PROCEDURE Pad                                {010,008}
  319.    (VAR StringText : PathSpec;                        {010,008}
  320.     PadLength  : INTEGER);                        {010,008}
  321.  
  322. (***********************************************************************{008}
  323.  
  324. FUNCTIONAL DESCRIPTION:                         {008}
  325.  
  326.     Adjusts a string by truncating the rightmost characters  or  padding{008}
  327.     on the right with spaces to be a specified length.            {008}
  328.  
  329. FORMAL PARAMETERS:                            {008}
  330.  
  331.     StringToPad.rt.v - The string to be adjusted.            {008}
  332.     DesiredLength.rg.v - The length of the result string.        {008}
  333.  
  334. RETURN VALUE:                                {008}
  335.  
  336.     None.                                {010}
  337.  
  338. IMPLICIT INPUTS:                            {008}
  339.  
  340.     None.                                {008}
  341.  
  342. IMPLICIT OUTPUTS:                            {008}
  343.  
  344.     None.                                {008}
  345.  
  346. SIDE EFFECTS:                                {008}
  347.  
  348.     None.                                {008}
  349.  
  350. ***********************************************************************){008}
  351.  
  352.     VAR                                 {008}
  353.  
  354.     StuffIndex : INTEGER;                        {008}
  355.  
  356.     BEGIN                                {008}
  357.  
  358.     (*                                    {008}
  359.      *    Pad on the right with blanks                    {008}
  360.      *)                                 {008}
  361.  
  362.     FOR StuffIndex := Length (StringText) + 1 TO PadLength        {008}
  363.     DO                                    {008}
  364.     StringText [StuffIndex] := ' ';                 {010,008}
  365.  
  366.     (*                                    {008}
  367.      *    Adjust the length                        {008}
  368.      *)                                 {008}
  369.  
  370.     StringText [0] := Chr (PadLength)                    {010,008}
  371.  
  372.     END;                                {008}
  373. {.PA}
  374. PROCEDURE AppendString                            {010}
  375.    (    InsertString : PathSpec;                    {010}
  376.     VAR TargetString : PathSpec);                    {010}
  377.  
  378. (***********************************************************************{010}
  379.  
  380. FUNCTIONAL DESCRIPTION:                         {010}
  381.  
  382.     Appends one string to another.                    {010}
  383.  
  384. FORMAL PARAMETERS:                            {010}
  385.  
  386.     StringToAdd.rt.v - The string to be appended to TargetString.    {010}
  387.     TargetString.mt.r - The string to which StringToAdd is to be ap-    {010}
  388.     pended.                             {010}
  389.  
  390. RETURN VALUE:                                {010}
  391.  
  392.     None.                                {010}
  393.  
  394. IMPLICIT INPUTS:                            {010}
  395.  
  396.     None.                                {010}
  397.  
  398. IMPLICIT OUTPUTS:                            {010}
  399.  
  400.     None.                                {010}
  401.  
  402. SIDE EFFECTS:                                {010}
  403.  
  404.     None.                                {010}
  405.  
  406. ***********************************************************************){010}
  407.  
  408.     BEGIN                                {010}
  409.  
  410.     Insert (InsertString, TargetString, Length (TargetString) + 1)    {010}
  411.  
  412.     END;                                {010}
  413. {.PA}
  414. PROCEDURE SetKeywordBit
  415.    (    KeywordText : PathSpec;
  416.     VAR OptionMask  : INTEGER);
  417.  
  418. (***********************************************************************
  419.  
  420. FUNCTIONAL DESCRIPTION:
  421.  
  422.     Sets the bit in an attribute mask designated by a keyword.    The key-
  423.     word is any of ARCHIVE, HIDDEN, READ_ONLY, or SYSTEM, or any leading
  424.     abbreviation of one of these keywords.
  425.  
  426. FORMAL PARAMETERS:
  427.  
  428.     Keyword.rt.v - The keyword designating an attribute.
  429.     AttributeMask.mg.r - The attribute mask in which the bit correspond-
  430.     ing to the keyword is to be set.
  431.  
  432. RETURN VALUE:
  433.  
  434.     None.
  435.  
  436. IMPLICIT INPUTS:
  437.  
  438.     None.
  439.  
  440. IMPLICIT OUTPUTS:
  441.  
  442.     None.
  443.  
  444. SIDE EFFECTS:
  445.  
  446.     If Keyword is not an abbreviation of one of the valid  keywords,  an
  447.     error  mesage  is  written to the standard output and the program is
  448.     terminated.
  449.  
  450. ***********************************************************************)
  451.  
  452.     BEGIN
  453.  
  454.     (*
  455.      *    Check against list and set appropriate bit
  456.      *)
  457.  
  458.     IF PrefixLength (KeywordText, 'HIDDEN') > 0             {002}
  459.     THEN
  460.  
  461.     OptionMask := OptionMask OR AttrMaskHidden
  462.  
  463.     ELSE IF PrefixLength (KeywordText, 'SYSTEM') > 0            {002}
  464.     THEN
  465.  
  466.     OptionMask := OptionMask OR AttrMaskSystem
  467.  
  468.     ELSE IF PrefixLength (KeywordText, 'READ_ONLY') > 0         {002}
  469.     THEN
  470.  
  471.     OptionMask := OptionMask OR AttrMaskReadOnly
  472.  
  473.     ELSE IF PrefixLength (KeywordText, 'ARCHIVE') > 0            {002}
  474.     THEN
  475.  
  476.     OptionMask := OptionMask OR AttrMaskArchive
  477.  
  478.     ELSE
  479.     BEGIN
  480.  
  481.     WriteLn ('Invalid argument value: "', KeywordText, '"');
  482.     Halt
  483.  
  484.     END
  485.  
  486.     END;
  487. {.PA}
  488. PROCEDURE DoSetArgument
  489.    (    ArgumentText : PathSpec;
  490.     VAR OptionMask   : INTEGER);
  491.  
  492. (***********************************************************************
  493.  
  494. FUNCTIONAL DESCRIPTION:
  495.  
  496.     Parses the value to the /SET or /RESET option.  The syntax of  these
  497.     values is:
  498.  
  499.     keyword
  500.     (keyword[,keyword]...])
  501.  
  502.     where 'keyword' is one of ARCHIVE, HIDDEN, READ_ONLY, or SYSTEM,  or
  503.     a unique leading abbreviation of one of these.
  504.  
  505. FORMAL PARAMETERS:
  506.  
  507.     ValueText.rt.v - The text of the value to be parsed.
  508.     AttributeMask.mg.r - The attribute    mask  in  which  the  bits  cor-
  509.     responding to the keywords are to be set.
  510.  
  511. RETURN VALUE:
  512.  
  513.     None.
  514.  
  515. IMPLICIT INPUTS:
  516.  
  517.     None.
  518.  
  519. IMPLICIT OUTPUTS:
  520.  
  521.     None.
  522.  
  523. SIDE EFFECTS:
  524.  
  525.     May write a message to the standard output and halt program  execut-
  526.     ion under the following circumstances:
  527.  
  528.      -    ValueText consists only of '(';
  529.      -    ValueText starts with '(' but does not end with ')';
  530.      -    ValueText has ')' before the end of the string;
  531.      -    ValueText has two adjacent commas.
  532.  
  533. ***********************************************************************)
  534.  
  535.     VAR
  536.  
  537.     KeyWord     : PathSpec;
  538.     SearchIndex : INTEGER;
  539.  
  540.     BEGIN
  541.  
  542.     (*
  543.      *    See whether single keyword or bundle
  544.      *)
  545.  
  546.     IF ArgumentText [1] = '('
  547.     THEN
  548.     BEGIN
  549.  
  550.     (*
  551.      *  Is a bundle.  Do each word individually
  552.      *)
  553.  
  554.     Delete (ArgumentText, 1, 1);
  555.  
  556.     WHILE Length (ArgumentText) > 0
  557.     DO
  558.         BEGIN
  559.  
  560.         (*
  561.          *    Isolate the keyword
  562.          *)
  563.  
  564.         SearchIndex := 1;
  565.  
  566.         WHILE (SearchIndex <= Length (ArgumentText)) AND
  567.           (ArgumentText [SearchIndex] <> ',') AND
  568.           (ArgumentText [SearchIndex] <> ')')
  569.         DO
  570.         SearchIndex := SearchIndex + 1;
  571.  
  572.         IF SearchIndex > Length (ArgumentText)
  573.         THEN
  574.         BEGIN
  575.  
  576.         WriteLn ('Invalid unterminated argument value');
  577.         Halt
  578.  
  579.         END;
  580.  
  581.         IF SearchIndex = 1
  582.         THEN
  583.         BEGIN
  584.  
  585.         WriteLn ('Invalid null argument value');
  586.         Halt
  587.  
  588.         END;
  589.  
  590.         Keyword := Copy (ArgumentText, 1, SearchIndex - 1);
  591.  
  592.         (*
  593.          *    Set the appropriate bit
  594.          *)
  595.  
  596.         SetKeywordBit (Keyword, OptionMask);
  597.  
  598.         (*
  599.          *    Ensure proper separator format
  600.          *)
  601.  
  602.         IF SearchIndex = Length (ArgumentText)
  603.         THEN
  604.         BEGIN
  605.  
  606.         IF ArgumentText [SearchIndex] <> ')'
  607.         THEN
  608.             BEGIN
  609.  
  610.             WriteLn ('Invalid unterminated argument value');
  611.             Halt
  612.  
  613.             END
  614.  
  615.         END
  616.         ELSE
  617.         BEGIN
  618.  
  619.         IF ArgumentText [SearchIndex] <> ','
  620.         THEN
  621.             BEGIN
  622.  
  623.             WriteLn ('Invalid argument value after termination');
  624.             Halt
  625.  
  626.             END
  627.  
  628.         END;
  629.  
  630.         Delete (ArgumentText, 1, SearchIndex)
  631.  
  632.         END
  633.     END
  634.     ELSE
  635.  
  636.     (*
  637.      *  Argument value is single keyword
  638.      *)
  639.  
  640.     SetKeywordBit (ArgumentText, OptionMask)
  641.  
  642.     END;
  643. {.PA}
  644. PROCEDURE ParseCommandQualifiers;                    {003}
  645.  
  646. (***********************************************************************
  647.  
  648. FUNCTIONAL DESCRIPTION:
  649.  
  650.     Parses the command line for the ATTRIB program.
  651.  
  652.     The command line has the format:
  653.  
  654.     ATTRIB wildspec [option]...
  655.  
  656.     The ATTRIB token is typed by the user but is not part of the command
  657.     line tail retained by MS-DOS, and so does not  participate    in  this
  658.     parse.
  659.  
  660.     Wildspec is a single path specification which may contain wild  card
  661.     characters    in  the  last  component.  Any single token not starting
  662.     with the option character is accepted in this position.  This is not{003}
  663.     parsed by this routine.                        {003}
  664.  
  665.     Option is one of:
  666.  
  667.     /SET:value
  668.     /RESET:value or /CLEAR:value or /REMOVE:value            {004}
  669.     /[NO]LOG
  670.  
  671.     where 'value' is as accepted by  the  DoSetArgument  routine  above.
  672.     The  keywords  SET, CLEAR, REMOVE, and LOG may be abbreviated to any{004}
  673.     unique leading substring;  the keywords RESET and REMOVE may be  ab-{004}
  674.     breviated  all the way to R, permitted in this case as they are syn-{004}
  675.     onyms.                                {004}
  676.  
  677.     An equal sign (=) may be used in place of the colon.
  678.  
  679. FORMAL PARAMETERS:
  680.  
  681.     None.
  682.  
  683. RETURN VALUE:
  684.  
  685.     None.
  686.  
  687. IMPLICIT INPUTS:
  688.  
  689.     The command line tail at CS:0080.  [Actually, this    is  an    implicit
  690.     input of the CLA package which this routine uses.]
  691.     ResetMask - The mask of attribute bits to be reset.
  692.     SetMask - The mask of attribute bits to be set.
  693.  
  694. IMPLICIT OUTPUTS:
  695.  
  696.     OptionSpecifed - The  flag    determining  whether  any  options  were
  697.     specified on the command line.
  698.     ResetMask - The mask of attribute bits to be reset.
  699.     SetMask - The mask of attribute bits to be set.
  700.  
  701. SIDE EFFECTS:
  702.  
  703.     May write a message to the standard  output  and  terminate  program
  704.     execution under the following circumstances:
  705.  
  706.      -    A null option (slash with no other characters) is present in the
  707.     command
  708.      -    An unrecognized option (slash followed by something other than a
  709.     unique abbreviation of [NO]LOG, RESET, or SET) is present in the
  710.     command
  711.      -    A value is specified with [NO]LOG
  712.      -    No value is specified with RESET or SET
  713.      -    The attributes specified with /SET and /RESET are not disjoint.
  714.  
  715. ***********************************************************************)
  716.  
  717.     VAR
  718.  
  719.     DummyArg    : PathSpec;
  720.     Keyword     : PathSpec;
  721.     SearchIndex : INTEGER;
  722.     TargetMask  : ^ INTEGER;
  723.     ValueType   : INTEGER;
  724.  
  725.     BEGIN
  726.  
  727.     (*
  728.      *    Get all switches                        {003}
  729.      *)
  730.  
  731.     DummyArg := CommandLineArgument ('', '', TRUE);
  732.  
  733.     WHILE Length (DummyArg) > 0
  734.     DO
  735.     BEGIN
  736.  
  737.     (*
  738.      *  Delete the leading slash
  739.      *)
  740.  
  741.     Delete (DummyArg, 1, 1);
  742.     IF Length (DummyArg) = 0
  743.     THEN
  744.         BEGIN
  745.  
  746.         WriteLn ('Invalid null option');
  747.         Halt
  748.  
  749.         END;
  750.  
  751.     (*
  752.      *  Extract the keyword
  753.      *)
  754.  
  755.     SearchIndex := 1;
  756.     WHILE (SearchIndex <= Length (DummyArg)) AND
  757.           (DummyArg [SearchIndex] <> ':') AND
  758.           (DummyArg [SearchIndex] <> '=')
  759.     DO
  760.         SearchIndex := SearchIndex + 1;
  761.  
  762.     Keyword := Copy (DummyArg, 1, SearchIndex - 1);
  763.  
  764.     (*
  765.      *  Delete all but the keyword value
  766.      *)
  767.  
  768.     IF SearchIndex > Length (DummyArg)
  769.     THEN
  770.         SearchIndex := Length (DummyArg);
  771.     Delete (DummyArg, 1, SearchIndex);
  772.  
  773.     (*
  774.      *  Try to match the keyword to a possible keyword
  775.      *)
  776.  
  777.     IF PrefixLength (Keyword, 'LOG') > 0                {002}
  778.     THEN
  779.         BEGIN
  780.  
  781.         Logging := TRUE;
  782.         ValueType := 0
  783.  
  784.         END
  785.     ELSE IF PrefixLength (Keyword, 'NOLOG') > 2            {002}
  786.     THEN
  787.         BEGIN
  788.  
  789.         Logging := FALSE;
  790.         ValueType := 0
  791.  
  792.         END
  793.     ELSE IF PrefixLength (Keyword, 'SET') > 0            {002}
  794.     THEN
  795.         BEGIN
  796.  
  797.         TargetMask := Addr (SetMask);
  798.         ValueType  := 1
  799.  
  800.         END
  801.     ELSE IF (PrefixLength (Keyword, 'RESET')  > 0) OR        {004,002}
  802.         (PrefixLength (Keyword, 'CLEAR')  > 0) OR        {004}
  803.         (PrefixLength (Keyword, 'REMOVE') > 0)            {004}
  804.     THEN
  805.         BEGIN
  806.  
  807.         TargetMask := Addr (ResetMask);
  808.         ValueType  := 1
  809.  
  810.         END
  811.     ELSE IF PrefixLength (Keyword, 'HELP') > 0            {015}
  812.     THEN                                {015}
  813.         BEGIN                            {015}
  814.  
  815.         HelpDesired := TRUE;                    {015}
  816.         ValueType := 0                        {015}
  817.  
  818.         END                             {015}
  819.     ELSE IF PrefixLength (Keyword, 'NOHELP') > 2            {015}
  820.     THEN                                {015}
  821.         BEGIN                            {015}
  822.  
  823.         HelpDesired := FALSE;                    {015}
  824.         ValueType := 0                        {015}
  825.  
  826.         END                             {015}
  827.     ELSE
  828.         BEGIN
  829.  
  830.         WriteLn ('Invalid switch: "', Keyword, '"');
  831.         Halt
  832.  
  833.         END;
  834.  
  835.     (*
  836.      *  Parse the switch value
  837.      *)
  838.  
  839.     IF ValueType = 0
  840.     THEN
  841.         BEGIN
  842.  
  843.         IF Length (DummyArg) > 0
  844.         THEN
  845.         BEGIN
  846.  
  847.         WriteLn ('/LOG switch does not take value');
  848.         Halt
  849.  
  850.         END
  851.         END
  852.     ELSE
  853.         BEGIN
  854.  
  855.         IF Length (DummyArg) = 0
  856.         THEN
  857.         BEGIN
  858.  
  859.         WriteLn ('/SET and /RESET require value');
  860.         Halt
  861.  
  862.         END;
  863.  
  864.         DoSetArgument (DummyArg, TargetMask ^)
  865.  
  866.         END;
  867.  
  868.     (*                                {005}
  869.      *  Note option parsed                        {005}
  870.      *)                                {005}
  871.  
  872.     OptionSpecified := TRUE;                    {005}
  873.  
  874.     (*
  875.      *  Get next switch
  876.      *)
  877.  
  878.     DummyArg := CommandLineArgument ('', '', TRUE)
  879.  
  880.     END;
  881.  
  882.     (*
  883.      *    Check for non-interference of set and reset masks
  884.      *)
  885.  
  886.     IF (SetMask AND ResetMask) <> 0
  887.     THEN
  888.     BEGIN
  889.  
  890.     WriteLn ('Same attribute specified for both /SET and /RESET');
  891.     Halt
  892.  
  893.     END
  894.  
  895.     END;
  896. {.PA}
  897. (***********************************************************************
  898.  
  899. FUNCTIONAL DESCRIPTION:
  900.  
  901.     Manipulates attributes of files.
  902.  
  903. FORMAL PARAMETERS:
  904.  
  905.     None.
  906.  
  907. RETURN VALUE:
  908.  
  909.     None.
  910.  
  911. IMPLICIT INPUTS:
  912.  
  913.     Logging - The flag showing whether    attribute  messages  are  to  be
  914.     written to the standard output.
  915.     ResetMask - The mask of attribute bits to be reset in the files sel-
  916.     ected by WildSpec.
  917.     SetMask - The mask of attribute bits to be set in the files  select-
  918.     ed by WildSpec.
  919.  
  920. IMPLICIT OUTPUTS:
  921.  
  922.     None.
  923.  
  924. SIDE EFFECTS:
  925.  
  926.     May write messages to the standard output.
  927.     May modify attributes of files.
  928.  
  929. ***********************************************************************)
  930.  
  931. TYPE
  932.  
  933.     RegPack = RECORD
  934.     CASE INTEGER OF
  935.      0: (AX, BX, CX, DX, DP, SI, DI, DS, ES, Flags : INTEGER);
  936.      1: (AL, AH, BL, BH, CL, CH, DL, DH           : BYTE)
  937.     END;
  938.  
  939. VAR
  940.  
  941.     FileSpec  : PathSpec;
  942.     NewAttr   : INTEGER;
  943.     OldAttr   : INTEGER;
  944.     OutLine   : PathSpec;                        {010}
  945.     Registers : RegPack;
  946.     WildSpec  : PathSpec;                        {003}
  947.  
  948. BEGIN
  949.  
  950. (*                                    {012}
  951.  *  Set up Control/C trapping for program                {012}
  952.  *)                                    {012}
  953.  
  954. CtrlCSetup;                                {012,009}
  955.  
  956. (*
  957.  *  Print banner
  958.  *)
  959.  
  960. WriteLn ('ATTRIB version ', ProgramVersion);
  961. Flush (Output);                             {012}
  962.  
  963. (*
  964.  *  Parse the command line
  965.  *)
  966.  
  967. Logging     := TRUE;                        {003}
  968. OptionSpecified := FALSE;                        {005}
  969. HelpDesired    := FALSE;                        {015}
  970. ResetMask    := 0;                            {003}
  971. SetMask     := 0;                            {003}
  972.  
  973. ParseCommandQualifiers;                         {003}
  974.  
  975. WildSpec := CommandLineArgument ('', '', FALSE);            {005}
  976.  
  977. IF (Length (WildSpec) = 0) AND NOT OptionSpecified            {005}
  978. THEN                                    {005}
  979.     BEGIN                                {005}
  980.  
  981.     (*                                    {015}
  982.      *    A totally blank command line.  Assume *.* and  give  short  mes-{015}
  983.      *    sage.                                {015}
  984.      *)                                 {015}
  985.  
  986.     WildSpec := '*.*';                            {015}
  987.     WriteLn;                                {015}
  988.     WriteLn ('Use /HELP qualifier for help')                {015}
  989.  
  990.     END;                                {005}
  991.  
  992. (*                                    {015}
  993.  *  If help requested, give it                        {015}
  994.  *)                                    {015}
  995.  
  996. IF HelpDesired                                {015}
  997. THEN                                    {015}
  998.  
  999.     PrintHelp;                                {015}
  1000.  
  1001. (*                                    {006}
  1002.  *  Scan with each wild card specification                {006}
  1003.  *)                                    {006}
  1004.  
  1005. WHILE (NOT CtrlCOccurred) AND (Length (WildSpec) > 0)            {009,006}
  1006. DO                                    {006}
  1007.     BEGIN                                {006}
  1008.  
  1009.     (*                                    {007}
  1010.      *    Append *.* if path ends in : or \                {007}
  1011.      *)                                 {007}
  1012.  
  1013.     IF WildSpec [Length (WildSpec)] IN [':', '/', '\']            {007}
  1014.     THEN                                {007}
  1015.  
  1016.     Insert ('*.*', WildSpec, Length (WildSpec) + 1);        {007}
  1017.  
  1018.     (*                                    {007}
  1019.      *    Make the wild card path absolute                {007}
  1020.      *)                                 {007}
  1021.  
  1022.     MakePathAbsolute (WildSpec);                    {007}
  1023.  
  1024.     (*                                    {008}
  1025.      *    Log the specification                        {008}
  1026.      *)                                 {008}
  1027.  
  1028.     IF Logging                                {008}
  1029.     THEN                                {008}
  1030.     BEGIN                                {008}
  1031.  
  1032.     WriteLn;                            {008}
  1033.     WriteLn (WildSpec, ':')                     {008}
  1034.  
  1035.     END;                                {008}
  1036.  
  1037.     (*
  1038.      *    Initialize the wild card scan
  1039.      *)
  1040.  
  1041.     IF NOT WildExpandInitialize (WildSpec, $17)
  1042.     THEN
  1043.     BEGIN
  1044.  
  1045.     IF Logging                            {008}
  1046.     THEN                                {008}
  1047.  
  1048.         WriteLn ('  No files found')                {008}
  1049.  
  1050.     ELSE                                {008}
  1051.  
  1052.         WriteLn ('No files found for ', WildSpec)            {008}
  1053.  
  1054.     END                                {008}
  1055.     ELSE                                {006}
  1056.     BEGIN                                {006}
  1057.  
  1058.     WildExpandContinue (FileSpec, OldAttr);             {011}
  1059.  
  1060.     WHILE (NOT CtrlCOccurred) AND (Length (FileSpec) > 0)        {009}
  1061.     DO
  1062.         BEGIN
  1063.  
  1064.         (*
  1065.          *    Append NUL for MS-DOS
  1066.          *)
  1067.  
  1068.         FileSpec [Length (FileSpec) + 1] := #$00;
  1069.  
  1070.         (*
  1071.          *    Obtain changed attributes
  1072.          *)
  1073.  
  1074.         NewAttr := (OldAttr OR SetMask) AND NOT ResetMask;
  1075.  
  1076.         (*
  1077.          *    Modify attributes
  1078.          *)
  1079.  
  1080.         IF NewAttr <> OldAttr
  1081.         THEN
  1082.         BEGIN
  1083.  
  1084.         Registers . AH := $43;
  1085.         Registers . AL := $01;
  1086.         Registers . CX := NewAttr AND NOT AttrMaskSubDirectory;
  1087.         Registers . DS := Seg (FileSpec [1]);
  1088.         Registers . DX := Ofs (FileSpec [1]);
  1089.         MsDos (Registers)
  1090.  
  1091.         END
  1092.         ELSE                            {010}
  1093.  
  1094.         Registers . Flags := 0;                 {010}
  1095.  
  1096.         IF (Registers . Flags AND 1) <> 0
  1097.         THEN
  1098.  
  1099.         WriteLn ('Cannot change attributes for ', FileSpec)    {008}
  1100.  
  1101.         ELSE
  1102.         BEGIN
  1103.  
  1104.         (*
  1105.          *  List new attributes and file name
  1106.          *)
  1107.  
  1108.         IF Logging
  1109.         THEN
  1110.             BEGIN
  1111.  
  1112.             OutLine := '  ';                    {010}
  1113.             AppendString (BaseName (FileSpec), OutLine);    {010}
  1114.  
  1115.             IF (NewAttr AND AttrMaskArchive) <> 0
  1116.             THEN
  1117.             BEGIN                        {010}
  1118.             Pad (OutLine, 16);                {014,010}
  1119.             AppendString ('Arc', OutLine)            {010}
  1120.             END;                        {010}
  1121.  
  1122.             IF (NewAttr AND AttrMaskSubDirectory) <> 0
  1123.             THEN
  1124.             BEGIN                        {010}
  1125.             Pad (OutLine, 20);                {014,010}
  1126.             AppendString ('Dir', OutLine)            {010}
  1127.             END;                        {010}
  1128.  
  1129.             IF (NewAttr AND AttrMaskReadOnly) <> 0
  1130.             THEN
  1131.             BEGIN                        {010}
  1132.             Pad (OutLine, 24);                {014,010}
  1133.             AppendString ('R/O', OutLine)            {010}
  1134.             END;                        {010}
  1135.  
  1136.             IF (NewAttr AND AttrMaskHidden) <> 0
  1137.             THEN
  1138.             BEGIN                        {010}
  1139.             Pad (OutLine, 28);                {014,010}
  1140.             AppendString ('Hid', OutLine)            {010}
  1141.             END;                        {010}
  1142.  
  1143.             IF (NewAttr AND AttrMaskSystem) <> 0
  1144.             THEN
  1145.             BEGIN                        {010}
  1146.             Pad (OutLine, 32);                {014,010}
  1147.             AppendString ('Sys', OutLine)            {010}
  1148.             END;                        {010}
  1149.  
  1150.             WriteLn (OutLine);                    {010,008}
  1151.             Flush (Output)                    {009}
  1152.  
  1153.             END
  1154.         END;
  1155.  
  1156.         WildExpandContinue (FileSpec, OldAttr)            {011}
  1157.  
  1158.         END                             {006}
  1159.     END;
  1160.  
  1161.     WildSpec := CommandLineArgument ('', '', FALSE)            {006}
  1162.  
  1163.     END                                 {006}
  1164. END.
  1165.