htmlParser for delphi

(******************************************************)
(*                **                                *)
(*              HTML                               *)
(*                                                    *)
(*              DxHtmlParser Unit                     *)
(*                                                    *)
(*    email:[email protected]     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에서 ihtmlDocument 4.createDocumentFromUrl에서 새 ihtmlDocument2 인터페이스를 만듭니다.
설명하지 않겠습니다. 코드는 이 정도입니다.
부족한 점:doc2는 자동으로 사진을 다운로드합니다. 만약 친구가 수정한 후에 저에게 한 부 보내주세요. 감사합니다!!

htmlParser for delphi

좋은 웹페이지 즐겨찾기