
{$IFNDEF __TMT__} {$M $E800, 0, 0} {$ENDIF}

program HUNT {needs stack and no heap} {$R+,S+,I-}
  {$IFDEF VER40} NEEDS TurboPascal 5.0 or higher {$ENDIF} ;

{ !!! The Help that was here is now in file HUNT.TXT !!! }


uses Dos ;

type
S5 = string [5] ;
S25 = string [25] ;

const Wait : boolean = false ;

var Scrn : Text ;


function ReadChar : char { in lieu of Crt.ReadKey, for normal keys } ;
var Regs : registers ;
begin with Regs do begin
    AH := 0 ; Intr($16, Regs) ; ReadChar := char(AL) ;
  end end {ReadChar} ;


procedure STOP(Nb : byte) ;
begin
  if Wait then char(Wait) := ReadChar ;
  HALT(Nb) end {STOP} ;


procedure Explain ;
begin
  Writeln(Scrn, ^M'HUNT.PAS  www.merlyn.demon.co.uk  >= 2007-12-13', ^M^J,
    ' Alpha Before Chdir Dironly- Endless',
    ' From Grant Hold Ibid Jbid Kind Later Media'^M^J,
    ' New Only Path'#241' Quiet Rootwards Subdir Type',
    ' Uncond Veto When eXecutable'^M^J,
    ' Yesterday siZe * \ "command"s ~*~ + 2/4 ? # œ $',
    '  (for more info, see HUNT.TXT)') ;
  STOP(3) end {Explain} ;


{$I+}
procedure Quit(Sq : PathStr) ;
var Ch : char ; const Wrd : word = 9 ;
begin
  Writeln('HUNT: ', Sq, '; quit.'^G) ;
  Write('Try to use most of O/P so far? ERRORLEVEL digit=(0=Yes, >0=No) ? ') ;
  Ch := ReadChar ; Writeln(Ch) ; if Ch>='0' then Wrd := Ord(Ch) -  Ord('0') ;
  Writeln('ERRORLEVEL=', Wrd) ; STOP(Wrd) end {Quit} ;
{$I-}


procedure IOerr(ErrS : S25 ; IOR : integer) ; var IORS : S5 ;
begin Str(IOR, IORS) ; Quit(ErrS+' IOResult '+IORS) end {IOerr} ;


procedure IOCheck(Fail : S25) ; var IOR : integer ;
begin IOR := IOResult ; if IOR>0 then IOerr(Fail, IOR) end {IOCheck} ;


procedure IO ; var IOR : integer ;
begin IOR := IOResult ; if IOR>0 then IOerr('IO:', IOR) end {IO} ;


const Sp = char(32) ;


function LZ(JJ : word) : S5 { LZ:=00..09,10..99999 } ; var St : S5 ;
begin Str(JJ:2, St) ; if St[1]=Sp then St[1] := '0' ; LZ := St end ;


function SvenDOW(Yr, m, d : word) : word { Greg: Sven Pran, altered by JRS } ;
begin if m<3 then begin Inc(m, 12) ; Dec(Yr) end ;
  SvenDOW := 1 + ( ( (3*m + 3) div 5 ) + 2*m + d + Yr +
      (Yr div 4) - (Yr div 100) + (Yr div 400) ) mod 7 ;
        end {SvenDOW} ;


const
MinT = $00000000 ; MaxT = $FFFFFFFF ; W95LFN = $0F {rhsv} ;
Atst = 'rhsvdaè#' ; NoA = '.' ; Dot = '.' ; DotDot = '..' ;
MaxAtt = Length(Atst) ; Atts : string [MaxAtt] = Atst ;

