{$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(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.