home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / dossys / attrib / attrib.pas next >
Encoding:
Pascal/Delphi Source File  |  1994-04-11  |  3.6 KB  |  129 lines
  1. { MS-DOS file attribute editor version 1.00A by Bela Lubkin 1/10/85
  2.   Send suggestions via Borland SIG on CompuServe - GO BOR }
  3.  
  4. Program Attributes;
  5.  
  6.   Const
  7.     AN: Array [0..7] Of String[13]=
  8.           ('Read only','Hidden','System','Volume name','Directory',
  9.            'Not archived','Unknown ($40)','Unknown ($80)');
  10.     NA: Array [0..7] Of String[12]=
  11.           ('Read only','Read/write','Hidden','Visible',
  12.            'System','Non-system','Not archived','Archived');
  13.  
  14.   Type
  15.     FileName=String[65];
  16.     DTA=Record
  17.           Junk: Array [0..20] Of Byte;
  18.           Attrib: Byte;
  19.           Time: Integer;
  20.           Date: Integer;
  21.           LSize: Integer;
  22.           HSize: Integer;
  23.           FN: Array [0..12] Of Char;
  24.         End;
  25.     RegisterSet=Record Case Integer Of
  26.                   1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  27.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  28.                 End;
  29.  
  30.   Var
  31.     Path,FName,Found: FileName;
  32.     CurDTA: ^DTA;
  33.     Regs: RegisterSet;
  34.     Done,None,Changed,Prev: Boolean;
  35.     C,I,J: Integer;
  36.     CommandLine: String[127] Absolute CSEG:$0080;
  37.  
  38.   Begin
  39.     FName:=Copy(CommandLine,2,127);
  40.     If FName='' Then
  41.      Begin
  42.       Write('Enter file name: ');
  43.       ReadLn(FName);
  44.      End;
  45.     For I:=1 To Length(FName) Do FName[I]:=UpCase(FName[I]);
  46.     I:=Pos('\',FName);
  47.     If Pos(':',FName)<>0 Then I:=Pos(':',FName);
  48.     If I<>0 Then
  49.       Repeat
  50.         J:=Pos('\',Copy(FName,I+1,64));
  51.         I:=I+J;
  52.       Until J=0;
  53.     Path:=Copy(FName,1,I);
  54.     If Path=FName Then FName:=FName+'*.*';
  55.     FName[Length(FName)+1]:=Chr(0);
  56.     With Regs Do
  57.      Begin
  58.       AH:=$2F;
  59.       MsDos(Regs);
  60.       CurDTA:=Ptr(ES,BX);
  61.       AH:=$4E;
  62.       DS:=Seg(FName[1]);
  63.       DX:=Ofs(FName[1]);
  64.       CX:=$17;
  65.       MsDos(Regs);
  66.       Done:=False;
  67.       None:=True;
  68.       Repeat
  69.         If (Flags And 1)<>0 Then
  70.          Begin
  71.           Case AX Of
  72.             3: Write('Path not found');
  73.             15: Write('Invalid drive');
  74.             18: If None Then Write('File not found');
  75.             else Write('Unknown error #',AX);
  76.            End;
  77.           WriteLn;
  78.           Done:=True;
  79.          End
  80.         Else
  81.          Begin
  82.           None:=False;
  83.           Found:=Path+Copy(CurDTA^.FN,1,Pos(#0,CurDTA^.FN));
  84.           Write(Copy(Found,1,Length(Found)-1));
  85.           AX:=$4300;
  86.           DS:=Seg(Found[1]);
  87.           DX:=Ofs(Found[1]);
  88.           MsDos(Regs);
  89.           Write('(':Length(Path)-Length(Found)+15);
  90.           Prev:=False;
  91.           For I:=0 To 7 Do
  92.             If CX And (1 Shl I)<>0 Then
  93.              Begin
  94.               If Prev Then Write(',');
  95.               Write(AN[I]);
  96.               Prev:=True;
  97.              End;
  98.           WriteLn(')');
  99.           Changed:=False;
  100.           Repeat
  101.             Write('Change which attribute (0 for next file, -1 for list)? ');
  102.             C:=0;
  103.             ReadLn(C);
  104.             Case C Of
  105.               -1: WriteLn('#:Change to  1:',NA[CX And 1],'  2:',NA[(CX And 2) Shr 1+2],
  106.                           '  3:',NA[(CX And 4) Shr 2+4],
  107.                           '  4:',NA[(CX And 32) Shr 5+6]);
  108.                1: CX:=CX Xor 1;
  109.                2: CX:=CX Xor 2;
  110.                3: CX:=CX Xor 4;
  111.                4: CX:=CX Xor 32;
  112.              End;
  113.             If C In [1..4] Then Changed:=True;
  114.           Until C=0;
  115.           If Changed Then
  116.            Begin
  117.             AX:=$4301;
  118.             DS:=Seg(Found[1]);
  119.             DX:=Ofs(Found[1]);
  120.             CX:=CX And $FFE7;
  121.             MsDos(Regs);
  122.            End;
  123.           AH:=$4F;
  124.           MsDos(Regs);
  125.          End;
  126.       Until Done;
  127.      End;
  128.   End.
  129.