home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
bp7os2
/
whereis.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-11-13
|
8KB
|
324 lines
program whereis;
uses dos;
const
StartDrive = 3;
var
search : dos.searchrec;
t,name : string;
fullname :string;
count : longint;
basedir : string;
da,d : string[16];
dt : dos.datetime;
dates,times,sizes,totals,finished,
deletes,good,flags : boolean;
i,j,sizew : integer;
drive : string;
total : longint;
dsize : longint;
function strlen( t : string):byte;
var
b : byte absolute t;
begin
strlen := b;
end;
Function Strtrim(t : string):string;
var
I,J : integer;
begin
i := strlen(t);
while (I > 0)and(t[i] = ' ') do dec(i);
J := 1;
while (J<=i)and(t[j] =' ') do inc(J);
if j <= I then strtrim := copy(t,j,i-j+1)
else strtrim := '';
end;
function up_shift(t : string): string;
var
I,j : integer;
begin
I := strlen(t);
for j := 1 to I do t[j] := upcase(t[J]);
up_shift := t;
end;
procedure search_dir(fullname, indir : string);
var
dir : string;
s : dos.searchrec;
i : integer;
begin
if fullname <> '' then
if (strlen(indir)>0)and(indir[1] <> '\') then
if fullname[strlen(fullname)] = '\' then
fullname := fullname + indir
else fullname := fullname +'\'+ indir
else fullname := fullname + indir
else fullname := indir;
chdir(indir);
findfirst(name,anyfile,s);
while doserror = 0 do begin
if not((s.attr and directory)=directory) then begin
total := total + s.size;
if (deletes)and( dates or times or sizes or flags) then Write('REM ');
if dates then begin
unpacktime(s.time,dt);
str(dt.year mod 100:2,d);
da := '/'+d;
str(dt.day:2,d);
da := '/'+d+da;
str(dt.month:2,d);
da := d + da;
for I := 1 to 8 do if da[i] =' ' then da[i] := '0';
write (da,' ' );
end;
if times then begin
unpacktime(s.time,dt);
str(dt.sec:2,d);
da := ':'+d;
str(dt.min:2,d);
da := ':'+d+da;
str(dt.hour:2,d);
da := d+da;
for I := 1 to 7 do if da[i] = ' ' then da[i] := '0';
write(da,' ');
end;
if sizes then begin
Write(s.size:sizew,' ');
end;
if flags then begin
t := ' ';
if (s.attr and 1) = 1 then t[1] := 'R';
if (s.attr and 2) = 2 then t[2] := 'H';
if (s.attr and 4) = 4 then t[3] := 'S';
if (s.attr and 8) = 8 then t[4] := 'V';
if (s.attr and $10) = $10 then t[5] := 'D';
if (s.attr and $20) = $20 then t[6] := 'A';
Write(t);
end;
if (deletes)and( dates or times or sizes or flags) then begin
if (strlen(fullname)>0)and(fullname[strlen(fullname)]='\') then
write(fullname,s.name)
else Write(fullname,'\',s.name);
writeln;
write('DEL ');
end
else if deletes then write('DEL ');
if (strlen(fullname)>0)and(fullname[strlen(fullname)]='\') then
write(fullname,s.name)
else Write(fullname,'\',s.name);
writeln;
inc(count);
end;
findnext(s);
end;
findfirst('*.*',directory,s);
while doserror = 0 do begin
if (s.attr=directory)and(s.name <> '.')and(s.name <> '..') then begin
search_dir(fullname,s.name);
end;
findnext(s);
end;
{$I-}
chdir('..');
{$I+}
if ioresult=0 then ;
end;
Procedure help;
begin
writeln(' WHEREIS 1.00 BP4OS2 ');
writeln;
writeln(' WHEREIS target options ');
writeln;
writeln(' target : File to look for ');
writeln(' options : ');
writeln(' /DATE /D - Display file Write Date. ');
writeln(' /TIME /T - Display file Write Time. ');
WritelN(' /SIZE /S - Display file Size. ');
writeln(' /USAGE /U - Display Disk space used. ');
Writeln(' /FLAGS /F - Display File Attributes. ');
writeln(' /DELETE - Prefix output with ''DEL ''.');
writeln;
halt(1);
end;
procedure do_find (drive,lname:string );
var
finished : boolean;
fullname : string;
dir : dos.dirstr;
nme : dos.namestr;
ext : dos.extstr;
ser : dos.searchRec;
begin
if drive <> '' then chdir(drive);
finished := false;
fullname := '';
fsplit(lname,dir,nme,ext);
findfirst(lname,anyfile,ser);
while (doserror = 0)and(not finished) do begin
if (ser.attr and directory)=directory then
if ((ser.name <> '.')and(ser.name <> '..'))and
(ser.name = nme+ext) then begin
fullname := lname;
lname := '*.*';
finished := true;
end;
if not finished then findnext(ser);
end;
if not finished then
if dir <> '' then begin
fullname := dir;
if (strlen(fullname) >1)and(fullname[strlen(fullname)] = '\') then
delete(fullname,strlen(fullname),1);
lname := strtrim(nme)+strtrim(ext);
end
else fullname := '\';
fullname := drive+fullname;
name := lname;
search_dir('',fullname);
if not deletes then
if count > 1 then writeln(' found ',count);
end;
begin
assign(output,'');
rewrite(output);
getdir(0,basedir);
total := 0;
name := '';
dates := false;
times := false;
sizes := false;
sizew := 5;
totals := false;
deletes := false;
flags := false;
I := 1;
while I <= paramcount do begin
t := paramstr(i);
t := up_shift(strtrim(t));
if strlen(t)> 0 then begin
if (t[1] = '/')or(t[1]='-') then begin { Switch }
delete(t,1,1);
if strlen(t)=1 then case t[1] of
'D' : dates := true;
'S' : sizes := true;
'T' : times := true;
'U' : totals := true;
'F' : flags := true;
else help;
end
else if t='DATE' then dates := true
else if t='SIZE' then sizes := true
else if t='TIME' then times := true
else if t='USAGE' then totals := true
else if t='DELETE' then DELETES := true
else if t='FLAGS' then flags := true
else if pos('SIZE:',t)=1 then begin
Delete(t,1,5);
val(t,sizew,J);
if j = 0 then
if (sizew >=0) and(sizew<20) then sizes := true
else help
else help
end
else begin
good := true;
j := 1 ;
while (J <= strlen(t))and(good) do begin
case t[j] of
'D' : begin
good := good and not(dates);
dates := true;
end;
'S' : begin
good := good and not(sizes);
sizes := true;
end;
'T' : begin
good := good and not(times);
times := true;
end;
'U' : begin
good := good and not(Totals);
totals:= true;
end;
'F' : begin
good := good and not(Flags);
flags := true;
end;
else good := false;
end;
inc(j);
end;
if not good then help;
end;
end
else name := t;
end;
inc(i);
end;
if pos(':',name) <> 0 then begin
drive := copy (name,1,pos(':',name));
delete(name,1,pos(':',name));
if name <> '' then begin
if drive = '*:' then begin
for I := startdrive to 26 do begin
{$I-}
dsize := disksize(i);
{$I+}
if ioresult=0 then ;
if dsize <> -1 then begin
drive := chr(i+64)+':';
do_find(drive,name);
end;
end;
end
else begin
do_find(drive,name);
end;
end
else help;
end
else if name <> '' then do_find('',name)
else help;
if deletes then begin
writeln('DEL %0.CMD');
if totals then writeln('REM Total Disk Space Used =',total);
end
else if totals then writeln(' Total Disk Space Used =',total);
chdir(basedir);
close(output );
end.