Webbrowser - capturando retorno

Top  Previous  Next

unit site_browse;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, OleCtrls, SHDocVw, OverbyteIcsWndControl,

  OverbyteIcsHttpProt, StdCtrls;

 

type

  TForm5 = class(TForm)

    WebBrowser1: TWebBrowser;

    Button1: TButton;

    procedure FormCreate(Sender: TObject);

    procedure WebBrowser1DownloadBegin(Sender: TObject);

    procedure WebBrowser1DownloadComplete(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  public

    FCompleted: Boolean;

    function SalvarHTML(WB: TWebBrowser; out IP: string): Boolean;

  end;

 

var

  Form5: TForm5;

 

implementation

 

{$R *.dfm}

 

uses mLib, Activex;

 

procedure TForm5.Button1Click(Sender: TObject);

var

  X: string;

begin

  if SalvarHTML(Webbrowser1, X) then

    CAption := X;

end;

 

procedure TForm5.FormCreate(Sender: TObject);

begin

  WebBrowser1.Navigate('http://www.market.com.br/ipexterno.php');

end;

 

function TForm5.SalvarHTML(WB: TWebBrowser; out IP: string): Boolean;

var

  PersistStream: IPersistStreamInit;

  FileStream   : TFileStream;

  Stream       : IStream;

  SaveResult   : HRESULT;

  L            : TStringList;

  Arq          : string;

begin

  Result := False;

  Arq    := mFile.GetNomeArquivoTemp;

 

  while not(FCompleted) do

    Application.ProcessMessages;

 

  PersistStream := WB.Document as IPersistStreamInit;

  FileStream    := TFileStream.Create(Arq, fmCreate);

  try

    Stream     := TStreamAdapter.Create(FileStream, soReference) as IStream;

    SaveResult := PersistStream.Save(Stream, True);

    Result     := not FAILED(SaveResult);

  finally

    FileStream.Free;

 

    if Result and FileExists(Arq) then

    begin

      L := TStringList.Create;

      L.LoadFromFile(Arq);

      IP := Trim(L.Text);

      L.Free;

      DeleteFile(Arq);

    end;

  end;

  FCompleted := False;

end;

 

procedure TForm5.WebBrowser1DownloadBegin(Sender: TObject);

begin

  FCompleted := False;

end;

 

procedure TForm5.WebBrowser1DownloadComplete(Sender: TObject);

begin

  FCompleted := True;

  Caption    := 'done';

end;

 

end.