Developing.ru

Код: Выделить всё

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, OleCtrls, SHDocVw;
type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
    index:integer;
    procedure CheckContent(const pDisp: IDispatch);
  public
    { Public declarations }
    procedure NextPage;
  end;
var
  Form1: TForm1;
implementation
uses
  mshtml, ActiveX;
var
  ls:TStringList;
{$R *.DFM}
function GetHTML(iDoc:IHtmlDocument2):string;
var
  str:TStringStream;
begin
  str:=TStringStream.Create('');
  try
    (iDoc as IPersistStreamInit).Save(TStreamAdapter.Create(str),True);
    Result:=str.DataString;
  finally
    str.Free;
  end;
end;
procedure TForm1.CheckContent(const pDisp: IDispatch);
var
  iDoc:IHtmlDocument2;
  html:string;
begin
  If not assigned(pDisp) then Exit;
  If not assigned((pDisp as IWebBrowser).Document) then Exit;
  (pDisp as IWebBrowser).Document.QueryInterface(IHtmlDocument2,iDoc);
  If not assigned(iDoc) then Exit;
  html:=GetHTML(iDoc);
end;
procedure TForm1.NextPage;
begin
  if index<ls.Count then WebBrowser1.Navigate(ls.Strings[index]);
  Inc(index);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  index:=0;
  NextPage;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  ls:=TStringList.Create;
  //Список url
  ls.Add('www.ya.ru');
  ls.Add('www.r0.ru');
  ls.Add('www.google.ru');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  ls.Free;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
  CheckContent(pDisp);
  NextPage;
end;
end.