VPF::Работа с IHTMLDocument2 - Форум программистов

Matematik

Дата 6.5.2006, 10:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: нет
Всего: 50

С тем как его создать я разобрался http://forum.vingrad.ru/index.php?showtopic=93651 .
А как его уничтожить я не знаю.

Код


unit uParseHTML;

interface

uses Classes, mshtml, ActiveX, Variants;

procedure Init_parser;
procedure Close_parser;
procedure daj_all_link(var aBuff:AnsiString;aLinkList,aTextList:TStrings);

implementation

var
  iDoc : IHTMLDocument2;

procedure Init_parser;
begin
  idoc := CoHTMLDocument.Create as IHTMLDocument2;
end;

procedure Close_parser;
begin
  if assigned(iDoc) then
  begin
    iDoc.Close;
    iDoc := nil;
  end;
end;

procedure set_buff(var aBuff:AnsiString);
var v : Variant;
begin
  v    := VarArrayCreate([0, 0], varVariant);
  v[0] := aBuff;
  idoc.clear;
  idoc.write(PSafeArray(TVarData(v).VArray));
end;

procedure daj_all_link_2(var aLinkList,aTextList:TStrings);
var
  v : OleVariant;
  j : Integer;
  d : IDispatch;
  e : IHTMLElement;
  l : IHTMLAnchorElement;
  c : IHTMLElementCollection;
  z : string;
  s : string;
begin
  aLinkList.Clear;
  aTextList.Clear;
  v := 'A';
  d := iDoc.all.tags(v);
  if assigned(d) then
  begin
    d.QueryInterface(IHTMLElementCollection, c);
    if assigned(c) then
    begin
      for j:=1 to c.Get_length do
      begin
        d := c.item(pred(j),0);
        d.QueryInterface(IHTMLElement, e);
        d.QueryInterface(IHTMLAnchorElement, l);
        if assigned(e) and assigned(l) then
        begin
          z := l.href;
          if aLinkList.IndexOf(z)=-1 then
          begin
            aLinkList.Add(z);
            aTextList.Add(e.innerText);
          end
        end
      end
    end
  end
end;

procedure daj_all_link(var aBuff:AnsiString;aLinkList,aTextList:TStrings);
begin
  set_buff(aBuff);
  daj_all_link_2(aLinkList,aTextList);
end;

end.

Вызываю я его примерно так

Код


procedure TForm1.Button2Click(Sender: TObject);
var sss:AnsiString;
  s1,s2:TStringList;
begin
  sss := '<p>Дизайн&nbsp;—&nbsp;<a href="http://www.artlebedev.ru/" class="copy">Студия Артемия Лебедева</a></p>';
  s1  := TStringList.Create;
  s2  := TStringList.Create;
  uParseHTML.Init_parser;
  uParseHTML.daj_all_link(sss, s1,s2);
  uParseHTML.Close_parser
end;

Будет ли учетка памяти?

Rennigth

Дата 6.5.2006, 13:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: нет
Всего: 76

Цитата(Matematik @ 6.5.2006, 10:36

)

Будет ли учетка памяти?

Нет, этож интерфейс.

--------------------

(* Honesta mors turpi vita potior *)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »