{$I VERSION.PAS - configures for different compilers}

{$IFDEF BORPAS} {$M 65520, 0, 655360}
{$ELSE} {$UNDEF LFN} {$ENDIF}

{$IFDEF DELPHI} {$H-} {$ENDIF}

program CHEKLINX

  { For instructions, now see cheklinx.txt.
  www.merlyn.demon.co.uk   date follows } ;


uses {$IFDEF DELPHI} SysUtils {$ELSE} Dos {$ENDIF}
  {$IFDEF LFN}, LFN {$ENDIF} ;

const Today = '2006-01-27' ; { Try to allow for <A class=X href=... etc. }

type
S80 = string [80] ;
Pstring = ^string ;
Sort = (Nun, Src, Dst, Bas) ;
PItem = ^Item ;
Item = record Next : PItem ; Pstr : Pstring ; No : word end ;
TItems = array [Src..Dst] of PItem ;
PFileList = ^FileList ;
FileList = record Next : PFileList ; DosFiNa : Pstring ;
  Items : TItems ; Exists, Listed : boolean end ;
Perhaps = (Nay, Yes, Dunno) ;
APoI = array [Perhaps] of integer ;

const
Space = #32 ;
Spc = #32 { may change? } ;
AncLen = 20 ;
Colon : boolean = false ;
Viz : (Zero, Less, Norm, More, Lots, Full) = Norm { Enter as 0..4 } ;
LongWarn : (Lmiss, Lwarn, Lstop) = Lstop ;
UCWarn : (Cmiss, Cwarn, Cstop) = Cstop ;
QuoTest : (Qmiss, Qwarn, Qstop) = Qwarn ;
UnUsed : (Umiss, Uwarn, Ustop) = Umiss ;
Again : (Amiss, Awarn, Astop) = Astop ;
ParamTest : boolean = false ;
BSwarn : boolean = true ;
ACount : array [Src..Dst] of word = (0, 0) ;
TestDirs : APoI = (0, 0, 0) ;
TestFiles : APoI = (0, -1, 0) ;
TestAnkas : APoI = (0, 0, 0) ;
LocalURLs : word = 0 ;
FarURLs : word = 0 ;
OddArefs : word = 0 ;
Not8_3 : word = 0 ;
Empty : word = 0 ;
NotUsed : word = 0 ;
Dupes : word = 0 ;
BSlash : word = 0 ;
Relables : word = 0 ;
NoQuos : word = 0 ;
OptB : S80 = '' ;
WidthSearch : boolean = false ;
UCChars : word = 0 ;
NotHTM : word = 0 ;

Slant = '/' ;


procedure Um ;
begin if Viz<Norm then Writeln else begin Write(' <cr>') ; Readln end ;
  end {Um} ;


procedure Umm(const B : boolean) ;
begin if B then Um else Writeln end {Umm} ;


procedure WhyError(const WhyE, Doing : string ; const Error : integer) ;
begin
  Write(WhyE, Space) ; if Viz>Norm then Write(Doing, ': ') ;
  case Error of
    1 : Write('invalid function number') ;
    2 : Write('file not found') ;
    3 : Write('path not found') ;
    4 : Write('too many open files') ;
    5 : Write('file access denied') ;
    6 : Write('invalid file handle') ;
    12 : Write('invalid file access code') ;
    15 : Write('invalid drive number') ;
    18 : Write({'No more files'}'not found') ;
    else Write({'unexpected?'}'Error #', Error) ;
    end ;
  Um end {WhyError} ;


function UpCaseStr(S : string) : string ;
var B : byte ;
begin for B := 1 to Length(S) do S[B] := UpCase(S[B]) ;
  UpCaseStr := S end {UpCaseStr} ;


function ErrLoc(const S : string ; const N : word) : string ;
var S5 : string [5] ;
begin Str(N:4, S5) ;
  ErrLoc := '@ ' + S + Space + S5 ;
  end {ErrLoc} ;


procedure CheckNotEmptyValue(const FN, Got : string ; const LNo : word) ;
begin
  if Got='' then begin Write(ErrLoc(FN, LNo), ' "', Got, '" value empty') ;
    Um ;
    Inc(Empty) ; EXIT end ;
  end {CheckNotEmptyValue} ;


procedure Check8_3(const FN, Got : string ; const LNo : word) ;
var J, K, L : byte ;
begin K := 0 ; L := 8 ; J := 1 ;
  repeat
    if K>L then begin Write(ErrLoc(FN, LNo), ' "', Got, '" not 8.3') ;
      Umm(LongWarn=Lstop) ;
      Inc(Not8_3) ; EXIT end ;
    if J>Length(Got) then EXIT ;
    Inc(K) ;
    case Got[J] of
      Spc : K := 255 ;
      '#' : EXIT ;
      '.' : if L<>3 then begin K := 0 ; L := 3 end ;
      '/' : begin K := 0 ; L := 8 end ;
      end ;
    Inc(J) until false ;
  end {Check8_3} ;


