PROGRAM FileAttributes; {$G128,P128,D-} {010,001} CONST ProgramVersion = '1.0'; (*********************************************************************** This software has been placed into the public domain by Digital Equipment Corporation. DISCLAIMER: The information herein is subject to change without notice and should not be construed as a commitment by Digital Equipment Corporation. Digital Equipment Corporation assumes no responsibility for the use or reliability of this software. This software is provided "as is," without any warranty of any kind, express or implied. Digital Equipment Corporation will not be liable in any event for any damages including any loss of data, profit, or savings, claims against the user by any other party, or any other incidental or consequential damages arising out of the use of, or inability to use, this software, even if Digital Equipment Corporation is advised of the possibility of such damage. DEFECT REPORTING AND SUGGESTIONS: Please send reports of defects or suggestions for improvement directly to the author: Brian Hetrick Digital Equipment Corporation 110 Spit Brook Road ZKO1-3/J10 Nashua NH 03062-2698 Do NOT file a Software Performance Report on this software, call the Telephone Support Center regarding this software, contact your Digital Field Office regarding this software, or use any other mechanism provided for Digital's supported and warranted software. FACILITY: MS-DOS user utilities ABSTRACT: Manipulates attributes of files ENVIRONMENT: MS-DOS V2.0 or later compiled with Borland International's TURBO Pascal V3.0 or later AUTHOR: Brian Hetrick, CREATION DATE: 24 November 1986. MODIFIED BY: Brian Hetrick, 24-Nov-86: Version Y1.0-0 000 - Original creation of module. Released to selected Easynet sites for beta test on 24 November 1986. Brian Hetrick, 02-Dec-86: Version Y1.0-8 001 - Add Gn, Pn compiler directives for compilation on IBM PC clones. 002 - Modify IsPrefix routine to PrefixLength for command qualifiers starting with same letter. 003 - Parse command qualifiers before and after parsing file spec, as bad command qualifier with no file spec prompts for file spec before detecting bad command qualifer. 004 - Add /CLEAR and /REMOVE synonyms for /RESET. 005 - Add help message if no command line given. 006 - Allow multiple wild card specs. 007 - Make path specifications absolute before reporting. 008 - List file names on left side of display. Released to selected Easynet sites for beta test on 2 December 1986. Brian Hetrick, 16-Dec-86: Version Y1.0-14 009 - Use CtlCTrap package to trap CTRL/C, as TURBO Pascal's CTRL/C is not as desired. The undesired behavior (waiting for a Read or ReadLn to abort the program) appears to occur only on MS-DOS or PC-DOS V2.x. The PC-DOS specific TURBO Pascal had this un- desired behavior all along, but MS-DOS generic TURBO Pascals be- fore version 3.02A did not have this behavior on the Rainbow (due to a bug in how the TURBO CTRL/C handler was set up), where most testing occurred. The undesired behavior was noticed by a beta test site using ATTRIB Y1.0-8, the first release compiled with TURBO Pascal 3.02A, when it was impossible to CTRL/C out of listings that were hit with the performance bug handled in edit 011. 010 - Construct print lines as a whole and omit trailing spaces. Add the D- compiler directive and Flush (Output) to speed things up. This also makes all program-generated text finally go to the MS- -DOS standard output: even with Pn, TURBO will use IBM PC ROM BIOS calls if the standard output is the console. 011 - Retain attribute from wild card lookup. This considerably improves performance in highly fragmented directories. 012 - CTRL/C entered in response to the ReadLn in CLA.PAS does *NOT* abort the program at least under PC-DOS V2.10. Apparently, using the Gn,Pn,D- set of compiler directives entirely defeats ^C detection. So use the ^C package even for command line pars- ing. 013 - Detect CTRL/Z entered in response to ReadLn in CLA.PAS. 014 - Reorder attributes in listing to put Arc and Dir, the most pop- ular attributes, first. Released to selected Easynet sites for beta test on 17 December 1986. Brian Hetrick, 30-Jan-87: Version Y1.0-16 015 - Introduce /HELP switch to give long help message; if no command line given, give short message and assume *.*. Remove prompting for command parameters as there is now a 'reasonable' default. 016 - Make help text less dense, as it is now explicitly requested and the user is presumably ready to deal with it. Brian Hetrick, 30-Jan-87: Version 1.0 017 - Delete internal use only notice, copyright notice, etc., and set version number to have no prefix or edit suffix, as will be re- leased to DECUS Program Library. Released to Easynet sites and DECUS Program Library 30 January 1987. ***********************************************************************) {.PA} (* * INCLUDE FILES: *) {$I CtlCTrap.Pas} {009} {$I CLA.PAS} {$I WildExpa.Pas} {$I MakeAbs.Pas} {007} {$I BaseName.Pas} {008} (* * LABEL DECLARATIONS: *) (* * CONSTANT DECLARATIONS: *) CONST AttrMaskReadOnly = 1; AttrMaskHidden = 2; AttrMaskSystem = 4; AttrMaskSubDirectory = 16; AttrMaskArchive = 32; (* * TYPE DECLARATIONS: *) TYPE PathSpec = WildExpandPathSpec; {011} (* * OWN STORAGE: *) VAR Logging : BOOLEAN; HelpDesired : BOOLEAN; {015} OptionSpecified : BOOLEAN; {005} ResetMask : INTEGER; SetMask : INTEGER; (* * TABLE OF CONTENTS: *) {.PA} PROCEDURE PrintHelp; {005} (***********************************************************************{005} FUNCTIONAL DESCRIPTION: {005} Writes a description of the program on the standard output. {005} FORMAL PARAMETERS: {005} None. {005} RETURN VALUE: {005} None. {005} IMPLICIT INPUTS: {005} None. {005} IMPLICIT OUTPUTS: {005} None. {005} SIDE EFFECTS: {005} None. {005} ***********************************************************************){005} BEGIN {005} WriteLn; {016} WriteLn ('Command line: ATTRIB filespec [qualifier]...'); {005} WriteLn; {016} WriteLn ('''filespec'' is a path specification possibly with wild card characters'); {005} WriteLn (' in the last component'); {005} WriteLn; {016} WriteLn ('''qualifier'' is one of /[NO]HELP, /[NO]LOG, /SET:value, /RESET:value,'); {005} WriteLn (' /CLEAR:value, /REMOVE:value'); {005} WriteLn; {016} WriteLn (' /SET grants attributes'); {016} WriteLn (' /RESET, /CLEAR, and /REMOVE remove attributes'); {016} WriteLn; {016} WriteLn ('''value'' is either name or (name[,name]...)'); {005} WriteLn; {016} WriteLn ('''name'' is one of ARCHIVE, HIDDEN, SYSTEM, READ_ONLY'); {005} WriteLn; {016} WriteLn ('All keywords may be uniquely abbreviated') {005} END; {005} {.PA} FUNCTION PrefixLength {002} ( Str1 : PathSpec; Str2 : PathSpec) : INTEGER; {002} (*********************************************************************** FUNCTIONAL DESCRIPTION: Determines whether one string is a prefix of another, ignoring the case of letters. FORMAL PARAMETERS: TestString.rt.v - The string which may be a prefix of TargetString. TargetString.rt.v - The string of which TestString may be a prefix. RETURN VALUE: Zero: TestString is not a prefix of TargetString. {002} n>0: TestString is a prefix of TargetString and has n characters. {002} IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: None. ***********************************************************************) VAR Chr1 : CHAR; Chr2 : CHAR; Index : INTEGER; BEGIN IF Length (Str1) <= Length (Str2) THEN BEGIN (* * Test string is no longer than target string, so check char- * acters *) PrefixLength := Length (Str1); {002} FOR Index := 1 TO Length (Str1) DO BEGIN Chr1 := UpCase (Str1 [Index]); Chr2 := UpCase (Str2 [Index]); IF Chr1 <> Chr2 THEN BEGIN {002} (* * A mismatch was found, test string is not a prefix of * target string *) PrefixLength := 0; {002} Exit {002} END {002} END END ELSE (* * Test string is longer than target string and so cannot be a * prefix *) PrefixLength := 0 {002} END; {.PA} PROCEDURE Pad {010,008} (VAR StringText : PathSpec; {010,008} PadLength : INTEGER); {010,008} (***********************************************************************{008} FUNCTIONAL DESCRIPTION: {008} Adjusts a string by truncating the rightmost characters or padding{008} on the right with spaces to be a specified length. {008} FORMAL PARAMETERS: {008} StringToPad.rt.v - The string to be adjusted. {008} DesiredLength.rg.v - The length of the result string. {008} RETURN VALUE: {008} None. {010} IMPLICIT INPUTS: {008} None. {008} IMPLICIT OUTPUTS: {008} None. {008} SIDE EFFECTS: {008} None. {008} ***********************************************************************){008} VAR {008} StuffIndex : INTEGER; {008} BEGIN {008} (* {008} * Pad on the right with blanks {008} *) {008} FOR StuffIndex := Length (StringText) + 1 TO PadLength {008} DO {008} StringText [StuffIndex] := ' '; {010,008} (* {008} * Adjust the length {008} *) {008} StringText [0] := Chr (PadLength) {010,008} END; {008} {.PA} PROCEDURE AppendString {010} ( InsertString : PathSpec; {010} VAR TargetString : PathSpec); {010} (***********************************************************************{010} FUNCTIONAL DESCRIPTION: {010} Appends one string to another. {010} FORMAL PARAMETERS: {010} StringToAdd.rt.v - The string to be appended to TargetString. {010} TargetString.mt.r - The string to which StringToAdd is to be ap- {010} pended. {010} RETURN VALUE: {010} None. {010} IMPLICIT INPUTS: {010} None. {010} IMPLICIT OUTPUTS: {010} None. {010} SIDE EFFECTS: {010} None. {010} ***********************************************************************){010} BEGIN {010} Insert (InsertString, TargetString, Length (TargetString) + 1) {010} END; {010} {.PA} PROCEDURE SetKeywordBit ( KeywordText : PathSpec; VAR OptionMask : INTEGER); (*********************************************************************** FUNCTIONAL DESCRIPTION: Sets the bit in an attribute mask designated by a keyword. The key- word is any of ARCHIVE, HIDDEN, READ_ONLY, or SYSTEM, or any leading abbreviation of one of these keywords. FORMAL PARAMETERS: Keyword.rt.v - The keyword designating an attribute. AttributeMask.mg.r - The attribute mask in which the bit correspond- ing to the keyword is to be set. RETURN VALUE: None. IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: If Keyword is not an abbreviation of one of the valid keywords, an error mesage is written to the standard output and the program is terminated. ***********************************************************************) BEGIN (* * Check against list and set appropriate bit *) IF PrefixLength (KeywordText, 'HIDDEN') > 0 {002} THEN OptionMask := OptionMask OR AttrMaskHidden ELSE IF PrefixLength (KeywordText, 'SYSTEM') > 0 {002} THEN OptionMask := OptionMask OR AttrMaskSystem ELSE IF PrefixLength (KeywordText, 'READ_ONLY') > 0 {002} THEN OptionMask := OptionMask OR AttrMaskReadOnly ELSE IF PrefixLength (KeywordText, 'ARCHIVE') > 0 {002} THEN OptionMask := OptionMask OR AttrMaskArchive ELSE BEGIN WriteLn ('Invalid argument value: "', KeywordText, '"'); Halt END END; {.PA} PROCEDURE DoSetArgument ( ArgumentText : PathSpec; VAR OptionMask : INTEGER); (*********************************************************************** FUNCTIONAL DESCRIPTION: Parses the value to the /SET or /RESET option. The syntax of these values is: keyword (keyword[,keyword]...]) where 'keyword' is one of ARCHIVE, HIDDEN, READ_ONLY, or SYSTEM, or a unique leading abbreviation of one of these. FORMAL PARAMETERS: ValueText.rt.v - The text of the value to be parsed. AttributeMask.mg.r - The attribute mask in which the bits cor- responding to the keywords are to be set. RETURN VALUE: None. IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: May write a message to the standard output and halt program execut- ion under the following circumstances: - ValueText consists only of '('; - ValueText starts with '(' but does not end with ')'; - ValueText has ')' before the end of the string; - ValueText has two adjacent commas. ***********************************************************************) VAR KeyWord : PathSpec; SearchIndex : INTEGER; BEGIN (* * See whether single keyword or bundle *) IF ArgumentText [1] = '(' THEN BEGIN (* * Is a bundle. Do each word individually *) Delete (ArgumentText, 1, 1); WHILE Length (ArgumentText) > 0 DO BEGIN (* * Isolate the keyword *) SearchIndex := 1; WHILE (SearchIndex <= Length (ArgumentText)) AND (ArgumentText [SearchIndex] <> ',') AND (ArgumentText [SearchIndex] <> ')') DO SearchIndex := SearchIndex + 1; IF SearchIndex > Length (ArgumentText) THEN BEGIN WriteLn ('Invalid unterminated argument value'); Halt END; IF SearchIndex = 1 THEN BEGIN WriteLn ('Invalid null argument value'); Halt END; Keyword := Copy (ArgumentText, 1, SearchIndex - 1); (* * Set the appropriate bit *) SetKeywordBit (Keyword, OptionMask); (* * Ensure proper separator format *) IF SearchIndex = Length (ArgumentText) THEN BEGIN IF ArgumentText [SearchIndex] <> ')' THEN BEGIN WriteLn ('Invalid unterminated argument value'); Halt END END ELSE BEGIN IF ArgumentText [SearchIndex] <> ',' THEN BEGIN WriteLn ('Invalid argument value after termination'); Halt END END; Delete (ArgumentText, 1, SearchIndex) END END ELSE (* * Argument value is single keyword *) SetKeywordBit (ArgumentText, OptionMask) END; {.PA} PROCEDURE ParseCommandQualifiers; {003} (*********************************************************************** FUNCTIONAL DESCRIPTION: Parses the command line for the ATTRIB program. The command line has the format: ATTRIB wildspec [option]... The ATTRIB token is typed by the user but is not part of the command line tail retained by MS-DOS, and so does not participate in this parse. Wildspec is a single path specification which may contain wild card characters in the last component. Any single token not starting with the option character is accepted in this position. This is not{003} parsed by this routine. {003} Option is one of: /SET:value /RESET:value or /CLEAR:value or /REMOVE:value {004} /[NO]LOG where 'value' is as accepted by the DoSetArgument routine above. The keywords SET, CLEAR, REMOVE, and LOG may be abbreviated to any{004} unique leading substring; the keywords RESET and REMOVE may be ab-{004} breviated all the way to R, permitted in this case as they are syn-{004} onyms. {004} An equal sign (=) may be used in place of the colon. FORMAL PARAMETERS: None. RETURN VALUE: None. IMPLICIT INPUTS: The command line tail at CS:0080. [Actually, this is an implicit input of the CLA package which this routine uses.] ResetMask - The mask of attribute bits to be reset. SetMask - The mask of attribute bits to be set. IMPLICIT OUTPUTS: OptionSpecifed - The flag determining whether any options were specified on the command line. ResetMask - The mask of attribute bits to be reset. SetMask - The mask of attribute bits to be set. SIDE EFFECTS: May write a message to the standard output and terminate program execution under the following circumstances: - A null option (slash with no other characters) is present in the command - An unrecognized option (slash followed by something other than a unique abbreviation of [NO]LOG, RESET, or SET) is present in the command - A value is specified with [NO]LOG - No value is specified with RESET or SET - The attributes specified with /SET and /RESET are not disjoint. ***********************************************************************) VAR DummyArg : PathSpec; Keyword : PathSpec; SearchIndex : INTEGER; TargetMask : ^ INTEGER; ValueType : INTEGER; BEGIN (* * Get all switches {003} *) DummyArg := CommandLineArgument ('', '', TRUE); WHILE Length (DummyArg) > 0 DO BEGIN (* * Delete the leading slash *) Delete (DummyArg, 1, 1); IF Length (DummyArg) = 0 THEN BEGIN WriteLn ('Invalid null option'); Halt END; (* * Extract the keyword *) SearchIndex := 1; WHILE (SearchIndex <= Length (DummyArg)) AND (DummyArg [SearchIndex] <> ':') AND (DummyArg [SearchIndex] <> '=') DO SearchIndex := SearchIndex + 1; Keyword := Copy (DummyArg, 1, SearchIndex - 1); (* * Delete all but the keyword value *) IF SearchIndex > Length (DummyArg) THEN SearchIndex := Length (DummyArg); Delete (DummyArg, 1, SearchIndex); (* * Try to match the keyword to a possible keyword *) IF PrefixLength (Keyword, 'LOG') > 0 {002} THEN BEGIN Logging := TRUE; ValueType := 0 END ELSE IF PrefixLength (Keyword, 'NOLOG') > 2 {002} THEN BEGIN Logging := FALSE; ValueType := 0 END ELSE IF PrefixLength (Keyword, 'SET') > 0 {002} THEN BEGIN TargetMask := Addr (SetMask); ValueType := 1 END ELSE IF (PrefixLength (Keyword, 'RESET') > 0) OR {004,002} (PrefixLength (Keyword, 'CLEAR') > 0) OR {004} (PrefixLength (Keyword, 'REMOVE') > 0) {004} THEN BEGIN TargetMask := Addr (ResetMask); ValueType := 1 END ELSE IF PrefixLength (Keyword, 'HELP') > 0 {015} THEN {015} BEGIN {015} HelpDesired := TRUE; {015} ValueType := 0 {015} END {015} ELSE IF PrefixLength (Keyword, 'NOHELP') > 2 {015} THEN {015} BEGIN {015} HelpDesired := FALSE; {015} ValueType := 0 {015} END {015} ELSE BEGIN WriteLn ('Invalid switch: "', Keyword, '"'); Halt END; (* * Parse the switch value *) IF ValueType = 0 THEN BEGIN IF Length (DummyArg) > 0 THEN BEGIN WriteLn ('/LOG switch does not take value'); Halt END END ELSE BEGIN IF Length (DummyArg) = 0 THEN BEGIN WriteLn ('/SET and /RESET require value'); Halt END; DoSetArgument (DummyArg, TargetMask ^) END; (* {005} * Note option parsed {005} *) {005} OptionSpecified := TRUE; {005} (* * Get next switch *) DummyArg := CommandLineArgument ('', '', TRUE) END; (* * Check for non-interference of set and reset masks *) IF (SetMask AND ResetMask) <> 0 THEN BEGIN WriteLn ('Same attribute specified for both /SET and /RESET'); Halt END END; {.PA} (*********************************************************************** FUNCTIONAL DESCRIPTION: Manipulates attributes of files. FORMAL PARAMETERS: None. RETURN VALUE: None. IMPLICIT INPUTS: Logging - The flag showing whether attribute messages are to be written to the standard output. ResetMask - The mask of attribute bits to be reset in the files sel- ected by WildSpec. SetMask - The mask of attribute bits to be set in the files select- ed by WildSpec. IMPLICIT OUTPUTS: None. SIDE EFFECTS: May write messages to the standard output. May modify attributes of files. ***********************************************************************) TYPE RegPack = RECORD CASE INTEGER OF 0: (AX, BX, CX, DX, DP, SI, DI, DS, ES, Flags : INTEGER); 1: (AL, AH, BL, BH, CL, CH, DL, DH : BYTE) END; VAR FileSpec : PathSpec; NewAttr : INTEGER; OldAttr : INTEGER; OutLine : PathSpec; {010} Registers : RegPack; WildSpec : PathSpec; {003} BEGIN (* {012} * Set up Control/C trapping for program {012} *) {012} CtrlCSetup; {012,009} (* * Print banner *) WriteLn ('ATTRIB version ', ProgramVersion); Flush (Output); {012} (* * Parse the command line *) Logging := TRUE; {003} OptionSpecified := FALSE; {005} HelpDesired := FALSE; {015} ResetMask := 0; {003} SetMask := 0; {003} ParseCommandQualifiers; {003} WildSpec := CommandLineArgument ('', '', FALSE); {005} IF (Length (WildSpec) = 0) AND NOT OptionSpecified {005} THEN {005} BEGIN {005} (* {015} * A totally blank command line. Assume *.* and give short mes-{015} * sage. {015} *) {015} WildSpec := '*.*'; {015} WriteLn; {015} WriteLn ('Use /HELP qualifier for help') {015} END; {005} (* {015} * If help requested, give it {015} *) {015} IF HelpDesired {015} THEN {015} PrintHelp; {015} (* {006} * Scan with each wild card specification {006} *) {006} WHILE (NOT CtrlCOccurred) AND (Length (WildSpec) > 0) {009,006} DO {006} BEGIN {006} (* {007} * Append *.* if path ends in : or \ {007} *) {007} IF WildSpec [Length (WildSpec)] IN [':', '/', '\'] {007} THEN {007} Insert ('*.*', WildSpec, Length (WildSpec) + 1); {007} (* {007} * Make the wild card path absolute {007} *) {007} MakePathAbsolute (WildSpec); {007} (* {008} * Log the specification {008} *) {008} IF Logging {008} THEN {008} BEGIN {008} WriteLn; {008} WriteLn (WildSpec, ':') {008} END; {008} (* * Initialize the wild card scan *) IF NOT WildExpandInitialize (WildSpec, $17) THEN BEGIN IF Logging {008} THEN {008} WriteLn (' No files found') {008} ELSE {008} WriteLn ('No files found for ', WildSpec) {008} END {008} ELSE {006} BEGIN {006} WildExpandContinue (FileSpec, OldAttr); {011} WHILE (NOT CtrlCOccurred) AND (Length (FileSpec) > 0) {009} DO BEGIN (* * Append NUL for MS-DOS *) FileSpec [Length (FileSpec) + 1] := #$00; (* * Obtain changed attributes *) NewAttr := (OldAttr OR SetMask) AND NOT ResetMask; (* * Modify attributes *) IF NewAttr <> OldAttr THEN BEGIN Registers . AH := $43; Registers . AL := $01; Registers . CX := NewAttr AND NOT AttrMaskSubDirectory; Registers . DS := Seg (FileSpec [1]); Registers . DX := Ofs (FileSpec [1]); MsDos (Registers) END ELSE {010} Registers . Flags := 0; {010} IF (Registers . Flags AND 1) <> 0 THEN WriteLn ('Cannot change attributes for ', FileSpec) {008} ELSE BEGIN (* * List new attributes and file name *) IF Logging THEN BEGIN OutLine := ' '; {010} AppendString (BaseName (FileSpec), OutLine); {010} IF (NewAttr AND AttrMaskArchive) <> 0 THEN BEGIN {010} Pad (OutLine, 16); {014,010} AppendString ('Arc', OutLine) {010} END; {010} IF (NewAttr AND AttrMaskSubDirectory) <> 0 THEN BEGIN {010} Pad (OutLine, 20); {014,010} AppendString ('Dir', OutLine) {010} END; {010} IF (NewAttr AND AttrMaskReadOnly) <> 0 THEN BEGIN {010} Pad (OutLine, 24); {014,010} AppendString ('R/O', OutLine) {010} END; {010} IF (NewAttr AND AttrMaskHidden) <> 0 THEN BEGIN {010} Pad (OutLine, 28); {014,010} AppendString ('Hid', OutLine) {010} END; {010} IF (NewAttr AND AttrMaskSystem) <> 0 THEN BEGIN {010} Pad (OutLine, 32); {014,010} AppendString ('Sys', OutLine) {010} END; {010} WriteLn (OutLine); {010,008} Flush (Output) {009} END END; WildExpandContinue (FileSpec, OldAttr) {011} END {006} END; WildSpec := CommandLineArgument ('', '', FALSE) {006} END {006} END.