procedure FindLinks(Datei: string; gefunden: TStrings); 
const 
  a: array[0..1] of char = ('<', 'a'); 
  b: array[0..3] of char = ('h', 'r', 'e', 'f'); 
var 
  sl, gef: TStringlist; 
  pb: Pchar; 
  position, lg: integer; 
  procedure weiter(i: integer); 
  begin 
    inc(position, i); 
    inc(pb, i); 
  end; 
  function leerzeichenweg: boolean; 
  begin 
    result := false; 
    while pb^ in [#13, #10, #32, '\'] do begin 
      weiter(1); 
      if position >= lg then exit; 
    end; 
    result := true; 
  end; 
  function anfang: boolean; 
  begin 
    result := false; 
    while not comparemem(@a, pb, 2) do begin 
      weiter(1); 
      if position >= lg - 7 then exit; 
    end; 
    weiter(2); 
    if (not leerzeichenweg) then exit; 
    if (not comparemem(@b, pb, 4)) then exit; 
    weiter(4); 
    if (not leerzeichenweg) or (pb^ <> '=') then exit; 
    weiter(1); 
    if (not leerzeichenweg) then exit; 
    if pb^ = '"' then weiter(1); 
    result := true; 
  end; 
  procedure ende; 
  var 
    hlp: string; 
    pe: pointer; 
    merk: integer; 
  begin 
    pe := @pb^; 
    merk := position; 
    while (pb^ <> '"') and (pb^ <> '>') 
      do begin 
      weiter(1); 
      if position >= lg then break; 
    end; 
    setlength(hlp, position - merk); 
    copymemory(@hlp[1], pe, position - merk); 
    hlp := stringreplace(Trim(stringreplace(hlp, #10, '', 
      [rfReplaceAll])), #13, '', [rfReplaceAll]); 
    if ansilastchar(hlp) = ':' then delete(hlp, length(hlp), 1); 
    if copy(hlp, 1, 6) <> 'mailto' then 
      gef.add(hlp); 
  end; 
begin 
  gefunden.clear; 
  sl := TStringlist.create; 
  gef := TStringlist.create; 
  gef.sorted := true; 
  gef.Duplicates := dupIgnore; 
  try 
    sl.LoadFromFile(datei); 
    sl.text := Ansilowercase(sl.text); 
    sl.text := stringreplace(sl.text, ' ', #32, [rfreplaceall]); 
    lg := length(sl.text); 
    pb := @sl.text[1]; 
    position := 0; 
    repeat 
      if anfang then ende 
      else weiter(1); 
    until position >= lg - 7; 
    gefunden.assign(gef); 
  finally 
    gef.free; 
    sl.free 
  end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button11Click(Sender: TObject); 
begin 
  FindLinks('C:\Eigene Dateien\Eigene Webs\Delphi\main.htm', listbox1.items); 
  if listbox1.items.count = 0 then 
    listbox1.items.add('--- Nichts gefunden ---') else 
    listbox1.sorted := true; 
end;