home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB18.ZIP / SETAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-03  |  11.4 KB  |  348 lines
  1. { PC-DOS 2.xx File Attribute Editor, Version 2.04, by Rick Housh, 3/5/85.
  2.  THIS PROGRAM WILL NOT WORK PROPERLY WITH A COMMAND LINE ARGUMENT UNTIL
  3.  COMPILED TO A .COM FILE BECAUSE IT MUST SCAN THE MS-DOS COMMAND LINE AT
  4.  THE SYSTEM LEVEL.  My sincere apologies to Mr. Wirth for the "Goto".
  5.  Written in TURBO PASCAL, Version 3.01A.  Modified last on 7/27/85.
  6.  
  7. N.B. Be very careful when using this program with directories, especially
  8. with hard disks.  You can make your directory invisible to the normal oper-
  9. ating system commands.}
  10.  
  11.  
  12. Program Read_and_Set_File_Attributes;
  13.  
  14. {$C-}  {For faster screen writes-can always use abort option anyway}
  15.  
  16.   Const                                {Names for the attribute bits}
  17.  
  18.     NowSet: Array [0..7] Of String[33]=
  19.           ('Read only','Hidden','System','Volume label','Directory name',
  20.            'Unarchived','Illegal Byte Value (2nd bit set)',
  21.            'Illegal Byte Value (1st bit set)');
  22.  
  23.     SetTo: Array [0..7] Of String[12]=
  24.           ('Read only','Read/write','Hidden','Not hidden',
  25.            'System','Non-system','Unarchived','Archived');
  26.  
  27.            {We could have allowed the setting of the (presently) illegal
  28.             first and second bits here, for some use of our own,
  29.             but it will probably conflict with some future legal
  30.             use}
  31.  
  32.   Label
  33.     Start_here;                        {Sorry, but it's so much easier}
  34.  
  35.   Type
  36.  
  37.     FileNames=String[65];
  38.  
  39.     DataTransArea=Record        {Record of File Control Block + some buffers}
  40.  
  41.           KeyboardBufferAndOtherStuffWeDontNeed: Array [0..20] Of Byte;
  42.           AttribByte: Byte;
  43.           Time_Date_Size1_Size2: Array [0..3] Of Integer; {Maybe use it later}
  44.           FileName: Array [0..12] Of Char;
  45.         End;
  46.  
  47.     RegisterSet=Record Case Integer Of {Standard MS-DOS RegPack}
  48.  
  49.                   1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  50.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  51.                 End;
  52.  
  53.   Var
  54.  
  55.     DirAndOrPath,Mask,CurrentFile: FileNames;
  56.     CurDataTransArea: ^DataTransArea;
  57.     Regs: RegisterSet;
  58.     Finished,None,AttributeChanged,AnAttributeSet: Boolean;
  59.     A,BitPattern,Index,J,P : Byte;
  60.     C,ERR : Integer;
  61.     Choice: String[2];
  62.     Dummy: String[1];
  63.     This: String[12];
  64.  
  65.  
  66. Procedure Warble;
  67.   Begin
  68.     For A := 1 to 3 do
  69.       Begin
  70.         Sound(440);
  71.         Delay(50);
  72.         Sound(660);
  73.         Delay(50);
  74.         NoSound;
  75.       End;
  76.   End; {Procedure Warble}
  77.  
  78. Procedure Beep;
  79.   Begin
  80.     Sound(440);
  81.     Delay(100);
  82.     NoSound;
  83.   End; {Procedure Beep}
  84.  
  85.  
  86. Begin
  87.  
  88. {Introduction}
  89.  P:=1;
  90.  If ParamCount > 0 then if ParamStr(1) = ('?') then P := 0;
  91.  If ParamCount = 0 then P:=0;
  92.  If P = 0 then
  93.   Begin
  94.     ClrScr;
  95.     WriteLn('File attribute program, by T. A. Housh, Jr.');
  96.     WriteLn;
  97.     LowVideo;
  98.     WriteLn('This program will allow you to view and change the attributes');
  99.     WriteLn('of an MS-DOS 2.xx file.');
  100.     WriteLn;
  101.     WriteLn('You may use wild cards or not, as you choose.');
  102.     WriteLn;
  103.     WriteLn('If you wish to examine a whole directory or disk just specify the');
  104.     WriteLn('drive or path in the usual way, e.g. a: or b:\bin or whatever.');
  105.     WriteLn('You may specify this parameter in the command line, or if');
  106.     WriteLn('you wish, you may enter the program without a file parameter, in');
  107.     WriteLn('which case this message will be displayed, and you will then be');
  108.     WriteLn('prompted for a file name or other parameter.  If you enter a carriage');
  109.     WriteLn('return in response, the file parameter will default to *.* on the');
  110.     WriteLn('default drive and/or directory.  If you enter SETATR ? you will');
  111.     WriteLn('receive this message and the program will terminate.');
  112.     WriteLn;
  113.     WriteLn('The designation "(No exceptions)" indicates no special attributes set,');
  114.     WriteLn('that is, the file is read/write, non-system, not hidden, and has been');
  115.     WriteLn('archived.');
  116.     If ParamStr(1) = ('?') then Halt;
  117.     WriteLn;
  118.   end;
  119.  
  120. {Now look for a parameter in the command line}
  121. If P =1 then Mask:=ParamStr(1) else Mask:=('');
  122.  
  123. (*Could define Mask as an array of ParamStr, with an index of 1..ParamCount
  124. and loop through the whole program until MaxParamcount is reached, allowing
  125. multiple files to be specified in the command line without wild cards..a
  126. thought, but its getting pretty large already.*)
  127.  
  128.     If Mask='' Then
  129.  
  130. Start_Here: {If file name not specified, or restart requested, ask for target}
  131.  
  132.      Begin
  133.      WriteLn;
  134.      Write('Enter file name: ');
  135.       ReadLn(Mask);
  136.      End;
  137.  
  138. {START OF FILE SEARCH}
  139.  
  140. {Parse file name, force to upper case, look for directories and paths.}
  141.  
  142.     For Index:=1 To Length(Mask) Do
  143.      Mask[Index]:=UpCase(Mask[Index]);
  144.     Index:=Pos('\',Mask);
  145.     If Pos(':',Mask)<>0 Then Index:=Pos(':',Mask);
  146.     If Index<>0 Then
  147.       Repeat
  148.         J:=Pos('\',Copy(Mask,Index+1,64));
  149.         Index:=Index+J;
  150.       Until J=0;
  151.     DirAndOrPath:=Copy(Mask,1,Index);
  152.  
  153. {If only directory or path, set wildcards for all files.}
  154.  
  155.     If DirAndOrPath=Mask Then Mask:=Mask+'*.*';
  156.  
  157. {Go to disk directory, get first (or only) file.}
  158.  
  159.     Mask[Length(Mask)+1]:=Chr(0);
  160.     With Regs Do
  161.      Begin
  162.       AH:=$2F;                         {Get Data Transfer Address (DTA)}
  163.       MsDos(Regs);
  164.       CurDataTransArea:=Ptr(ES,BX);
  165.       AH:=$4E;                         {Search for first}
  166.       DS:=Seg(Mask[1]);
  167.       DX:=Ofs(Mask[1]);
  168.       CX:=$17;
  169.       MsDos(Regs);
  170.       Finished:=False;
  171.       None:=True;
  172.  
  173. {START OF MAIN PROGRAM LOOP}
  174.  
  175. {If drive, directory, path, or file not found, display error and terminate.}
  176.  
  177.    Repeat
  178.         This:='';
  179.         WriteLn;
  180.         If (Flags And 1)<>0 Then
  181.          Begin
  182.           Beep;
  183.           HighVideo;
  184. (*For some reason the following I/O error detection does not work*)
  185.           Case AX Of                   {Limited Error Return Detection}
  186.            $02: Write('File not found');
  187.            $03: Write('Directory or path not found');
  188.            $05: Write('Access denied.  Illegal device specified');
  189.            $06: Write('Access denied. Invalid file handle');
  190.            $0F: Write('Invalid drive specified');
  191.            $12: If None Then Write('Specified file ',Mask,' not found');
  192.             else Write('Unknown error ');
  193.            End;
  194.           LowVideo;
  195.           WriteLn;
  196.           Finished:=True;
  197.          End
  198.         Else
  199.  
  200. {If no error, then get first file and show attribute data.}
  201.  
  202.          Begin
  203.           ERR:=0;
  204.           None:=False;
  205.           CurrentFile:=DirAndOrPath+
  206.             Copy(CurDataTransArea^.FileName,1,
  207.             Pos(#0,CurDataTransArea^.FileName));
  208.  
  209. {START OF RECYCLE LOOP}
  210.  
  211.         Repeat;
  212.           ClrScr;
  213.           LowVideo;
  214.           Write('File Attribute Program.  Looking at: ');
  215.           TextBackGround(White);
  216.           TextColor(Black);
  217.           WriteLn(Mask);
  218.           LowVideo;
  219.           If ERR<>0 Then
  220.            Begin
  221.              GotoXY(1,3);
  222.              Warble;
  223.              TextColor(LightGray + Blink);
  224.              Write('Input error - ');
  225.              HighVideo;
  226.              WriteLN(' Try again.');
  227.              LowVideo;
  228.              ERR:=0;
  229.            End;
  230.           GotoXY(1,5);
  231.           Write('Current File  -> ');
  232.           TextColor(White + Blink);
  233.           Write(Copy(CurrentFile,1,Length(CurrentFile)-1));
  234.           If This <> '' Then
  235.             Begin
  236.              NormVideo;
  237.              Write(' reset to ');
  238.              HighVideo;
  239.              Write(This,'.');
  240.              Beep;
  241.              NormVideo;
  242.             End;
  243.           WriteLn;
  244.           NormVideo;
  245.           AX:=$4300;                   {Read current file attribute byte}
  246.           DS:=Seg(CurrentFile[1]);
  247.           DX:=Ofs(CurrentFile[1]);
  248.           MsDos(Regs);
  249.           BitPattern:=CX;
  250.           GotoXY(1,7);
  251.           Write('Normal, except-> ');
  252.           HighVideo;
  253.           Write(#221);
  254.           LowVideo;
  255.           AnAttributeSet:=False;
  256.           For Index:=0 To 7 Do
  257.             If BitPattern And (1 Shl Index)<>0 Then
  258.              Begin
  259.               If AnAttributeSet Then Write(': ');
  260.               Write(NowSet[Index]);
  261.               AnAttributeSet:=True;
  262.              End;
  263.           If Not AnAttributeSet Then Write('No exceptions');
  264.           HighVideo;
  265.           WriteLn(#222);
  266.           LowVideo;
  267.           AttributeChanged:=False;
  268.             GotoXY(1,9);
  269.             WriteLn;
  270.             WriteLn('Reset   to:      1:' ,SetTo[BitPattern AND 1]);
  271.             WriteLn('                 2:' ,SetTo[(BitPattern AND 2) Shr 1+2]);
  272.             WriteLn('                 3:' ,SetTo[(BitPattern AND 4) Shr 2+4]);
  273.             WriteLn('                 4:' ,SetTo[(BitPattern AND 32) Shr 5+6]);
  274.             WriteLn('    or');
  275.             WriteLn;
  276.             WriteLn('Proceed to:      5:Abort Program.');
  277.             WriteLn('                 6:Restart Program. No further changes.');
  278.             WriteLn('                 0:Next File.       No further changes.');
  279.             WriteLn;
  280.             WriteLn;
  281.  
  282. {Ask for changes or other instructions.}
  283.  
  284.             Write('Your choice? (Default = Next file)-> ');
  285.             C:=0;
  286.             ERR:=0;
  287.             This:='';
  288.             ReadLn(Choice);
  289.             If Length(Choice) > 1 Then Choice := ('a'); {Set to illegal value}
  290.             Val(Choice,C,ERR);   {Convert string to number, check for error.}
  291.             If ERR<>0 Then C:=7; {Enable error trap, if input out of range.}
  292.             Choice:='';
  293.             Case C Of
  294.                1: This:=SetTo[BitPattern AND 1];
  295.                2: This:=SetTo[(BitPattern AND 2) Shr 1+2];
  296.                3: This:=SetTo[(BitPattern AND 4) Shr 2+4];
  297.                4: This:=SetTo[(BitPattern AND 32) Shr 5+6];
  298.              End;
  299.             Case C Of
  300.                1: BitPattern:=BitPattern Xor 1;
  301.                2: BitPattern:=BitPattern Xor 2;
  302.                3: BitPattern:=BitPattern Xor 4;
  303.                4: BitPattern:=BitPattern Xor 32;
  304.              End;
  305.               If C In [1..4] Then AttributeChanged:=True;
  306.               If C=5 then Finished:=True;
  307.               If C=6 Then Goto Start_here;
  308.               If C=5 then C :=0;
  309.               If C>7 Then C:=7;                               {Error Trap}
  310.               If C=7 Then AttributeChanged:=True;
  311.  
  312.               {Not really, but doesn't matter, input error.  Change nothing,
  313.               set error flag, beep, redisplay, with error message.}
  314.  
  315.               If C = 7 Then ERR:=1;
  316.  
  317. {If change requested, make it.}
  318.  
  319.          If AttributeChanged Then      {Reset attribute Byte}
  320.             Begin
  321.              AX:=$4301;
  322.              DS:=Seg(CurrentFile[1]);
  323.              DX:=Ofs(CurrentFile[1]);
  324.              CX:=BitPattern And $FFE7;
  325.              MsDos(Regs);
  326.             End;
  327.  
  328. {Loop back to same file, unless no change requested and no error on input.}
  329.  
  330.           Until C=0;
  331.           AH:=$4F;                     {Search for next}
  332.           MsDos(Regs);
  333.          End;
  334.  
  335. {Loop back to start of main program, get next file, unless end of requested
  336.  files, or end of directory.}
  337.  
  338.     Until Finished;
  339.  
  340. {Termination sequence.}
  341.  
  342.      WriteLn('End of specified files or end of directory.');
  343.      WriteLn('End of program.');
  344.      NormVideo;
  345.     End;
  346.  
  347.   End. {Of Read_And_Set_File_Attributes}
  348.