home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / bp7os2 / whereis.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-13  |  8.2 KB  |  324 lines
  1. program whereis;
  2. uses dos;
  3. const
  4.    StartDrive = 3;
  5.  
  6. var
  7.   search : dos.searchrec;
  8.   t,name : string;
  9.   fullname :string;
  10.   count    : longint;
  11.   basedir  : string;
  12.   da,d       : string[16];
  13.   dt : dos.datetime;
  14.   dates,times,sizes,totals,finished,
  15.   deletes,good,flags : boolean;
  16.   i,j,sizew : integer;
  17.   drive       : string;
  18.  
  19.   total : longint;
  20.   dsize : longint;
  21.  
  22.  
  23. function strlen( t : string):byte;
  24. var
  25.    b : byte absolute t;
  26. begin
  27. strlen := b;
  28. end;
  29.  
  30.  
  31. Function Strtrim(t : string):string;
  32. var
  33.   I,J : integer;
  34. begin
  35. i := strlen(t);
  36. while (I > 0)and(t[i] = ' ') do dec(i);
  37. J := 1;
  38. while (J<=i)and(t[j] =' ') do inc(J);
  39. if j <= I then strtrim := copy(t,j,i-j+1)
  40. else strtrim := '';
  41. end;
  42.  
  43. function up_shift(t : string): string;
  44. var
  45.    I,j : integer;
  46. begin
  47. I := strlen(t);
  48. for j := 1 to I do t[j] := upcase(t[J]);
  49. up_shift := t;
  50. end;
  51.  
  52.  
  53. procedure search_dir(fullname, indir : string);
  54. var
  55.    dir : string;
  56.    s : dos.searchrec;
  57.    i : integer;
  58.  
  59. begin
  60.  
  61. if fullname <> '' then
  62.    if (strlen(indir)>0)and(indir[1] <> '\') then
  63.       if fullname[strlen(fullname)] = '\' then
  64.          fullname := fullname + indir
  65.       else fullname := fullname +'\'+ indir
  66.    else fullname := fullname + indir
  67. else fullname := indir;
  68. chdir(indir);
  69. findfirst(name,anyfile,s);
  70. while doserror = 0 do begin
  71.    if not((s.attr and directory)=directory) then begin
  72.       total := total + s.size;
  73.       if (deletes)and( dates or times or sizes or flags) then Write('REM ');
  74.       if dates then begin
  75.          unpacktime(s.time,dt);
  76.          str(dt.year mod 100:2,d);
  77.          da := '/'+d;
  78.          str(dt.day:2,d);
  79.          da := '/'+d+da;
  80.          str(dt.month:2,d);
  81.          da := d + da;
  82.          for I := 1 to 8 do if da[i] =' ' then da[i] := '0';
  83.          write (da,' ' );
  84.          end;
  85.       if times then begin
  86.          unpacktime(s.time,dt);
  87.          str(dt.sec:2,d);
  88.          da := ':'+d;
  89.          str(dt.min:2,d);
  90.          da := ':'+d+da;
  91.          str(dt.hour:2,d);
  92.          da := d+da;
  93.          for I := 1 to 7 do if da[i] = ' ' then da[i] := '0';
  94.          write(da,' ');
  95.          end;
  96.       if sizes then begin
  97.          Write(s.size:sizew,' ');
  98.          end;
  99.       if flags then begin
  100.          t := '       ';
  101.          if (s.attr and 1) = 1 then t[1] := 'R';
  102.          if (s.attr and 2) = 2 then t[2] := 'H';
  103.          if (s.attr and 4) = 4 then t[3] := 'S';
  104.          if (s.attr and 8) = 8 then t[4] := 'V';
  105.          if (s.attr and $10) = $10 then t[5] := 'D';
  106.          if (s.attr and $20) = $20 then t[6] := 'A';
  107.          Write(t);
  108.          end;
  109.       if (deletes)and( dates or times or sizes or flags) then begin
  110.          if (strlen(fullname)>0)and(fullname[strlen(fullname)]='\') then
  111.             write(fullname,s.name)
  112.          else Write(fullname,'\',s.name);
  113.          writeln;
  114.          write('DEL ');
  115.          end
  116.       else if deletes then write('DEL ');
  117.  
  118.       if (strlen(fullname)>0)and(fullname[strlen(fullname)]='\') then
  119.          write(fullname,s.name)
  120.       else Write(fullname,'\',s.name);
  121.       writeln;
  122.  
  123.       inc(count);
  124.       end;
  125.    findnext(s);
  126.    end;
  127. findfirst('*.*',directory,s);
  128. while doserror = 0 do begin
  129.    if (s.attr=directory)and(s.name <> '.')and(s.name <> '..') then begin
  130.       search_dir(fullname,s.name);
  131.       end;
  132.    findnext(s);
  133.    end;
  134. {$I-}
  135. chdir('..');
  136. {$I+}
  137. if ioresult=0 then ;
  138. end;
  139.  
  140.  
  141. Procedure help;
  142.  
  143. begin
  144. writeln(' WHEREIS    1.00   BP4OS2 ');
  145. writeln;
  146. writeln(' WHEREIS target options ');
  147. writeln;
  148. writeln('    target  : File to look for ');
  149. writeln('    options : ');
  150. writeln('             /DATE  /D    - Display file Write Date. ');
  151. writeln('             /TIME  /T    - Display file Write Time. ');
  152. WritelN('             /SIZE  /S    - Display file Size. ');
  153. writeln('             /USAGE /U    - Display Disk space used. ');
  154. Writeln('             /FLAGS /F    - Display File Attributes. ');
  155. writeln('             /DELETE      - Prefix output with ''DEL ''.');
  156. writeln;
  157. halt(1);
  158. end;
  159.  
  160.  
  161.  
  162. procedure do_find (drive,lname:string  );
  163. var
  164.    finished : boolean;
  165.    fullname : string;
  166.    dir : dos.dirstr;
  167.    nme : dos.namestr;
  168.    ext : dos.extstr;
  169.    ser : dos.searchRec;
  170. begin
  171. if drive <> '' then chdir(drive);
  172. finished := false;
  173. fullname := '';
  174. fsplit(lname,dir,nme,ext);
  175. findfirst(lname,anyfile,ser);
  176. while (doserror = 0)and(not finished) do begin
  177.    if (ser.attr and directory)=directory then
  178.       if ((ser.name <> '.')and(ser.name <> '..'))and
  179.         (ser.name = nme+ext) then begin
  180.          fullname := lname;
  181.          lname := '*.*';
  182.          finished := true;
  183.          end;
  184.    if not finished then findnext(ser);
  185.    end;
  186.  
  187. if not finished then
  188.    if dir <> '' then begin
  189.       fullname := dir;
  190.       if (strlen(fullname) >1)and(fullname[strlen(fullname)] = '\') then
  191.          delete(fullname,strlen(fullname),1);
  192.       lname := strtrim(nme)+strtrim(ext);
  193.       end
  194.    else fullname := '\';
  195. fullname := drive+fullname;
  196. name := lname;
  197. search_dir('',fullname);
  198. if not deletes then
  199.    if count > 1 then writeln(' found ',count);
  200. end;
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210. begin
  211.  
  212. assign(output,'');
  213. rewrite(output);
  214. getdir(0,basedir);
  215. total := 0;
  216. name := '';
  217. dates := false;
  218. times := false;
  219. sizes := false;
  220. sizew := 5;
  221. totals := false;
  222. deletes := false;
  223. flags := false;
  224. I := 1;
  225. while I <= paramcount do begin
  226.    t := paramstr(i);
  227.    t := up_shift(strtrim(t));
  228.    if strlen(t)> 0 then begin
  229.       if (t[1] = '/')or(t[1]='-') then begin { Switch }
  230.          delete(t,1,1);
  231.          if strlen(t)=1 then case t[1] of
  232.             'D' : dates := true;
  233.             'S' : sizes := true;
  234.             'T' : times := true;
  235.             'U' : totals := true;
  236.             'F' : flags  := true;
  237.             else help;
  238.             end
  239.          else if t='DATE' then dates := true
  240.          else if t='SIZE' then sizes := true
  241.          else if t='TIME' then times := true
  242.          else if t='USAGE' then totals := true
  243.          else if t='DELETE' then DELETES := true
  244.          else if t='FLAGS' then flags := true
  245.          else if pos('SIZE:',t)=1 then begin
  246.             Delete(t,1,5);
  247.             val(t,sizew,J);
  248.             if j = 0 then
  249.                if (sizew >=0) and(sizew<20) then sizes := true
  250.                else help
  251.             else help
  252.             end
  253.          else begin
  254.             good := true;
  255.             j := 1 ;
  256.             while (J <= strlen(t))and(good) do begin
  257.                case t[j] of
  258.                   'D' : begin
  259.                         good := good and not(dates);
  260.                         dates := true;
  261.                         end;
  262.                   'S' : begin
  263.                         good := good and not(sizes);
  264.                         sizes := true;
  265.                         end;
  266.                   'T' : begin
  267.                         good := good and not(times);
  268.                         times := true;
  269.                         end;
  270.                   'U' : begin
  271.                         good := good and not(Totals);
  272.                         totals:= true;
  273.                         end;
  274.                   'F' : begin
  275.                         good := good and not(Flags);
  276.                         flags := true;
  277.                         end;
  278.                   else good := false;
  279.                   end;
  280.                inc(j);
  281.                end;
  282.             if not good then help;
  283.             end;
  284.          end
  285.       else name := t;
  286.       end;
  287.    inc(i);
  288.    end;
  289.  
  290. if pos(':',name) <> 0 then begin
  291.    drive := copy (name,1,pos(':',name));
  292.    delete(name,1,pos(':',name));
  293.    if name <> '' then begin
  294.       if drive = '*:' then begin
  295.          for I := startdrive to 26 do begin
  296.          {$I-}
  297.             dsize := disksize(i);
  298.          {$I+}
  299.             if ioresult=0 then ;
  300.             if dsize <> -1 then begin
  301.                drive := chr(i+64)+':';
  302.                do_find(drive,name);
  303.                end;
  304.             end;
  305.          end
  306.       else begin
  307.          do_find(drive,name);
  308.          end;
  309.       end
  310.    else help;
  311.    end
  312. else if name <> '' then do_find('',name)
  313. else help;
  314. if deletes then begin
  315.    writeln('DEL %0.CMD');
  316.    if totals then writeln('REM Total Disk Space Used =',total);
  317.    end
  318. else if totals then writeln(' Total Disk Space Used =',total);
  319.  
  320.  
  321. chdir(basedir);
  322. close(output );
  323. end.
  324.