当前位置：首页 > news >正文

htmlParser for delphi

news 来源：原创 2024/5/8 7:14:49

(******************************************************)
(*                **工作室                             *)
(*              HTML解析单元库                          *)
(*                                                    *)
(*              DxHtmlParser Unit                     *)
(*                                                    *)
(*    email:316454904@qq.com     QQ:316454904         *)
(******************************************************)
unit MyHtmlParser;

interface
uses Windows,MSHTML,ActiveX,Forms,Variants, SysUtils, Classes;

type
  TMyHtmlParser = class
private
    Doc: IHTMLDocument2;
    FHTML, FURL: string;
procedure SetHTML(const Value: string);
procedure SetURL(s: string);
public
    Doc2:IHTMLDocument2;
    FParserOK:boolean;
    FTimeOut:integer;
constructor Create;
destructor Destroy;override;
property HTML: string read FHTML write SetHTML;
property URL: string read FURL write SetURL;
property TimeOut:integer read FTimeOut write FTimeOut default 20000;
property ParserOK:boolean read FParserOK default false;
end;
implementation

{ TDxHtmlParser }

procedure TMyHtmlParser.SetURL(s: string);
var
  doc4:ihtmldocument4;
  tick:integer;
begin
  FURL:=s ;
if FURL<>'' then
begin
    tick:=gettickcount;
    doc.QueryInterface(IID_ihtmldocument4,doc4);
if assigned(doc4) then
begin
      doc2:=doc4.createDocumentFromUrl(s,'null');
while (doc2.readyState<>'complete') and (gettickcount-tick<FTimeOut) do
begin
        application.ProcessMessages;
        sleep(10);
end;
if doc2.readyState='complete' then FParserOK:=true;
end;
end;
end;

constructor TMyHtmlParser.Create;
begin
  CoInitialize(nil);
  //创建IHTMLDocument2接口
  FTimeOut:=20000;
  CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER, IID_IHTMLDocument2, Doc);
  Assert(Doc<>nil,'构建HTMLDocument接口失败');
  Doc.Set_designMode('On'); //设置为设计模式，不执行脚本
while not (Doc.readyState = 'complete') do
begin
    sleep(1);
    Application.ProcessMessages;
end;                   
  HTML:='<html></html>';
end;

destructor TMyHtmlParser.Destroy;
begin
  CoUninitialize;
inherited;
end;

procedure TMyHtmlParser.SetHTML(const Value: string);
var
  V: OLEVariant;
  vDocument: OLEVariant;
  vMimeType: OLEVariant;
  vHtml: OLEVariant;
  tick:integer;
begin
if FHTML <> Value then
begin
    tick:=gettickcount;
    FHTML := Value;
    V := Doc;
    vDocument := V.script.Document;
    vMimeType := 'text/Html';
    vHtml := FHtml;
    vDocument.Open(vMimeType);
    vDocument.Clear;
    vDocument.Write(vHtml);
    vDocument.Close;
while (doc.readyState<>'complete') and (gettickcount-tick<FTimeOut) do
begin
      application.ProcessMessages;
      sleep(10);
end;
if doc.readyState='complete' then
begin
     FParserOK:=true;
     doc2:=doc;
end;
end;
end;

end.

受到得闲老师的htmlparser启发，完善了一下，去掉的自认为没必要的东西（有了IhtmlDocument2，神马都是浮云）,当然不是完全抄自得闲老师的解析器，本单元中的精华是SetHTML(const Value: string);和SetURL(s: string);这两个函数，其它的没什么意思。

SetHTML(const Value: string)是抄自TEmbeddedwb的IEParser。

SetURL(s: string);是根据MSDN上ihtmlDocument4.createDocumentFromUrl创建出新的ihtmlDocument2接口。

不解释了，代码就这点。

不足的地方：doc2会自动去下载图片，如有朋友修改后还请发我一份，谢谢！！

转载于:https://www.cnblogs.com/Delphi-Farmer/archive/2011/09/21/2184192.html