procedure CheckCase(const FN, Got : string ; const LNo : word) ;
var J : byte ;
begin
  for J := 1 to Length(Got) do case Got[J] of
    'A'..'Z' : begin
      Write(ErrLoc(FN, LNo), ' "', Got, '" not lower case') ;
      Umm(UCWarn=Cstop) ;
      Inc(UCChars) ; EXIT end ;
    '#' : EXIT ;
    end ;
  end {CheckCase} ;


function PartMatch(const S, T : string) : boolean ;
var B : byte ;
begin PartMatch := false ;
  B := 1 ;
  while (B<=Length(S)) and (B<=Length(T)) do
    if S[B]<>T[B] then EXIT else Inc(B);
  PartMatch := true end {PartMatch} ;


function SeekFileRef(const UpG, Start, Need, Name : string ;
  var Got : string ; var So : Sort) : boolean ;
{ Need is for NAME in PARAM }
var B : byte ;
begin SeekFileRef := false ;
  if Length(Start)>Length(UpG) then EXIT ;
  for B := 1 to Length(Start) do if UpG[B]<>Start[B] then EXIT ;
  if Length(Need)>0 then if Pos(Need, UpG)=0 then EXIT ;
  B := Pos(Name, UpG) ;
  if B>0 then begin SeekFileRef := true ;
    So := Src ; Delete(Got, 1, B+Length(Name)-1) end ;
  end {SeekFileRef} ;


function Hex(const C : char) : byte ;
begin Hex := Pred(Pos(UpCase(C), '0123456789ABCDEF')) end {Hex} ;

{ CRD = Current Relative Directory
  FB = File Base ? }

procedure ExamineInLtGt(var Got : string ; var FB, CRD : S80 ;
  const Root : PFileList ; const LNo : word) ;
var PL : PItem ; PMore, Q : byte ; So : Sort ; Ch : char ; B : boolean ;
S4 : string [4] ; UpG : string ;
begin
  UpG := UpCaseStr(Got) ;
  So := Nun ;


  repeat

    if Copy(UpG, 1, 2)='A'+Spc then begin Q := 3 ;
      while (UpG[Q]=Spc) and (Q<255) do Inc(Q) ;
      S4 := Copy(UpG, Q, Q+3) ;
      if S4='HREF' then So := Src else if S4='NAME' then So := Dst ;
      if So=Nun then begin Inc(OddArefs) ;
        Write(ErrLoc(Root^.DosFiNa^, LNo), ' <A ', S4, ' ...> eh?') ;
        Um end {So=Nun} ;
      Delete(Got, 1, Q+4) ;
      BREAK end {A HREF=} ;
    (* *)
    if (UpG[1]='H') and (UpG[2] in ['1'..'6']) then begin Q := 4 ;
      while (UpG[Q]=Spc) and (Q<255) do Inc(Q) ;
      if Copy(UpG, Q, Q+1) ='ID' then So := Dst ;
      Delete(Got, 1, Q+2) ;
      BREAK end {Hn ID=} ;
    (*  *)
    if ParamTest then
      if Copy(UpG, 1, 6)='PARAM ' then begin
      if SeekFileRef(UpG, '', 'IMAGE',    'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'FILENAME', 'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'URL',      'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'DATAURL',  'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'SRC',      'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'LINK',     'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'SOURCE',   'VALUE=', Got, So) then BREAK ;
      if SeekFileRef(UpG, '', 'MOVIE',    'VALUE=', Got, So) then BREAK ;
      end {PARAM} ;

    if SeekFileRef(UpG, 'IMG ',    '', 'SRC=',   Got, So) then BREAK ;
    if SeekFileRef(UpG, 'SCRIPT ', '', 'SRC=',   Got, So) then BREAK ;
    if SeekFileRef(UpG, 'FRAME ',  '', 'SRC=',   Got, So) then BREAK ;
    if SeekFileRef(UpG, 'IFRAME ',  '', 'SRC=',   Got, So) then BREAK ;
    if SeekFileRef(UpG, 'EMBED ',  '', 'SRC=',   Got, So) then BREAK ;
    if SeekFileRef(UpG, 'AREA ',   '', 'HREF=',  Got, So) then BREAK ;
    if SeekFileRef(UpG, 'LINK ',   '', 'HREF=',  Got, So) then BREAK { CSS } ;
    if SeekFileRef(UpG, 'APPLET ', '', 'CODE=',  Got, So) then BREAK ;
    { if SeekFileRef(UpG, 'OPTION ', '', 'VALUE=', Got, So) then BREAK { Select } ;
    if SeekFileRef(UpG, 'META ',   '', 'URL=',   Got, So) then
      begin { Writeln('META : *', Got, '*') ; }
      if Got[Length(Got)] in ['''','"'] then Dec(Got[0]) ;
      {       Writeln('META : *', Got, '*') ; }
      BREAK end ;

    if Copy(UpG, 1, 9)='BASE HREF' then begin So := Bas ;
      Writeln(ErrLoc(Root^.DosFiNa^, LNo),
        ' <BASE HREF= ...> not (yet?) fully handled OK ?') ;
      Delete(Got, 1, 10) ;
      BREAK end {BASE HREF=} ;

    until TRUE ;


  if So=Nun then EXIT ;

  while (Got>'') and (Got[1]=Spc) do Delete(Got, 1, 1) ;

  if Got>'' then { reduce to file name } begin Ch := Got[1] ;
    B := not (Ch in ['"', '''']) ;
    if B then Pmore := Pos(Spc, Got)
      else begin Delete(Got, 1, 1) ; Pmore := Pos(Ch, Got) end ;
    if Pmore>0 then Delete(Got, Pmore, 255) ;
    if B and (QuoTest>QMiss) then begin Inc(NoQuos) ;
      Write(ErrLoc(Root^.DosFiNa^, LNo), ' "', Got, '": not in quotes') ;
      Umm(QuoTest=Qstop) end ;
    end ;

  if Copy(Got, 1, 1)='!' then EXIT { See JRS's puzzles.htm ! } ;

  Pmore := Pos('?', Got) ; if PMore>0 then Delete(Got, PMore, 255) ;

  if So<>Bas then begin
    Pmore := Pos(':', Got) ;
    if Pmore>0 then begin { only use relative references }
      if (OptB>'') and (Pos(OptB, Got)=1) and (Got<>OptB+Root^.DosFiNa^) then
        begin Inc(Relables) ;
        Write(ErrLoc(Root^.DosFiNa^, LNo), ' "', Got, '" make relative?') ;
        Um ; EXIT end ;
      if (Pmore<3) or (not (UpCase(Got[Pmore-2]) in ['A'..'Z'])) or
        (Pos('FILE:', UpCaseStr(Got))>0) then begin
        if Viz>More then Writeln ;
        if Viz>Zero then begin
          Write(ErrLoc(Root^.DosFiNa^, LNo), ' "', Got, '": local?') ;
          Umm(Colon) ;
          end ;
        Inc(LocalURLs) ; EXIT end ;
      Inc(FarURLs) { presume it is a full URL, so ignore } ;
      EXIT end ;
    end {<>Bas} ;

  if So=Src then if BSwarn and (Pos('\', Got)>0) then begin
    Write(ErrLoc(Root^.DosFiNa^, LNo), ' "', Got, '" has "\"') ;
    Inc(BSlash) ; Um end else begin
    (* CheckNotEmptyValue(Root^.DosFiNa^, Got, LNo) ; *)
    if LongWarn>Lmiss then Check8_3(Root^.DosFiNa^, Got, LNo) ;
    if UCWarn>Cmiss then CheckCase(Root^.DosFiNa^, Got, LNo) ;
    end ;

  if So in [Src, Dst] then CheckNotEmptyValue(Root^.DosFiNa^, Got, LNo) ;

  (*
    Present plan is (/B option is the Web dir of the DOS current directory)
    1) to remark on presence of BASE - OK (above).
    2) if no /B option, assert that BASE HREF gives the current Web
    directory - then all works normally.
    3) else if BASE HREF equals /B + relative offset, it is as 2).
    4) else if BASE HREF equals /B ... might be able to handle it.
    5) else if BASE HREF and /B are equal after truncation of longer,
    apologise for the case being difficult.
    6) else express disbelief in one or both strings.
    *)

  if So=Bas then begin
    if Got[Length(Got)]<>'/' then begin
      Write(' ?? "', Got, '" does not end in "/"') ; Um ; EXIT end ;
    if OptB='' then begin
      Writeln(' ?? No OptB : assume that is the current Web directory.') ;
      EXIT end ;
    if OptB+CRD=Got then begin
      Write(' ?? HREF=OptB+CRD : so it is the current Web directory; OK.') ;
      Um ; EXIT end ;
    if OptB=Got then begin
      Write(' ?? HREF=OptB, CRD>"" : use Web root directory; OK?') ;
      CRD := '' ; Um ; EXIT end ;

    Writeln(' ?? BASE is "', Got, '"'^M^J' ?? OptB is "', OptB, '"') ;
    if PartMatch(Got, OptB) then begin
      case Length(Got)>=Length(OptB) of
        true : begin FB := '' ;
          CRD := Copy(Got, Succ(Length(OptB)), 255) end ;
        false : begin CRD := '' ;
          FB := Copy(OptB, Succ(Length(Got)), 255) end ;
        end ;
      Write(' ?? PartMatch : being tried') ; Um ; EXIT end ;

    Write(' ?? MisMatch : cannot be handled') ; Um ; EXIT ;
    end {Bas} ;

  if So in [Src, Dst] then with Root^ do begin
    PL := Items[So] ; New(Items[So]) ;
    with Items[So]^ do begin Next := PL ; No := LNo ;
      if So=Src then repeat Q := Pos('%', Got) ; if Q=0 then BREAK ;
        Got[Q] := char(Hex(Got[Q+1])*16+Hex(Got[Q+2])) ;
        Delete(Got, Q+1, 2) until false ;
      { if So=Src then
        for Q := 1 to Length(Got) do if Got[Q]='/' then Got[Q] := Slant ; }
      if (So=Dst) and (Length(Got)>AncLen) then Got[0] := char(AncLen) ;
      GetMem(Pstr, Succ(Length(FB)+Length(Got))) ;
      Pstr^ := FB+Got ;
      end {Items[So]^} ;
    Inc(ACount[So]) end {Root^} ;

  end {ExamineInLtGt} ;