const { initialised variables }
NofB : longint = 0 { No. of Bytes } ;
From : longint = MinT { longword when } ;
Bee4 : longint = MaxT { " " } ;
TMin : longint = MaxT ;
TMax : longint = MinT ;
Smin : longint = 0 ;
Smax : longint = $7FFFFFFF ;
Nbad : longint = 0 { No. of Bad names } ;
NofF : longint = 0 { No. of Files } ;
Att0 : byte = $00 ;
Att1 : byte = $FF ;
IJst : string [40] = '' ;
Hold : string [12] = '' ;
Drvs : string [26] = '.' ;
Alph : boolean = false ;
Ibid : boolean = false ;
Jbid : boolean = false ;
SubDir : boolean = false ;
DirOnly : boolean = false ;
ComExeBat : boolean = false ;
Job : boolean = false ;
Path : boolean = false ;
Qot : boolean = false ;
Cdno : byte = 0 ;
Cmnd : array [1..2] of string [80] = ('TYPE', '') ;
S12S : string [1] = Sp ;
ChD : boolean = false ;
Show : set of 0..2 = [0,1,2] ;
Super : boolean = false ;
Only : boolean = false ;
Lata : boolean = false ;
Hnot : boolean = false ;
DS : DirStr = '' ;
NS : NameStr = '' ;
ES : ExtStr = '' ;
YrNo : char = '?' ;
Endless : boolean = false ;
Plus : char = #01 ;
Kind : string [8] = Atst ;
Dogs : char = {$IFDEF __TMT__} '''' {$ELSE} '"' {$ENDIF}
  { TP/BP Default '"', changes for special cases, see ~ } ;
Perm : set of 'A'..'Z' = [] ;
UpTo : longint = 1 { Cluster } ;
USet : boolean = false ;
HCmd : boolean = false ;
Days : string [7] = '' ;
DSep : char = '/' ;
DTsp : char = '-' ;
TSep : char = ':' ;


var GlobalDT : DateTime ; GlobalDowk : char ;


procedure DoDate ;
begin with GlobalDT do Write(Sp, LZ(Year), DSep, LZ(Month), DSep, LZ(Day),
    DTsp, LZ(Hour), TSep, LZ(Min), TSep, LZ(Sec)) end {DoDate} ;


procedure DoDateWk ;
begin DoDate ;
  if 'D' in Perm then Write(GlobalDoWk:2) end {DoDateWk} ;


var Quy : boolean ;


procedure Execute
  (var DirInf : SearchRec ; var Prfx : DirStr ; var NoMore : boolean) ;
const Pset = ['Y', 'N', 'U', 'Q', 'S'] ;
var ESiz : word ;
Jndx : byte ;
ParS : ComStr ;
Est : string [6] ;
Para : char ;
begin with DirInf do begin
    Para := 'Y' ; NoMore := false ;
    if Ibid then ParS := Prfx else ParS := '' ;
    ParS := Cmnd[1] + S12S +Prfx+Name + S12S +IJst +ParS+Cmnd[2] ;
    if Jbid then ParS := ParS+S12S+Prfx ;

    {$I+}

    if Quy or (2 in Show) then begin
      Write(ParS:61, Sp) ;
      if Quy then begin Write('(y/n/U/Q/S/?) ? '^G) ;
        repeat Para := UpCase(ReadChar) ;
          if Para=#27 then STOP(2) ;
          if Para='?' then Write(^M^J': y = Yes, n = No,',
            ' u = all Yes, q = all No, s = Skip directory, Esc = QUIT; ? ') ;
          until Para in Pset ;
        end { else Para := 'Y' } ;
      Writeln(Para) ;
      end ;

    if Para='S' then begin NoMore := true ; EXIT end ;
    if Para='Q' then begin Job := false ; ChD := false end ;
    if Para='U' then begin Quy := false ; Para := 'Y' end ;
    if Para='Y' then begin

      if ChD then begin
        if DirOnly then Prfx := Prfx+Name else Delete(Prfx, Length(Prfx), 1) ;
        ChDir(Prfx) ; STOP(0) end ;

      Esiz := 50 + EnvCount+1 {0s} ;
      for Jndx := 1 to EnvCount do Inc(Esiz, Length(EnvStr(Jndx))) ;
      if Esiz<160 then Esiz := 160 ; Str(Esiz, Est) ;

      Flush(Output) ;
      SwapVectors ;
      Exec(GetEnv('COMSPEC'), '/E:'+Est+' /C '+ParS) ;
      (*** COMMAND.COM /C loses error returns ***)
      SwapVectors ;
      if (DosError<>0) or (DosExitCode<>0) then
        Writeln('COMSPEC DosError ':45, DosError,
        '  DosExitCode '^G, DosExitCode) ;
      end {Y} ;

    {$I-}

    end end {Execute} ;



function PfxS(Prfx : DirStr) : PathStr ;
begin
  if Plus='+' then PfxS := FExpand(Prfx) else { 20020804 }
    if Prfx='' then PfxS := '.\' else PfxS := Prfx end {PfxS} ;




function UltiMo(Year, Month : word) : word ;
const Ult : array [1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31) ;
begin
  if (Month=2) and
    ((Year and 3) = 0) and ((Year mod 100 > 0) or (Year mod 400 = 0))
    then UltiMo := 29 else UltiMo := Ult[Month] ;
  end {Ultimo} ;


function DW(LI : longint) : longint { for Year2044 compliance } ;
begin DW := LI xor $80000000 end {DW} ;


type TN3 = record NofBS, NofFS, NbadS : longint end ;
type BitSet = set of 0..7 ;

var NoEA : array [1..MaxAtt] of longint { Number Of Each Attribute } ;


procedure DoOnly(var Prfx : DirStr ; Name : string) ;
var St : PathStr ;
P : BitSet absolute Plus ;
begin
  if 2 in P then St := '' else
    if 1 in P then St := FExpand(Prfx) else St := Prfx ;
  if 0 in P then St := St + Name ;
  Write(St) end {DoOnly} ;


procedure ProcessEntry(var DirInf : SearchRec ; var Prfx : DirStr ;
  var N3 : TN3 ; var NoMore : boolean ; var Flag : boolean) ;
const
GoodSet =
  ['!', '#'..')', '-', Dot, '0'..'9', '@'..'Z', '^'..'`', '{', '}', '~'] ;
var
Atrb : string [MaxAtt] ;
Indx, Jatt : byte ;
Deed, BadC : boolean ;
NuNa : string [12] ;
const FlgA : array [boolean] of char = ' ?' ;

begin with DirInf, N3 do begin

    BadC := false ;
    for Indx := 1 to Length(Name) do
      if not (Name[Indx] in GoodSet) then BadC := true ;
    if BadC then Flag := true else if 'B' in Perm then EXIT ;

    if Flag then begin Inc(Nbad) ; Inc(NbadS) end ;

    Atrb := Atts ;
    { 1:6 - ReadOnly Hidden SysFile VolumeID Directory Archive }
    { 7:8 - ?undef? Shareable? }

    Size := ((Size+UpTo-1) div UpTo ) * UpTo { Round Up } ;

    for JAtt := 1 to MaxAtt do
      if JAtt-1 in BitSet(Attr) then Inc(NoEA[JAtt]) else Atrb[JAtt] := NoA ;
    if ((Atrb[5]=NoA) xor DirOnly) then begin                  { NoDirys? }
      Inc(NofB, Size) ; Inc(NofF) ;
      Inc(NofBS, Size) ; Inc(NofFS) end ;

    if DW(Time)<DW(TMin) then TMin := Time ;
    if DW(Time)>DW(TMax) then TMax := Time ;

    if 1 in Show then begin
      if Only then DoOnly(Prfx, Name) else begin
        with GlobalDT do if YrNo='2' then Year := Year mod 100 ;
        if not Alph then DoDateWk ;
        if Pos(Dot, Name)=0 then Name := Name+Dot ;
        NuNa := Name ;
        for Indx := Pos(Dot, NuNa) to 8 do Insert(Sp, NuNa, Indx) ;
        while Length(NuNa)<12 do NuNa := NuNa+Sp ;
        Write(Sp, NuNa, FlgA[Flag]) ;
        if Atrb[5]=NoA then Write(Size:9) else Write('':9) ;
        Write(Sp, Atrb) ;
        if Alph then DoDateWk ;
        end {not Only} ;
      end ;

    Deed := (Job or ChD) and ( (Atrb[5]=NoA) xor DirOnly ) ;     { NoDirys? }
    if not ('H' in Perm) then if Atrb[2]<>NoA { H=2 } then Deed := false ;
    if not ('S' in Perm) then if Atrb[3]<>NoA { S=3 } then Deed := false ;

    if 1 in Show then begin
      if Path and not (Deed or Only) then Write(' via ', PfxS(Prfx)) ;
      Writeln ; IO end ;

    if Deed then Execute(DirInf, Prfx, NoMore) else NoMore := false ;

    end end {ProcessEntry} ;




procedure ConsiderEntry(var DirInf : SearchRec ;
  var Prfx : DirStr ; var N3 : TN3 ; var NoMore : boolean) ;
var Flag : boolean ;
begin NoMore := false ;

  with DirInf do begin

    if Name = Dot then EXIT ;
    if Name = DotDot then EXIT ;

    if Size < Smin then EXIT ;
    if Size > SMax then EXIT ;

    if Hold > '' then if (Pos(Hold, Name)=0) xor Hnot then EXIT ;

    if (Attr  or Att1) <> $FF then EXIT ;
    if (Attr and Att0) <> $00 then EXIT ;

    if DW(Time) <  DW(From) then EXIT ;
    if DW(Time) >= DW(Bee4) then EXIT ;

    UnPackTime(Time, GlobalDT) ;

    with GlobalDT do begin
      Flag := (Month=0) or (Month>12) or (Day=0) or (Day>UltiMo(Year, Month))
        or (Hour>23) or (Min>59) or (Sec>59) ;
      if 'D' in Perm then begin
        if Flag then GlobalDowk := '?' else
          GlobalDowk := char(48+SvenDow(Year, Month, Day)) ;
        if (Days>'') and (Pos(GlobalDowk, Days)=0) then EXIT ;
        end ;
      end ;


    end {DirInf} ;

  ProcessEntry(DirInf, Prfx, N3, NoMore, Flag) ;

  end {ConsiderEntry} ;





procedure FindEntries(var Prfx : DirStr ; var N3 : TN3) ;
const Exts : array [0..3] of string [3] = ('', 'BAT', 'EXE', 'COM') ;
var DirInfo : SearchRec ; Ex : shortint ; NoMore : boolean ;
begin

  if ComExeBat and (ES=Dot) then Ex := 3 else Ex := 0 ;

  repeat FindFirst(Prfx+NS+ES+Exts[Ex], AnyFile-VolumeID, DirInfo) ;

    if (DosError<>18) and (DosError<>0) then begin
      {$I+}
      Write('  *** FindFirst(', Prfx+NS+ES+Exts[Ex],
        ',,) -> DosError ', DosError, '; '^G) ;
      case DosError of
        3: Write('Path not found') ;
        151: Write('Unknown Unit') ;
        152: Write('Drive not ready') ;
        154: Write('CRC error in data') ;
        162: Write('Hardware Failure (density?)') ;
        else Write('See TP5.0 Ref Guide p.467-472, or a good DOS manual.') ;
        end {case} ;
      Writeln ; STOP(4) end ;
    {$I-}

    while DosError=0 do begin
      ConsiderEntry(DirInfo, Prfx, N3, NoMore) ;
      if NoMore then EXIT ;
      FindNext(DirInfo) ;
      end {while 0} ;

    Dec(Ex) until Ex<1 ;

  end {FindEntries} ;



type UpDn = (Up, Dn) ;


procedure DoADir(Prfx : DirStr ; UD : UpDn ; Miss : PathStr) ; forward ;




function DoSubDirs(var Prfx : DirStr ; var {const} Miss : PathStr) : longint ;
var DirInfoo : SearchRec ; NoSD : longint ;
begin NoSD := 0 ;
  if SubDir then begin {QV MS-DOS Bible Ed2 p.458 4Eh 4Fh}
    if 0 in Show then begin
      Writeln('  * scanning SubDirs of ', PfxS(Prfx)) ; IO end ;
    FindFirst(Prfx+'*.*', {Directory} AnyFile, DirInfoo) ;
    while DosError=0 do begin
      with DirInfoo do
        if boolean(Attr and Directory) and not ( (Name=Dot) or (Name=DotDot) )
        then begin
        if Miss<>FExpand(Prfx+Name)+'\'
          then DoADir(Prfx+Name+'\', Dn, '')
          else if 0 in Show then begin
          Writeln('  ** Did ', Prfx+Name, '\ before') ; IO end ;
        Inc(NoSD) end ;
      FindNext(DirInfoo) ;
      end {while 0} ;
    end {SubDir} ;
  DoSubDirs := NoSD end {DoSubDirs} ;




procedure DoADir(Prfx : DirStr ; UD : UpDn ; Miss : PathStr) ;
var N3 : TN3 ; NofSD : longint ; ShoNuDir, GoUpADir : boolean ;

begin {DoADir} with N3 do begin

    if not Lata then NofSD := DoSubDirs(Prfx, Miss) { keep here } ;

    GoUpADir := Super and (UD=Up) and (FExpand(Prfx)<>FExpand(Prfx+'..\')) ;
    ShoNuDir := (0 in Show) and (GoUpADir or Subdir) ;
    if ShoNuDir then begin Writeln('  * scanning in ', PfxS(Prfx)) ; IO end ;

    NofBS := 0 ; NbadS := 0 ; NofFS := 0 ;

    FindEntries(Prfx, N3) ;

    if GoUpADir then begin
      if 0 in Show then begin
        Writeln('  * scanning up from ', PfxS(Prfx)) ; IO end ;
      DoADir(Prfx+'..\', Up, FExpand(Prfx)) end ;

    if Lata then NofSD := DoSubDirs(Prfx, Miss) { where ? } ;

    if ShoNuDir then begin
      Write('  ** in ', PfxS(Prfx), ' : ', NofSD+NofFS, ' entries; ',
        NofSD, ' SubDirs; ', NofFS, ' matches') ;
      if NbadS>0 then Write(', ', NbadS, ' badfiles'^G) ;
      if not DirOnly then Write(', ', NofBS, ' bytes.') ;        { NoDirys? }
      Writeln ; IO end ;

    end end { DoADir } ;






procedure ScanPath ;
var PthStr : DirStr ; List : string ; Temp : PathStr ; Jn : byte ;
begin
  if 0 in Show then begin
    Writeln('  ** Now search rest of PATH **') ; IO end ;
  List := GetEnv('PATH') ;
  if Length(List)=255 then
    {$I+} Writeln('WARNING long path truncated ?'^G) {$I-}
    else if List[Length(List)]<>';' then List := List+';' ;
  GetDir(0, Temp) ;
  if Temp[Length(Temp)]<>'\' then Temp := Temp+'\' ;
  while Pos(';', List)>0 do begin
    Jn := Pos(';', List) ;
    PthStr := Copy(List, 1, Jn-1) ; Delete(List, 1, Jn) ;





    if Pos(Sp, PthStr)>0 { or not 8.3 ? } then begin { 2007-12-13 }
      {$I+} Writeln('CANNOT HANDLE LFN : '^G, PthStr) {$I-} ; CONTINUE end ;





    if PthStr[Length(PthStr)]<>'\' then PthStr := PthStr+'\' ;
    if PthStr<>Temp then DoADir(PthStr, Dn, '')
      else if 0 in Show then begin
      Writeln('  (* CURRENT ', PthStr, ' *)') ; IO end ;
    end {while} ;
  end {ScanPath} ;


procedure DoPackedDate(Time : longint) ;
begin UnPackTime(Time, GlobalDT) ; DoDate end {DoPackedDate} ;


procedure GetLbl(Dev : char) ;
var DirInfo : SearchRec ; By, Ix : byte ;
begin FindFirst(Dev+':\*.*', VolumeID, DirInfo) ;
  with DirInfo do begin
    while DosError=0 do begin
      if Attr<>W95LFN then begin
        By := Pos(Dot, Name) ;
        if By>0 then begin for Ix := By to 8 do Insert(Sp, Name, Ix) ;
          Delete(Name, 9, 1) end ;
        Write('   Label ', Dev, ': = ', Name) ; DoPackedDate(Time) ;
        end ;
      FindNext(DirInfo) ;
      end ;
    end ;
  end {GetLbl} ;




procedure OOPS(St : string) ;
begin if HCmd then Write(' HUNTCMD:') ;
  Writeln(^G' HUNT parameter error : ', St) ; STOP(3) end {OOPS} ;


var Tail : ComStr ;


function Fnq : longint ;
var Fn : longint ;
begin Fn := 0 ;
  while (Tail>'') and (Tail[1] in ['0'..'9']) do begin
    Fn := 10*Fn + word(Tail[1])-word('0') ; Delete(Tail, 1, 1) end ;
  Delete(Tail, 1, 1) ; Fnq := Fn end {Fnq} ;


procedure DaysBack ;
var JW : word ;
begin
  if (Tail>'') and (Tail[1]='-') then with GlobalDT do begin
    Delete(Tail, 1, 1) ;
    for JW := Fnq downto 1 do begin Dec(Day) ;
      if Day=0 then begin Dec(Month) ;
        if Month=0 then begin Month := 12 ; Dec(Year) ;
          if Year<1980 then OOPS('<1980') ;
          end {Month 0} ;
        Day := UltiMo(Year, Month) ;
        end {Day 0};
      end {for} ;
    end {with} ;
  end {DaysBack} ;


var JH, JM, JS, IY, IM, ID, IW, XIW : word ;



procedure GetDT(var LI : longint ; Ch : char) ;
begin if not Endless then Write(Sp, Sp, Ch) ;
  with GlobalDT do begin
    if (Tail>'') and (Tail[1]='#') then begin Delete(Tail, 1, 1) ;
      Year := IY ; Month := IM ; Day := ID ; DaysBack end {=}
    else begin
      Year := Fnq ; Month := word(Fnq) and $0F ; Day := word(Fnq) and $1F ;
      if Year<80 then Inc(Year, 100) ; if Year<1000 then Inc(Year, 1900) ;
      if Year<1980 then OOPS('<1980') ; if Year>2107 then OOPS('>2107') ;
      end ;
    if (Tail>'') and (Tail[1]='#') then begin Delete(Tail, 1, 1) ;
      Hour := JH ; Min := JM ; Sec := JS ; DaysBack end
    else begin
      Hour := word(Fnq) and $1F ; Min := word(Fnq) and $3F ;
      Sec := word(Fnq) and $3E end ;
    end {with} ;
  if not Endless then begin DoDate ; Writeln end ;
  PackTime(GlobalDT, LI) end {GetDT} ;


var IYMD : word ;


procedure Cases(var Tail : ComStr) ;

function ZQ(N : byte) : char ;
var C : char ;
begin C := Tail[N] ;
  if C='0' then ZQ := Sp else ZQ := C end {ZQ} ;

var C1, C2 : char ; KK : byte ;
begin

  if Tail='' then EXIT ;

  if Tail[1] in ['-', '/'] then Delete(Tail, 1, 1) ;
  C1 := UpCase(Tail[1]) ; Delete(Tail, 1, 1) ;
  if Tail='' then C2 := #00 else C2 := UpCase(Tail[1]) ;

  if (C1 in ['G', 'V']) and not (C2 in ['A'..'Z']) then OOPS('Bad G/V') ;

  case C1 of
    '*', '\' : ;
    '?' : Explain ;
    'A' : Alph := true ;
    'B' : GetDT(Bee4, C1) ;
    'C' : begin ChD := true ; Cmnd[1] := 'GOTO' ; SubDir := true end ;
    'D' : Kind[5] := char (Ord('1') - Ord(C2='-')) ;
    'E' : Endless := true ;
    'F' : GetDT(From, C1) ;
    'G' : begin Delete(Tail, 1, 1) ; Perm := Perm + [C2] ;
      case C2 of
        'A' : begin Uset := Tail>'' ; if USet then UpTo := Fnq ; end ;
        'D' : Days := Tail ;
        'I' : begin
          if Tail='' then Tail := '- :' ;
          DSep := ZQ(1) ;
          if Length(Tail)>1 then DTsp := ZQ(2) ;
          if Length(Tail)>2 then TSep := ZQ(3) ;
          end ;
        end ;
      end ;
    'H' : begin
      Hnot := Tail[1]='*' ; if Hnot then Delete(Tail, 1, 1) ;
      for KK := 1 to Length(Tail) do Tail[KK] := UpCase(Tail[KK]) ;
      Hold := Tail end ;
    'I' : begin Ibid := true ; IJst := Tail end ;
    'J' : begin Jbid := true ; IJst := Tail end ;
    'K' : Kind := Tail ;
    'L' : Lata := true ;
    'M' : Drvs := Tail ;
    'N' : begin From := longint(IYMD)*$10000 ; Bee4 := From+$00010000 end ;
    'O' : begin Only := true ; Endless := true ; Show := [1] end ;
    'P' : begin Path := true ; Plus := C2 end ;
    'Q' : if C2=#0 then byte(Show) := byte(Show) and $6
      {}           else byte(Show) := byte(C2)   and $7 ;
    'R' : Super := true ;
    'S' : SubDir := true ;
    'T' : begin Job := true ; Inc(Cdno) end ;
    'U' : Quy := false ;
    'V' : Perm := Perm - [C2] ;
    'W' : begin GetDT(From, C1) ;
      if C2='#' then
        begin From := From and $FFFF0000 ; Bee4 := From + $00010000 end
      else begin Bee4 := From ; Inc(Bee4) end ;
      end ;
    'X' : begin ComExeBat := true ; Path := C2='+' end ;
    'Y' : begin Tail := '#-1' ; GetDT(From, 'Y') end ;
    'Z' : begin Delete(Tail, 1, 1) ;
      if C2='-' then Smax := Fnq else if C2='+'then Smin := Fnq
        else if C2='=' then begin Smax := Fnq ; Smin := Smax end
      else OOPS('Z needs +-=#') ;
      end ;
    '~' : if Copy(Tail, 2, 1)='~' then Dogs := C2 ;
    '+' : S12S := '' ;
    '0'..'9' : YrNo := C1 ;
    'œ', '$' : Wait := true ;
    else if C1=Dogs then
      if (*? (Tail>'') and ?*) (Cdno<2)
      then begin Job := true ; Qot := true end
    else OOPS('Bad ' + Dogs)
      else OOPS('Unknown: ' + C1+Tail) ;
    end {case} ;
  end {Cases} ;


var P1 : PathStr ;

procedure ReadParams ;
var KK : byte ; EnvVar : ComStr ;
const PN : word = 2 ;
begin

  if ParamStr(2)='#' then Inc(PN) else begin HCmd := true ;
    EnvVar := GetEnv('HUNTCMD')+#32 ;
    repeat
      KK := Pos(#32, EnvVar) ;
      Tail := Copy(EnvVar, 1, Pred(KK)) ; Cases(Tail) ;
      Delete(EnvVar, 1, KK) until EnvVar='' ;
    end ;
  HCmd := false ;

  Quy := true ;

  {$I+}

  while PN<= ParamCount do begin

    if Qot then Tail := Tail+Sp+ParamStr(PN) else begin
      Tail := ParamStr(PN) ;
      if Tail[1]<>';' then begin Cases(Tail) end else PN := 999 ;
      end {Qot else} ;

    if Tail[Length(Tail)]=Dogs then begin
      Qot := false ; Inc(Cdno) ; Dec(Tail[0]) ; Cmnd[Cdno] := Tail end ;
    Inc(PN) end {PN} ;

  if Qot then OOPS('Odd ' + Dogs) ;

  for KK := 1 to Length(P1) do if P1[KK]='/' then P1[KK] := '\' ;
  if not ('U' in Perm) then
    if Copy(P1, 1, 2)='\\' then OOPS('UNC path not allowed') ;

  if P1>'' then FSplit(P1, DS, NS, ES) ;
  if NS='' then NS := '*' ;
  if ComExeBat and (ES='') then ES := Dot ; {!!!???!!!}
  if ES='' then ES := '.*' ;

  if ComExeBat and Path and (DS<>'') then OOPS(DS + ' ... x p is error') ;

  {$I-}

  DirOnly := Kind[5] = '1' ;

  for KK := 0 to 7 do case Kind[KK+1] of {N.B. T5}
    '0' : BitSet(Att0) := BitSet(Att0) + [KK] ;
    '1' : BitSet(Att1) := BitSet(Att1) - [KK] ;
    end ;

  end {ReadParams} ;



procedure Report ;
const
Mo : array [1..12] of string [3] =
  ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec') ;
Dy : array [0..6] of string [3] = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') ;
var DirInfo : SearchRec ; Tmp, Tmpy : PathStr ; JA : byte ;
begin

  Write('Attribute counts - ') ;
  for JA := 1 to MaxAtt do if JA=4 then Write('':7) else
    Write(NoEA[JA]:5, Sp, Atts[JA]) ;
  Writeln ; IO ;

  Write('Date ', Dy[IW], Sp, ID, Sp, Mo[IM], IY:5, ', ',
    LZ(JH), ':', LZ(JM), ':', LZ(JS), '. ') ;

  if DW(TMin)<=DW(TMax) then
    begin DoPackedDate(TMin) ; Write(' -') ; DoPackedDate(TMax) end ;
  Writeln ; IO ;

  Tmp := FExpand(DS+NS+ES) ; IW := word(Tmp[1])-word('@') ;
  if Drvs='.' then begin
    Write('Disk bytes :', DiskSize(IW):10, '.') ;
    GetLbl(Tmp[1]) ; Writeln ; IO ;
    Write('Free bytes :', DiskFree(IW):10, '.   ') end ;

  Write('Find', NofF:7, ' matching ') ;
  if DirOnly then Write('dirs') else Write('files,', NofB:11, ' bytes') ;
  { NoDirys? }
  Writeln ; IO ;

  if Drvs='.' then begin Write('Finding in : ') ;
    Tmpy := FExpand(DS) ;
    if Tmpy[Length(Tmpy)]='\' then Dec(Tmpy[0]) ;
    if Length(Tmpy)<=2 then Write('RootDir') else with DirInfo do begin
      FindFirst(Tmpy, {Directory} AnyFile, DirInfo) ;
      if DosError<>0 then begin
          Writeln(Tmpy, ' : DosError ', DosError) ; STOP(4) end ;
      Write(Name) ; DoPackedDate(Time) end ;
    if UpTo>1 then Write('   Cluster ', UpTo, ' bytes?') ;
    Writeln ; IO end ;

  Write('Full names : ') ;
  if Drvs='.' then Write(Tmp) else Write(Drvs, ':', NS, ES) ;
  { if ComExeBat then Write('(ceb)') ; }
  case Kind[5] of
    '0' : Write(' NoD') ;
    '1' : Write(' Dir') ;
    end ;
  if Super then Write(' SupD') ;
  if SubDir then Write(' SubD') ;
  if Path then Write(' Path') ;
  Writeln ; IO ;
  end {Report} ;


procedure DriveWrite(Ch : char) ;
var Drv : byte ; St : string ;
begin
  if Ch='.' then Drv := 0 else Drv := Ord(Ch) and $1F ;
  GetDir(Drv, St) ;
  if not Only then Writeln('  *** Now at ', St, '\') ;
  end ;


function ClusterSize(Z : byte) : longint ;
var Regs : registers ;
begin with Regs do begin
    AH := $1C ; DL := Z ; MsDos(Regs) ; ClusterSize := longint(CX)*AL ;
  end end {ClusterSize} ;


procedure DoThat(It : PathStr) ;
var Z : byte ;
begin
  if ('A' in Perm) and not USet then begin
    if It[2]=':' then Z := byte(It[1]) and $1F else Z := 0 ;
    UpTo := ClusterSize(Z) ;
    end ;
  DoADir(It, Up, '') ;
  end {DoThat} ;


procedure ScanDrives ;
var KD : integer ; Ch : char ;
  begin
  for KD := 1 to Length(Drvs) do begin Ch := UpCase(Drvs[KD]) ;
    if Length(Drvs)>1 then DriveWrite(Ch) ;
    if Ch='.' then DoThat(DS)
      else if Ch in ['A'..'Z'] then DoThat(Ch+':'+DS) ;
    end ;
  end {ScanDrives} ;


BEGIN ;
Assign(Scrn, 'CON') ; Rewrite(Scrn) ;

P1 := ParamStr(1) ;
if P1='/?' then Explain { Halts } ;

GetDate(IY, IM, ID, IW) ;
repeat XIW := IW ;
  GetTime(JH, JM, JS, IW) ; GetDate(IY, IM, ID, Iw) until IW=XIW ;
IYMD := ((IY-1980) shl 4 + IM) shl 5 + ID ;

ReadParams ;

FillChar(NoEA, SizeOf(NoEA), 0) ;

ScanDrives ;

if ComExeBat and Path and not (Super or SubDir) then ScanPath ;

if Job then begin Writeln ; IO end ;

if not Endless then Report ;

Close(Output) ; IOCheck('Close(Output) problem') ;

if Nbad>0 then begin
  Writeln(Scrn, 'Wrong character or date/time found ', Nbad, ' times'^G) ;
  IO end ;

Close(Scrn) ;

STOP(Ord(NofF=0)) ;

{ J R Stockton, www.merlyn.demon.co.uk.  Documented by HUNT.TXT. }

END.
