home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB15.ZIP / SETATR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-27  |  9.6 KB  |  309 lines
  1. { MS-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.
  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.   Const
  15.     NowSet: Array [0..7] Of String[33]=
  16.           ('Read only','Hidden','System','Volume label','Directory name',
  17.            'Not archived','Illegal Byte Value (2nd bit set)',
  18.            'Illegal Byte Value (1st bit set)');
  19.     SetTo: Array [0..7] Of String[12]=
  20.           ('Read only','Read/write','Hidden','Not hidden',
  21.            'System','Non-system','Not archived','Archived');
  22.   Label
  23.     Start_here;
  24.  
  25.   Type
  26.     FileName=String[65];
  27.     DataTransArea=Record
  28.           ThrowAwayBytes: Array [0..20] Of Byte;
  29.           AttribByte: Byte;
  30.           TimeInt: Integer;
  31.           DateInt: Integer;
  32.           Size1Int: Integer;
  33.           Size2Int: Integer;
  34.           FNam: Array [0..12] Of Char;
  35.         End;
  36.     RegisterSet=Record Case Integer Of
  37.                   1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  38.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  39.                 End;
  40.   Var
  41.     DirAndOrPath,Mask,CurrentFile: FileName;
  42.     CurDataTransArea: ^DataTransArea;
  43.     Regs: RegisterSet;
  44.     Finished,None,AttributeChanged,AnAttributeSet: Boolean;
  45.     A,C,I,J,ERR: Integer;
  46.     CommandLine: String[127] Absolute CSEG:$0080;
  47.     Choice: String[2];
  48.     Dummy: String[1];
  49.     This: String[12];
  50.     Run: File;
  51. Procedure Warble;
  52.   Begin
  53.     For A := 1 to 3 do
  54.       Begin
  55.         Sound(440);
  56.         Delay(50);
  57.         Sound(660);
  58.         Delay(50);
  59.         NoSound;
  60.       End;
  61.   End; {Procedure Warble}
  62.  
  63. Procedure Beep;
  64.   Begin
  65.     Sound(440);
  66.     Delay(100);
  67.     NoSound;
  68.   End; {Procedure Beep}
  69.  
  70. {Introduction}
  71.  
  72.   Begin
  73.     ClrScr;
  74.     WriteLn('File attribute program, by T. A. Housh, Jr.');
  75.     WriteLn;
  76.     LowVideo;
  77.     WriteLn('This program will allow you to view and change the attributes');
  78.     WriteLn('of an MS-DOS 2.xx file.');
  79.     WriteLn;
  80.     WriteLn('You may use wild cards or not, as you choose.');
  81.     WriteLn;
  82.     WriteLn('If you wish to examine a whole directory or disk just specify the');
  83.     WriteLn('drive or directory in the usual way, e.g. a: or b:\ or whatever.');
  84.     WriteLn('You may specify this parameter in the command line.');
  85.     WriteLn;
  86.     WriteLn('The designation "(No exceptions)" indicates no special attributes set,');
  87.     WriteLn('that is, the file is read/write, non-system, not hidden, and has been');
  88.     WriteLn('archived.');
  89.     WriteLn;
  90.  
  91. {Look for some parameter in command line}
  92.  
  93.     Mask:=Copy(CommandLine,2,127);
  94.     While KeyPressed Do
  95.       Read(Kbd,Dummy);
  96.     Write('Press any key to continue...');
  97.     Read(Kbd,Dummy);
  98.     WriteLn;
  99.     If Mask='' Then
  100.  
  101. Start_Here: {If file name not specified, or restart requested, ask for target}
  102.  
  103.      Begin
  104.      WriteLn;
  105.      Write('Enter file name: ');
  106.       ReadLn(Mask);
  107.      End;
  108.  
  109. {START OF FILE SEARCH}
  110.  
  111. {Parse file name, force to upper case, look for directories and paths.}
  112.  
  113.     For I:=1 To Length(Mask) Do Mask[I]:=UpCase(Mask[I]);
  114.     I:=Pos('\',Mask);
  115.     If Pos(':',Mask)<>0 Then I:=Pos(':',Mask);
  116.     If I<>0 Then
  117.       Repeat
  118.         J:=Pos('\',Copy(Mask,I+1,64));
  119.         I:=I+J;
  120.       Until J=0;
  121.     DirAndOrPath:=Copy(Mask,1,I);
  122.  
  123. {If only directory or path, set wildcards for all files.}
  124.  
  125.     If DirAndOrPath=Mask Then Mask:=Mask+'*.*';
  126.  
  127. {Go to disk directory, get first (or only) file.}
  128.  
  129.     Mask[Length(Mask)+1]:=Chr(0);
  130.     With Regs Do
  131.      Begin
  132.       AH:=$2F;                         {Get Disk Transfer Address (DTA)}
  133.       MsDos(Regs);
  134.       CurDataTransArea:=Ptr(ES,BX);
  135.       AH:=$4E;                         {Search for first}
  136.       DS:=Seg(Mask[1]);
  137.       DX:=Ofs(Mask[1]);
  138.       CX:=$17;
  139.       MsDos(Regs);
  140.       Finished:=False;
  141.       None:=True;
  142.  
  143. {START OF MAIN PROGRAM LOOP}
  144.  
  145. {If drive, directory, path, or file not found, display error and terminate.}
  146.  
  147.    Repeat
  148.         This:='';
  149.         WriteLn;
  150.         If (Flags And 1)<>0 Then
  151.          Begin
  152.           Beep;
  153.           HighVideo;
  154. (*For some reason the following I/O error detection does not work*)
  155.           Case AX Of                   {Limited Error Return Detection}
  156.             2: Write('File not found');
  157.             3: Write('Directory or path not found');
  158.             5: Write('Access denied.  Illegal device specified');
  159.             15: Write('Invalid drive specified');
  160.             18: If None Then Write('Specified file ',Mask,' not found');
  161.             else Write('Undefined error ');
  162.            End;
  163.           LowVideo;
  164.           WriteLn;
  165.           Finished:=True;
  166.          End
  167.         Else
  168.  
  169. {If no error, then get first file and show attribute data.}
  170.  
  171.          Begin
  172.           ERR:=0;
  173.           None:=False;
  174.           CurrentFile:=DirAndOrPath+
  175.             Copy(CurDataTransArea^.FNam,1,Pos(#0,CurDataTransArea^.FNam));
  176.  
  177. {START OF RECYCLE LOOP}
  178.  
  179.         Repeat;
  180.           ClrScr;
  181.           LowVideo;
  182.           Write('File Attribute Program.  Looking at: ');
  183.           TextBackGround(White);
  184.           TextColor(Black);
  185.           WriteLn(Mask);
  186.           LowVideo;
  187.           If ERR<>0 Then
  188.            Begin
  189.              GotoXY(1,3);
  190.              Warble;
  191.              TextColor(LightGray + Blink);
  192.              Write('Input error - ');
  193.              HighVideo;
  194.              WriteLN(' Try again.');
  195.              LowVideo;
  196.              ERR:=0;
  197.            End;
  198.           GotoXY(1,5);
  199.           Write('Current File  -> ');
  200.           TextColor(White + Blink);
  201.           Write(Copy(CurrentFile,1,Length(CurrentFile)-1));
  202.           If This <> '' Then
  203.             Begin
  204.              LowVideo;
  205.              Write(' reset to ');
  206.              HighVideo;
  207.              Write(This,'.');
  208.              Beep;
  209.              LowVideo;
  210.             End;
  211.           WriteLn;
  212.           LowVideo;
  213.           AX:=$4300;                   {Read current file attribute byte}
  214.           DS:=Seg(CurrentFile[1]);
  215.           DX:=Ofs(CurrentFile[1]);
  216.           MsDos(Regs);
  217.           GotoXY(1,7);
  218.           Write('Normal, except-> |');
  219.           AnAttributeSet:=False;
  220.           For I:=0 To 7 Do
  221.             If CX And (1 Shl I)<>0 Then
  222.              Begin
  223.               If AnAttributeSet Then Write(': ');
  224.               Write(NowSet[I]);
  225.               AnAttributeSet:=True;
  226.              End;
  227.           If Not AnAttributeSet Then Write('No exceptions');
  228.           WriteLn('|');
  229.           AttributeChanged:=False;
  230.             GotoXY(1,9);
  231.             WriteLn;
  232.             WriteLn('Reset   to:      1:' ,SetTo[CX AND 1]);
  233.             WriteLn('                 2:' ,SetTo[(CX AND 2) Shr 1+2]);
  234.             WriteLn('                 3:' ,SetTo[(CX AND 4) Shr 2+4]);
  235.             WriteLn('                 4:' ,SetTo[(CX AND 32) Shr 5+6]);
  236.             WriteLn('    or');
  237.             WriteLn;
  238.             WriteLn('Proceed to:      5:Abort Program.');
  239.             WriteLn('                 6:Restart Program. No further changes.');
  240.             WriteLn('                 0:Next File.       No further changes.');
  241.             WriteLn;
  242.             WriteLn;
  243.  
  244. {Ask for changes or other instructions.}
  245.  
  246.             Write('Your choice? (Default = Next file)-> ');
  247.             C:=0;
  248.             ERR:=0;
  249.             This:='';
  250.             ReadLn(Choice);
  251.             If Length(Choice) > 1 Then Choice := ('a'); {Set to illegal value}
  252.             Val(Choice,C,ERR);   {Convert string to number, check for error.}
  253.             If ERR<>0 Then C:=7; {Enable error trap, if input out of range.}
  254.             Choice:='';
  255.             Case C Of
  256.                1: This:=SetTo[CX AND 1];
  257.                2: This:=SetTo[(CX AND 2) Shr 1+2];
  258.                3: This:=SetTo[(CX AND 4) Shr 2+4];
  259.                4: This:=SetTo[(CX AND 32) Shr 5+6];
  260.              End;
  261.             Case C Of
  262.                1: CX:=CX Xor 1;
  263.                2: CX:=CX Xor 2;
  264.                3: CX:=CX Xor 4;
  265.                4: CX:=CX Xor 32;
  266.              End;
  267.               If C In [1..4] Then AttributeChanged:=True;
  268.               If C=5 then Finished:=True;
  269.               If C=6 Then Goto Start_here;
  270.               If C=5 then C :=0;
  271.               If C>7 Then C:=7;                               {Error Trap}
  272.               If C=7 Then AttributeChanged:=True;
  273.  
  274.               {Not really, but doesn't matter, input error.  Change nothing,
  275.               set error flag, beep, redisplay, with error message.}
  276.  
  277.               If C = 7 Then ERR:=1;
  278.  
  279. {If change requested, make it.}
  280.  
  281.          If AttributeChanged Then      {Reset attribute Byte}
  282.             Begin
  283.              AX:=$4301;
  284.              DS:=Seg(CurrentFile[1]);
  285.              DX:=Ofs(CurrentFile[1]);
  286.              CX:=CX And $FFE7;
  287.              MsDos(Regs);
  288.             End;
  289.  
  290. {Loop back to same file, unless no change requested and no error on input.}
  291.  
  292.           Until C=0;
  293.           AH:=$4F;                     {Search for next}
  294.           MsDos(Regs);
  295.          End;
  296.  
  297. {Loop back to start of main program, get next file, unless end of requested
  298.  files, or end of directory.}
  299.  
  300.     Until Finished;
  301.  
  302. {Termination sequence.}
  303.  
  304.      WriteLn('End of specified files or end of directory.');
  305.      WriteLn('End of program.');
  306.     End;
  307.  
  308.   End. {Of Read_And_Set_File_Attributes}
  309.