{$v-}

 program FindArch;
{ This program will search an entire disk and print the paths
  to all unarchived files.
}

    type
       regset = record
          ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
          end;
       fname = array[1..80] of char;
       str80 = string[80];
       dta_def = record
          filler : array[1..21] of byte;
          attribute : byte;
          file_time : integer;
          file_date : integer;
          file_size : array[1..2] of integer;
          file_name : fname;
          end;

    const
       carry = 1;
       directory = $10;
       archive = $20;

    var
       regs : regset;
       pattern : string[40];
       CurrPath : string[80];
       DirSave : fname;
       root : string[10];

    procedure recurse;

       var
          dta : dta_def;
          param : regset;
          s_string : string[70];
          r1,r2 : real;
          dta_save : array[1..2] of integer;

       function pack_name(var a1; size : integer) : str80;

          var
             i : integer;
             b : str80;
             a : array[1..1000] of char absolute a1;

          begin
             i := 1;
             b := '';
             while (a[i]<>chr(0)) and (i <= size) do begin
                b := b+a[i];
                i := i+1;
                end;
             pack_name := b;
             end;

       begin
          with param,dta do begin
             ax := $2F00;          {get DTA}
             msdos(param);
             dta_save[1] := es;
             dta_save[2] := bx;
             ax := $1A00;          {set DTA}
             ds := seg(dta);
             dx := ofs(dta);
             msdos(param);
             ds := seg(pattern[1]);
             dx := ofs(pattern[1]);
             ax := $4E00;          {find 1st}
             cx := $FF;
             msdos(param);
             while (flags and carry) = 0 do begin
                s_string := pack_name(file_name,sizeof(file_name));
                if ((attribute and directory) <> 0)
                     and (s_string <> '.')
                     and (s_string <> '..')
                  then
                    begin
                      { decend to the next level }
                      CurrPath := CurrPath + s_string + '\';
                      s_string := s_string+chr(0);
                      ax := $3B00;    {CHDIR}
                      ds := seg(s_string[1]);
                      dx := ofs(s_string[1]);
                      msdos(param);
                      recurse;
                      { comming back up }
                      CurrPath := copy(CurrPath,1,length(CurrPath)-length(s_string));
                      ax := $3B00;    {go back}
                      s_string := '..'#0;
                      ds := seg(s_string[1]);
                      dx := ofs(s_string[1]);
                      msdos(param);
                    end
                else if (attribute and archive) = archive
                  then writeln(CurrPath, s_string);
                ax := $4F00;       {get next}
                msdos(param);
                end;
             ax := $1A00;          {set DTA}
             ds := dta_save[1];
             dx := dta_save[2];
             msdos(param);
             end;
          end;

    begin
      with regs do
        begin
          ax := $4700;       {save current directory}
          ds := seg(DirSave);
          si := ofs(DirSave);
          dx := 0;
          msdos(regs);
          root := '\'#0;
          CurrPath := '\';
          pattern := '*.*'#0;
          ax := $3B00;       {set root dir}
          ds := seg(root[1]);
          dx := ofs(root[1]);
          msdos(regs);
          recurse;
          ax := $3b00;       {restore old dir}
          ds := seg(DirSave);
          dx := ofs(DirSave);
          msdos(regs);
        end;
    end.