unit SEARCH;

interface

uses dos,utils;

type shortstr=string[9];
type extstring=string[4];
type numbers=1..12;
type pntstring=^string;
type TResult=object
private
pntarr:array[1..11] of pntstring;
str_num:numbers;
all_num:byte;
allow:boolean;
files:^text;
procedure init;
function records(fpath:string;max:byte;show:boolean):boolean;
public
function findname(num:numbers):string;
procedure destroy;
end;

const any='.**';
const sfile='.*';
const sfolder='';

function SuperSearch(name:shortstr;dir:string;const stype:extstring;max:byte;show:boolean;var PResult:TResult):boolean;

implementation

type search_array=array[1..28] of searchrec;

procedure TResult.init;
var i:numbers;
disk:char;
begin
allow:=true;
if all_num>1 then exit;
for i:=1 to 11 do pntarr[i]:=nil;
str_num:=1;
all_num:=1;
if fileExists('C:\*.*') then disk:='C'
else if fileExists('A:\*.*') then disk:='A'
else
 begin
 allow:=false;
 exit;
 end;
new(files);
assign(files^,disk+':\files.txt');
rewrite(files^);
end;

function TResult.records(fpath:string;max:byte;show:boolean):boolean;
begin
if all_num< max then
 begin
 if str_num< 10 then records:=true
 else if allow then records:=true
 else records:=false;
 end
else
 begin
 records:=false;
 if all_num>max then exit;
 end;
if show then writeln(all_num,': ',fpath)
else
 begin
 if str_num< 12 then
  begin
  new(pntarr[str_num]);
  pntarr[str_num]^:=fpath;
  inc(str_num);
  end
 else writeln(files^,fpath);
 end;
inc(all_num);
end;

function TResult.findname(num:numbers):string;
var i:byte;
name:string;
begin
if num>=all_num then findname:=''
else
 begin
 if num< 12 then findname:=pntarr[num]^
 else
  begin
  reset(files^);
  for i:=1 to num-11 do
   readln(files^,name);
  findname:=name;
  end;
 end;
end;

procedure TResult.destroy;
var i:byte;
begin
for i:=1 to str_num-1 do dispose(pntarr[i]);
{$I-}
erase(files^);
{$I+}
dispose(files);
str_num:=1;
all_num:=1;
end;

function SuperSearch(name:shortstr;dir:string;const stype:extstring;max:byte;show:boolean;var PResult:TResult):boolean;
var searcharr:^search_array;
srch:searchrec;
n_pos:pointer;
extmask:extstring;
namemask:shortstr;
find_folder,uni:boolean;
disk:'C'..'Z';
i:byte;
label ONE_DIR,NEXT;

function no_name(substr,str:shortstr):byte;
begin
no_name:=1;
end;

function Upper_name(name:string):shortstr;
begin
UpString(name);
Upper_name:=name;
end;

function write_result:boolean;

procedure check_end;
begin
SuperSearch:=true;
if PResult.records(dir+'\'+srch.name,max,show)
 then write_result:=true
else write_result:=false;
end;

begin
if (stype=sfolder) and (srch.size=0) then check_end
else if namemask< >'*' then
 begin
 if stype=any then check_end
 else if srch.size< >0 then check_end;
 end
else
 if (strCont(name,copy(srch.name,1,pos('.',srch.name)-1))) or
  ((n_pos=@no_name) and (strCont('.',srch.name))) then
  if stype=any then check_end
  else if srch.size< >0 then check_end;
end;

begin
SuperSearch:=false;
if dir< >'' then
 begin
 if byte(dir[0])=1 then dir:=dir+':'
 else if (dir[byte(dir[0])]='\') or (dir[byte(dir[0])]='\') then
  dec(dir[0]);
 if not fileExists(dir+'\*.*') then exit;
 uni:=true;
 disk:='Z';
 end
else disk:='C';
if stype=any then extmask:='.*'
else if (stype[1]='.') or (stype=sfolder) then extmask:=stype
else exit;
name:=Upper_name(name);
if name[1]='*' then
 begin
 namemask:='*';
 if byte(name[0])=1 then n_pos:=@no_name
 else n_pos:=@StrCont;
 delete(name,1,1);
 end
else
 begin
 n_pos:=@StrCont;
 namemask:=name;
 end;
PResult.init;
if not show then inc(max,PResult.all_num-1);
if (max>255) or (max=0) then max:=255;
new(searcharr);
i:=1;
if disk='Z' then goto ONE_DIR;
for disk:='C' to 'Z' do
 begin
 findfirst(disk+':\*.*',anyfile,srch);
 if doserror=0 then dir:=disk+':'
 else if disk>'G' then exit
 else continue;
 uni:=true;
 ONE_DIR:
 repeat
 find_folder:=false;
 if uni then
  begin
  findfirst(dir+'\*',anyfile,searcharr^[i]);
  if (byte(dir[0])>2) and (doserror=0) then
   begin
   findnext(searcharr^[i]);
   findnext(searcharr^[i]);
   end;
  while (doserror=0) and (searcharr^[i].size< >0) do findnext(searcharr^[i]);
  if doserror=0 then find_folder:=true;
  findfirst(dir+'\'+namemask+extmask,anyfile,srch);
  while doserror=0 do
   begin
   asm
   PUSH SS
   LEA AX,name
   PUSH AX
   PUSH SS
   LEA AX,srch.nameins
   PUSH AX
   CALL n_pos
   OR AX,AX
   JE NEXT
   end;
   if not write_result then exit;
   NEXT:
   findnext(srch);
   end;
  if find_folder then
   begin
   dir:=dir+'\'+searcharr^[i].name;
   inc(i);
   end
  else if i< >1 then
   begin
   uni:=false;
   dec(dir[0],byte(searcharr^[i-1].name[0])+1);
   dec(i);
   end
  else break;
  continue;
  end;
 findnext(searcharr^[i]);
 if doserror=0 then
  begin
  dir:=dir+'\'+searcharr^[i].name;
  uni:=true;
  inc(i);
  end
 else if i< >1 then
  begin
  dec(dir[0],byte(searcharr^[i-1].name[0])+1);
  dec(i);
  end
 else break;
 until false;
 if disk='Z' then exit;
 end;
end;

end.