[abcdef]

Практически полноценный html-парсер, можно производить парсинг любых тегов и их параметров.. делал для оптимизации html-страниц, где нужно было вырезать теги с учетом вложенности, или убирать ненужные параметры..

var
  res : resource;
  s,st,txt : string;
  id_txt : integer;
  i,len,b : integer;
  c : char;


procedure addText(s:string);
begin
  txt:=txt+s+chr(10);
  formRemove(id_txt);
  id_txt:=formAddString(txt);
end;


procedure nextb;
begin
  if (i<len) then
  begin
    b:=ord(getChar(s,i));
    i:=i+1;
  end;
end;


procedure nextstr;
begin
  while (b<=32) and (i<len) do nextb;  //убрать пробелы и т.д..
  if (b=ord('#')) or (b=ord(';'))
  or ((b>=ord('0')) and (b<=ord('9')))
  or ((b>=ord('A')) and (b<=ord('Z')))
  or ((b>=ord('a')) and (b<=ord('z'))) then
  begin  //получить строку
    st:='';
    repeat
      if (b>=65) and (b<=90) then b:=b+32;
      st:=st+chr(b);
      nextb;
    until (i>=len) or not (((b>=ord('0')) and (b<=ord('9'))) or ((b>=ord('A')) and (b<=ord('Z'))) or ((b>=ord('a')) and (b<=ord('z'))));
  end
  else if (b=ord('"')) then
  begin  //строку в двойных кавычках
    st:='';
    repeat
      st:=st+chr(b);
      nextb;
    until (b=ord('"')) or (i>=len);
    st:=st+'"';
    nextb;
  end
  else if (b=ord('''')) then
  begin  //строку в одинарных кавычках
    st:='';
    repeat
      st:=st+chr(b);
      nextb;
    until (b=ord('''')) or (i>=len);
    st:=st+'''';
    nextb;
  end
  else
  begin  //любой другой символ
    st:=chr(b);
    nextb;
  end;
end;


begin
  showForm;
  id_txt := formAddString('Programming by arT (c). [email protected]');
  res := openResource('/1.htm');
  if resourceAvailable(res) then
  begin
    s:='';
    len:=0;
    b:=readByte(res);
    while (b<>0) do
    begin
      s:=s+chr(b and 255);
      b:=readByte(res);
      len:=len+1;
    end;
    closeResource(res);
  end;
  i:=0;
  b:=0;
  addText('scan START ('+len+')...');
  repeat
    if b=ord('<') then
    begin
      nextb;
      nextstr;
      if (st='a') then
      begin
        nextstr;
        if (st='href') then
        begin
          nextstr;
          if (st='=') then
          begin
            nextstr;
            if (length(st)>8) then
            if (copy(st,1,8)='http://') then
            begin
              addText(st);  //нашли гиперссылку...
            end;
          end;
        end;
      end
      else if (st='/') then
      begin
        nextstr;
        if (st='html') then addText('/html => ok!');
      end;
    end
     else nextb; //следующий символ
  until (i>=len);
  addText('COMPLETED...');
  repeat delay(100); until false;
end.