procedure Ingest(var F : file ; const DN : S80 ; var FB, CRD : S80 ;
  const Root : PFileList) ;
const CommTest : string [3] = '!--' ;
BufMin = -8192 { -512 {-256} ; BufMax = 16383 { < MaxInt } ;
var InBuf : array [BufMin..BufMax] of char ;
PGot : Pstring ; Icom, LineNumber, LNo : word ;
BufEnd, PosLT, PosGT, NewPos : integer ;
C : char ; Find : (LT, GT, EC) ;
begin LineNumber := 1 ;
  if Viz>More then Write(' Ingesting ') ;

  PosLT := 0 ; Find := LT ;

  repeat

    BlockRead(F, InBuf[0], BufMax+1, BufEnd) ;
    if BufEnd=0 then BREAK ;

    repeat

      if Find=LT then begin

        while PosLT<BufEnd do begin C := InBuf[PosLT] ;
          if C=^J then Inc(LineNumber) ;
          if C='<' then BREAK ;
          Inc(PosLT) end ;

        if PosLT=BufEnd then begin PosLT := 0 ; BREAK { to BlockRead } end ;

        Find := GT ; Icom := 1 ; PosGT := PosLT+1 ; LNo := LineNumber ;
        end {LT} ;

      if Find=GT then begin

        while PosGT<BufEnd do begin C := InBuf[PosGT] ;
          if C=^J then Inc(LineNumber) ;
          if Icom in [1..3] then
            if C=CommTest[Icom] then Inc(Icom) else Icom := 0 ;
          if Icom=4 then begin
            Find := EC ; {Inc(PosGT)?} Icom := 0 ; BREAK end ;
          if C<=Space then InBuf[PosGT] := Spc ;
          if C='>' then BREAK ;
          Inc(PosGT) end ;

        if PosGT=BufEnd then begin { move [PosLT..BufEnd] to ..-1 }
          NewPos := PosLT-BufEnd ;
          if NewPos<BufMin then begin
            Writeln(^M^J'*** File ', DN, ' Line ', LineNumber, ' Problem; ',
              '< ... > too wide for buffer slide?') ;
            HALT end ;
          Move(InBuf[PosLT], InBuf[NewPos], BufEnd-PosLT) ;
          PosLT := NewPos ; PosGT := 0 ; BREAK { to BlockRead } end ;

        end {GT} ;

      if Find=GT then begin

        PGot := Addr(InBuf[PosLT]) ;
        NewPos := PosGT-PosLT-1 ; if NewPos>255 then NewPos := 255 ;
        PGot^[0] := Char(NewPos) ;

        if Length(PGot^) >= Length('A NAME=1') then
          ExamineInLtGt(PGot^, FB, CRD, Root, LNo) { content of < .. > } ;

        Find := LT ; PosLT := PosGT ;

        end {GT} ;

      if Find=EC then begin
        while PosGT<BufEnd do begin C := InBuf[PosGT] ;
          if C=^J then Inc(LineNumber) ;
          if (C='>') and (Icom=2) then BREAK ;
          if C='-' then Inc(Icom) else Icom := 0 ;
          Inc(PosGT) end ;

        if PosGT=BufEnd then begin PosGT := 0 ; BREAK { to BlockRead } end ;

        Find := LT ; PosLT := PosGT ;
        end {EC} ;

      until false ;

    until false ;

  if Viz>More then Write(' Ingested ', LineNumber, ' lines ') ;
  Root^.Listed := true ;
  end {Ingest} ;



const
FLRoot : PFileList = NIL ;
FileCount : word = 0 ;
MaxFiles : word = $FFFF ;
MaxDeep : word = $FFFF ;


procedure ListUnusedNames ;
var PFL : PFileList ; PN : PItem ;
begin PFL := FLRoot ;
  while PFL<>NIL do begin
    PN := PFL^.Items[Dst] ;
    while PN<>NIL do begin
      if PN^.No<>0 then begin Inc(NotUsed) ;
        Write('@ ', PFL^.DosFiNa^,
          Space, PN^.No, ' "', PN^.Pstr^, '": unused NAME.') ;
        Umm(UnUsed=Ustop) ;
        end ;
      PN := PN^.Next end ;
    PFL := PFL^.Next end ;
  end {ListUnusedNames} ;


function PrependToFileList(const DosFileName : string) : PFileList ;
var PTemp : PFileList ;
begin
  PTemp := FLRoot ; New(FLRoot) ;
  with FLRoot^ do begin Next := PTemp ;
    Items[Src] := NIL ; Items[Dst] := NIL ;
    GetMem(DosFiNa, Succ(Length(DosFileName))) ; DosFiNa^ := DosFileName ;
    Exists := false ; Listed := false end ;
  PrependToFileList := FLRoot end {PrependToFileList} ;


var F : file { Each file is closed before another is attempted } ;
SR : {$IFDEF DELPHI} TSearchRec {$ELSE} SearchRec {$ENDIF} ;


procedure VerifyFile(const DosName, FB, CRD, HTMLname : S80 ;
  const PDst : PFileList ; const Deep : word) ; forward ;


procedure ProcessName
  (var PdstFile : PFileList ; var FB, CRD, HTMLname, DosName : S80 ;
  const WhyP : string ; const Deep : word) ;
{$IFDEF DELPHI}
{} const AnyFile = faAnyFile ; VolumeID = faVolumeID ;
{} var DosError : integer ;
{$ENDIF}
{ type Bits = (RO, Hd, Sy, VI, D, A) ; ByteSet = set of Bits ; }
var IOR : integer ; Extn : string [5] ;
ReadIt, Diry, GoodDy, HTML : boolean ; B : byte ;
begin
  if Viz>More then Write(' Prepend ') ;

  PdstFile := PrependToFileList(DosName) ;

  Diry := DosName[Length(DosName)]=Slant ;

  if Diry then Dec(DosName[0]) ;

  if Viz>More then Write(' FindFirst ') ;
  {$IFDEF DELPHI} DosError := {$ENDIF}
    FindFirst(DosName, AnyFile-VolumeID, SR) ;
  if DosError<>0 then begin
    if Diry then Inc(TestDirs[Nay]) else Inc(TestFiles[Nay]) ;
    WhyError(WhyP, 'FindFirst', DosError) ;
    EXIT end ;
  if Viz>More then Write('FF-OK ') ;

  B := SR.Attr { Attr is integer in D3 } ;
  GoodDy := Diry = ((B and $10)>0) ;

  {$UNDEF FC}
  {$IFDEF LFN} {$DEFINE FC} {$ENDIF}
  {$IFDEF DELPHI} {$DEFINE FC} {$ENDIF}
  {$IFDEF FC} FindClose(SR) ; {$ENDIF}

  case Diry of
    true: begin
      Inc(TestDirs[Perhaps(GoodDy)]) ;
      if GoodDy then PdstFile^.Exists := true else begin
        Write(WhyP, ' non-directory found') ; Um ; EXIT end ;
      if Viz>More then Writeln(' directory exists.') ;
      end ;
    false: begin
      if not GoodDy then begin Inc(TestFiles[Nay]) ;
        Write(WhyP, ' directory found') ; Um ; EXIT end ;
      if Viz>More then Write(' Opening ') ;
      Assign(F, DosName) ;
      {$I-} Reset(F, 1) ; {$I+} IOR := IOResult ;
      Inc(TestFiles[Perhaps(IOR=0)]) ;
      if IOR<>0 then begin if Viz>More then Writeln ;
        WhyError(WhyP, 'Open', IOR) end ;
      if IOR=0 then begin
        PdstFile^.Exists := true ;
        Extn := UpCaseStr(Copy(HTMLname, Length(HTMLname)-3, 4)) ;
        HTML := ((Extn='.HTM') or (Extn='HTML')) ;
        if not HTML then Inc(NotHTM) ;
        ReadIt := HTML and (Deep<MaxDeep) and (FileCount<MaxFiles) ;
        if ReadIt then Ingest(F, DosName, FB, CRD, FLRoot) ;
        Close(F) ; if Viz>More then Writeln(' Closed.') ;
        if ReadIt then begin
          VerifyFile(DosName, FB, CRD, HTMLname, PdstFile, Deep+1) ;
          end {ReadIt} ;
        end {IOR=0} ;
      end ;
    end {case} ;

  end {ProcessName} ;



function TestName(FB, CRD, HTMLname : S80 ;
  const WhyT : string ; const Deep : word) : PFileList ;
var PdstFile : PFileList ; NewDosName, OldDosName : S80 ; P : byte ;
begin
  if Viz>Lots then begin OldDosName := CRD + HTMLname ;
    Writeln(^M^J' TestName "', OldDosName, '"') end ;

  if Pos('...', HTMLname)>0 then begin Write(WhyT, ' treble-dot') ; Um end ;

  if Copy(HTMLname, 1, 1) = Slant then
    begin Delete(HTMLname, 1, 1) ; CRD := '' end ;

  while Copy(HTMLname, 1, 3) = '..'+Slant do if CRD>'' then
    begin Delete(HTMLname, 1, 3) ;
    repeat Dec(CRD[0]) until (Length(CRD)=0) or (CRD[Length(CRD)]=Slant) ;
    end else BREAK ;

  (* repeat B := Pos('.'+Slant, HTMLname) ;
    if B=0 then BREAK ;
    if Viz>More then Writeln('!! ', HTMLName) ;
    Delete(HTMLname, B, 2) until false ; *)

  repeat P := Pos(Slant, HTMLname) ;
    if P=0 then BREAK ;
    CRD := CRD+Copy(HTMLname, 1, P) ; Delete(HTMLname, 1, P) ;
    until false ;

  NewDosName := CRD + HTMLname ;

  PdstFile := FLRoot ;
  while PdstFile<>NIL do begin
    if PdstFile^.DosFiNa^ = NewDosName then BREAK ;
    PdstFile := PdstFile^.Next end ;


  if PdstFile<>NIL then begin
    if not PdstFile^.Exists then
      begin Write(WhyT, ' already not found') ; Umm(Again=AStop) end else
      if Viz>More then Writeln(' file known.') ;
    TestName := PdstFile ; EXIT end ;


  if Viz>More then Write(^M^J' TestName "', NewDosName, '" ') ;

  if NewDosName>'' then
    ProcessName(PdstFile, FB, CRD, HTMLname, NewDosName, WhyT, Deep) ;

  TestName := PdstFile ;
  if Viz>Lots then Writeln(' TestName "', OldDosName, '" done.') ;
  end {TestName} ;


var BatF : text ;
const BatCmd : S80 = 'Test' ; BatNam : S80 = 'NUL' ;


procedure VerifyFile(const DosName, FB, CRD, HTMLname : S80 ;
  const PDst : PFileList ; const Deep : word) ;
var PdstFile : PFileList ; PsrcItem, PdstItem, PT, PX : PItem ;
PWhy, Want : PString ; WebNam : S80 ; Anchor : string [AncLen] ; B : byte ;
begin New(PWhy) ;
  if Viz>More then
    Writeln(' VerifyFile "', DosName, '" :-') ;
  Inc(FileCount) ;
  if Viz in [Less, Norm] then
    Writeln(' LinkSeek', FileCount:4, ',', Deep:4, '; ',
    {$IFDEF R}
    {$IFDEF BORPAS} Sptr, Space, {$ENDIF} MemAvail, '; ',
    {$ENDIF}
    DosName) ;
  Writeln(BatF, BatCmd, Spc, DosName) ;

  {Make reversed list :}
  PX := PDst^.Items[Dst] ; PdstItem := NIL ;
  while PX<>NIL do begin
    PT := PX^.Next ; PX^.Next := PdstItem ; PdstItem := PX ; PX := PT end ;
  PDst^.Items[Dst] := PdstItem ;

  {Duplicate name check :}
  PX := PdstItem ;
  while PX<>NIL do begin
    PT := PX^.Next ;
    while PT<>NIL do begin
      if PT^.PStr^=PX^.PStr^ then begin
        Write(ErrLoc(DosName, PX^.No), ' ', PT^.No,
          ' "', PX^.PStr^, '" repeated') ;
        Inc(Dupes) ; Um ; BREAK end ;
      PT := PT^.Next end ;
    PX := PX^.Next end ;

  {Make reversed list :}
  PX := PDst^.Items[Src] ; PsrcItem := NIL ;
  while PX<>NIL do begin
    PT := PX^.Next ; PX^.Next := PsrcItem ; PsrcItem := PX ; PX := PT end ;

  while PsrcItem<>NIL do begin
    with PsrcItem^ do begin
      Want := PStr ;
      B := Pos('#', Want^) ; if B=0 then B := 254 ;
      WebNam := Copy(Want^, 1, Pred(B)) ;
      Anchor := Copy(Want^, Succ(B), 255) ;

      PWhy^ := ErrLoc(DosName, No) + ' "'+Want^+'":' ;

      if Viz>More then Write(Space, PWhy^) ;

      if WebNam='' then PdstFile := PDst else
        PdstFile := TestName(FB, CRD, WebNam, PWhy^, Deep) ;

      if Anchor<>'' then with PdstFile^ do if Exists then case Listed of
        true : begin
          if Viz>More then
            Write(^M^J'   Seek "', Anchor, '" in "', DosFiNa^ , '" ') ;
          PdstItem := Items[Dst] ;
          while PdstItem<>NIL do begin
            if PdstItem^.Pstr^=Anchor then BREAK ;
            PdstItem := PdstItem^.Next end {PdstItem} ;
          Inc(TestAnkas[Perhaps(PdstItem<>NIL)]) ;


          if PdstItem<>NIL then PdstItem^.No := 0 ; (***)

          if PdstItem<>NIL then
            begin if Viz>More then Writeln(' OK.') end else begin
            if Viz>More then Writeln ;
            Write(PWhy^, ' NAME not found') ; Um ;
            end {NIL} ;


          end {Listed} ;
        false : begin if Viz>More then Writeln ;
          Inc(TestAnkas[Dunno]) end {not Listed} ;
        end {case} ;
      end {PsrcItem^} ;

    PT := PSrcItem ;
    PsrcItem := PsrcItem^.Next ;
    with PT^ do FreeMem(Pstr, Succ(Length(Pstr^))) ; Dispose(PT) ;

    end {PsrcItem<>NIL} ;

  if Viz>More then
    Writeln(' VerifyFile "', DosName, '" done; file ', FileCount, '.') ;
  Dispose(PWhy) end {VerifyFile} ;



{$IFDEF SLASH}

procedure NewProcess(FLPtr : PFileList) ;
var FB, CRD : S80 ;
begin FB := '' ; CRD := '' ;
  Writeln('NewProcess "', FLPtr^.DosFiNa^, '"') ;
  { ProcessName(FLPtr, FB, CRD, FLPtr^.DosFiNa^, FLPtr^.DosFiNa^, Why, Deep) ;
    { ... }
  end {NewProcess} ;


procedure NewJob(const Param : string) ;
var FLPtr : PFileList ;
begin Writeln('NEWJOB BEGIN') ;
  { Create list entry for given file "Param" }
  New(FLRoot) ;
  with FLRoot^ do begin
    Next := NIL ; DosFiNa := Addr(Param) ;
    Items[Src] := NIL ; Items [Dst] := NIL ;
    Exists := false {?} ; Listed := false ;
    end ;
  { Scan list ; NewProcess generally extends it }
  FLPtr := FLRoot ;
  repeat
    NewProcess(FLPtr) ;
    FLPtr := FLPtr^.Next until FLPtr = NIL ;
  Writeln('NEWJOB END') end {NewJob} ;

{$ENDIF SLASH}


procedure ReportCounts(const S : string ; const A : APoI) ;
begin Write('  Relative citations: ', S:12,
    ' - missing ', A[Nay], ', found ', A[Yes]) ;
  if A[Dunno]>0 then Write(', untested ', A[Dunno]) ;
  Writeln(' ;') end {ReportCounts} ;


function QStr(const B : boolean ; N : word) : string ;
var S : string [5] ;
begin S := '?' ; if B then Str(N, S) ; QStr := S end {QStr} ;


procedure Help ;
begin
Writeln('CHEKLINX.PAS  www.merlyn.demon.co.uk >= ', Today,
  ^M^J' Compiled with ',

  {$IFDEF  BORPAS} 'Borland ', {$ELSE}
  {}               'Unknown ', {$ENDIF}

  {$IFDEF DELPHI} 'Delphi.  ', {$ENDIF}

  {$IFDEF PASCAL} 'Pascal ',
  {} {$IFDEF MSDOS} 'MSDOS', {$ELSE}
  {} {$IFDEF  DPMI}  'DPMI', {$ELSE}
  {}              'Unknown', {$ENDIF} {$ENDIF}
  ' mode.  ', {$ENDIF}

  {$IFDEF BORPAS} {$IFNDEF LFN} 'No ', {$ENDIF} {$ENDIF} 'LFN.  ',

  '/H for Help.') ;

  Writeln('CHEKLINX [options] RootFile ...') ;
  Writeln(' opts:',
    ^I'/: wait on local refs'^I^I'/Bbase - HREF= of current directory'^M^J,
    ^I'/Dn file seek depth'^I^I'/Fn file seek count'^M^J,
    ^I'/Jbatcmd - default "test"'^I'/Kbatfil - filenames file - X.BAT'^M^J,
    ^I'/Cn, /Ln, /Qn, /Un - n = 0,1,2 = Miss, Show, Stop for:'^M^J,
    ^I^I'UpperCase, file component >8.3, unquoted link, unused NAME'^M^J,
    ^I'/P look in <PARAM...>',
    ^I^I'/Vn volubility (', byte(Zero), '..', byte(Full), ')'^M^J,
    ' For more, now see in cheklinx.txt.' ) ;
  HALT end ;


procedure DoAFilePara(const Para : string) ;
begin
  if Viz>Zero then Writeln('Doing ', Para) ;
  Assign(BatF, BatNam) ; Rewrite(BatF) ;
  case WidthSearch of
    false : if not TestName('', '', Para, '', 0)^.Exists then begin
      Writeln('** Some error "', Para, '".') ; Help end ;
    true : {$IFDEF SLASH} NewJob(Para) {$ENDIF} ;
    end {case WidthSearch} ;
  Close(BatF) ;
  if UnUsed>Umiss then ListUnusedNames ;
  end {DoAFilePara} ;


procedure ProcessParameters ;
var J, N : integer ; Para : S80 ;
{} procedure Ow ;
{} begin Writeln('** Parameter error "', Para, '".') ; Help end {Ow} ;
begin
  for J := 1 to ParamCount do begin Para := ParamStr(J) ;

    if Pos(Para, '/? -? /h -h /H -H')>0 then Help ;

    case Para[1] of
      '/' : if Length(Para)<2 then Ow else
        case UpCase(Para[2]) of
        ':' : Colon := true ;
        'A' : begin Val(Copy(Para, 3, 255), byte(Again), N) ;
          if N<>0 then Ow ;
          end ;
        'B' : OptB := Copy(Para, 3, 255) ;
        'C' : begin Val(Copy(Para, 3, 255), byte(UCWarn), N) ;
          if N<>0 then Ow ;
          end ;
        'D' : begin Val(Copy(Para, 3, 255), MaxDeep, N) ;
          if N<>0 then Ow ;
          end ;
        'F' : begin Val(Copy(Para, 3, 255), MaxFiles, N) ;
          if N<>0 then Ow ;
          end ;
        'J' : BatNam := Copy(Para, 3, 255) ;
        'K' : BatCmd := Copy(Para, 3, 255) ;
        'L' : begin Val(Copy(Para, 3, 255), byte(LongWarn), N) ;
          if N<>0 then Ow ;
          end ;
        'P' : ParamTest := true ;
        'Q' : begin Val(Copy(Para, 3, 255), byte(QuoTest), N) ;
          if N<>0 then Ow ;
          end ;
        'V' : begin Val(Copy(Para, 3, 255), byte(Viz), N) ;
          if N<>0 then Ow ;
          end ;
        'U' : begin Val(Copy(Para, 3, 255), byte(UnUsed), N) ;
          if N<>0 then Ow ;
          end ;
        {$IFDEF SLASH} '/' : WidthSearch := true ; {$ENDIF} { use // param }
        else Ow end {case P2};
      '\' : begin Write('** File not relative: ') ; Ow end ;
      else begin
        DoAFilePara(Para) ;
        if J<ParamCount then begin Write('Done ', Para) ; Um end ;
        end ;
      end {case P1} ;

    end {J} ;
  end {ProcessParameters} ;


procedure DoReport ;
const S : array [boolean] of string [1] = ('', 's') ;
begin
  if Viz=Zero then EXIT ;
  Writeln(' Summary:', FileCount:5, ' file', S[FileCount<>1], ' tested ;',
    ACount[Dst]:6, ' anchors seen ;',
    ACount[Src]:6, ' relative cites seen ;') ;
  ReportCounts('directories', TestDirs) ;
  ReportCounts('filenames', TestFiles) ;
  ReportCounts('anchors', TestAnkas) ;
  Writeln('  Local URLs ', LocalURLs,
    ' ;  Odd A-refs ', OddArefs, ' ;  Make relatives ', Relables,
    ' ;  NotHTM ', NotHTM, ' ;') ;
  Writeln(
    '  Links over 8.3 format ', QStr(LongWarn>Lmiss, Not8_3), ' ;',
    '  Links with Upper Case ', QStr(UCWarn>Cmiss, UCChars),
    ' ;  Links with "\" ', BSlash, ' ;') ;
  Writeln('  Repeated NAMEs ', Dupes,
    ' ;  Unused NAMEs ', QStr(UnUsed>Umiss, NotUsed),
    ' ;  UnQuoted HREF/NAME/&c. ', QStr(QuoTest>QMiss, NoQuos), ' ;') ;
  Writeln('  Empty values ', Empty, ' ;  Far URLs ', FarURLs, ' ;') ;
  end {DoReport} ;




BEGIN ;
{$IFDEF HEAPLIMIT (needs BP7 DPMI)} HeapLimit := 1 ; {$ENDIF}
FileMode := 0 ;
ProcessParameters ;
if FileCount=0 then DoAFilePara('index.htm') ;
if FileCount>0 then DoReport ;
if Viz>Zero then Writeln('CHEKLINX Done.') ; { Um ; }
END.