home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / dossys / attrib / setfatr.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-03-30  |  2.9 KB  |  78 lines
  1. uses crt,dos;
  2. var
  3.   fileinfo:searchrec;
  4.   attr:word;
  5.   newatr:string;
  6.   fil:file;
  7.   i:byte;
  8.   ch:char;
  9. procedure help;
  10. begin
  11.   if paramcount=1 then if (pos('N',paramstr(1))>0) or (pos('n',paramstr(1))>0) then begin
  12.     assign(output,'');
  13.     rewrite(output);
  14.   end;
  15.   writeln('Usage: setfatr filename attributes');
  16.   writeln('Filename is any legal DOS file specification. Wild cards are OK.');
  17.   writeln('Attributes are uppercase to set an attribute and lowercase to');
  18.   writeln('remove one. If there is more than one attribute setting DO NOT');
  19.   writeln('seperate them by spaces.');
  20.   writeln('The attributes and options are as follows:');
  21.   writeln(' --<<**attributes**>>--');
  22.   writeln('  R        Read only');
  23.   writeln('  H        Hidden');
  24.   writeln('  S        System');
  25.   writeln('  A        Archive');
  26.   writeln(' --<<**options**>>--');
  27.   writeln('  L        List only, do not set attributes');
  28.   writeln('  N        Use bios to write to screen (you can use redirection)');
  29.   writeln('All other characters will be ignored. If there are no valid attribute');
  30.   writeln('or option settings, the files will just be listed with their attributes.');
  31.   writeln('Entering N as the only parameter will use bios to write the help.');
  32.   writeln('This enables you to use redirection. Two examples of redirection are:');
  33.   writeln('             setfatr N>help.dat');
  34.   writeln('             setfatr *.* N>attr.dat');
  35.   writeln('You can use >> insted of > to append to an existing file');
  36.   halt;
  37. end;
  38.  
  39. begin
  40.   if paramcount<2 then help;
  41.   newatr:=paramstr(2);
  42.   if (pos('N',newatr)>0) or (pos('n',newatr)>0) then begin
  43.     assign(output,'');
  44.     rewrite(output);
  45.   end;
  46.   findfirst(paramstr(1),anyfile,fileinfo);
  47.   while doserror=0 do begin
  48.     if keypressed then begin
  49.       writeln('Press any key to continue');
  50.       ch:=readkey;
  51.       repeat until keypressed;
  52.       ch:=readkey;
  53.     end;
  54.     write(fileinfo.name,'':30-length(fileinfo.name)); {print file name}
  55.     assign(fil,fileinfo.name);
  56.     getfattr(fil,attr);
  57.     for i:=1 to length(newatr) do
  58.       case newatr[i] of
  59.         'r':attr:=attr and not($01);     {not read only}
  60.         'R':attr:=attr or $01;           {read only}
  61.         'h':attr:=attr and not($02);     {not hidden}
  62.         'H':attr:=attr or $02;           {hidden}
  63.         's':attr:=attr and not($04);     {not system}
  64.         'S':attr:=attr or $04;           {system}
  65.         'a':attr:=attr and not($20);     {not archive}
  66.         'A':attr:=attr or $20;           {archive}
  67.       end;
  68.     if (pos('L',newatr)=0) and (pos('l',newatr)=0) then setfattr(fil,attr);
  69.     if attr and $01=$01 then write('Read only ');   {print attributes}
  70.     if attr and $02=$02 then write('Hidden ');
  71.     if attr and $04=$04 then write('System ');
  72.     if attr and $20=$20 then write('Archive ');
  73.     writeln;
  74.     findnext(fileinfo);
  75.   end;
  76. end.
  77.  
  78.