home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1318 / gepackt.exe / BATUTIL / SOURCE / SUBDIR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-12-19  |  1.1 KB  |  57 lines
  1. {$N-}    {kein numerischer Coprozessor}
  2. {$M 10000,1384,5360}
  3.  
  4. program subdir;
  5.  
  6. uses
  7.   tastatur,testfile,dos;
  8.  
  9. var
  10.   s,s1 : string[80];
  11.   error : boolean;
  12.   errornr : word;
  13.   l : byte absolute s1;
  14.   n,i : byte;
  15.  
  16. begin
  17.   if paramcount>0 then for i:=1 to paramcount do begin
  18.     s:=paramstr(i);
  19.     if s[1]='%' then begin
  20.       delete(s,1,1);
  21.       s:=getenv(s);
  22.     end;
  23. {$i-}
  24.     chdir(s);
  25. {$i+}
  26.     n:=0;
  27.     error:=true;
  28.     s1:='';
  29.     while (ioresult<>0) and (n<32) and (error or not (s=s1)) do begin
  30.       s1:=s;
  31.       repeat
  32.         if keypressed and (readkey=^[) then halt(1);
  33. {$i-}
  34.         mkdir(s1);
  35. {$i+}
  36.         errornr:=ioresult;
  37.         error:=errornr<>0;
  38.         if error then
  39.           case errornr of
  40.             5,150 : halt;
  41.             3     : ;
  42.             else writeln('Error: ',errornr);
  43.         end;
  44.         if error then begin
  45.           while (l>0) and (s1[l]<>'\') and (s1[l]<>':') do delete(s1,l,1);
  46.           if s1[l]='\' then delete(s1,l,1);
  47.           if s1='' then n:=255;
  48.         end;
  49.         inc(n);
  50.       until error=false or (n>=32);
  51. {$i-}
  52.       chdir(s);
  53. {$i+}
  54.     end;
  55.   end;
  56. end.
  57.