ajuda pega fonte htm

[philberX]

bom dia novamente,

em minha aplicação, eu preciso pegar o fonte do embedded constantemente, porem o mesmo ao trocar de página, talvez por receber about:blank, acaba que da um erro que eu não estou conceguindo desvendá-lo

é o seguinte codigo

uses

mshtml;

begin

emb.Navigate('http://google.com);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

iall : IHTMLElement;

begin

if Assigned(emb.Document) then

begin

iall := (emb.Document AS IHTMLDocument2).body;

while iall.parentElement <> nil do

begin

iall := iall.parentElement;

end;

memo1.Text := iall.outerHTML;

end;

end; :ninja: :ninja:

porem ao clickar em pesquisar google como exemplo, me dá o seguinte erro

project raised exception class Eaccess violation with message 'access violation at adress 0047e02A in module' Project1.exe'. Read of adress 00000000'. Process stoped. Use step or run to continue

[Jhonas]

porem ao clickar em pesquisar google como exemplo, me dá o seguinte erro

coloque o código completo para podermos analisar

abraço

[philberX]

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, mshtml, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB,

ExtCtrls, SHDocVw;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Edit1: TEdit;

Button2: TButton;

Edit2: TEdit;

Edit3: TEdit;

Timer1: TTimer;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Timer2: TTimer;

emb: TWebBrowser;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure embNavigateComplete2(ASender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

procedure Edit1Change(Sender: TObject);

procedure Edit2Change(Sender: TObject);

procedure Edit3Change(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure embDocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

procedure embBeforeNavigate2(Sender: TObject; const pDisp: IDispatch;

var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;

var Cancel: WordBool);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

init: integer;

fin: integer;

fra: string;

ini: integer;

fi: integer;

frase: string;

inicio: integer;

fim: integer;

fr: string;

begin

inicio := Pos( '5 value=', memo1.Text);

fim:= Pos('name=user', memo1.Text);

if (fim > inicio) then

Frase := Copy( Memo1.text, Inicio, Fim-Inicio);

edit1.text:=frase;

ini := Pos( '6 value=', memo1.Text);

fi:= Pos('name=senha', memo1.Text);

if (fim > inicio) then

Fr := Copy( Memo1.text, Ini, Fi-Ini);

edit2.text:=fr;

init := Pos( '1 value=', memo1.Text);

fin:= Pos('name=dac', memo1.Text);

if (fin > init) then

Fra := Copy( Memo1.text, Init, Fin-Init);

edit3.text:=fra;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

emb.navigate('www.gmail.com')

end;

procedure TForm1.Button2Click(Sender: TObject);

var

iall : IHTMLElement;

begin

button1.Click;

if Assigned(emb.Document) then

begin

iall := (emb.Document AS IHTMLDocument2).body;

while iall.parentElement <> nil do

begin

iall := iall.parentElement;

end;

memo1.Text := iall.outerHTML;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

button2.Click;

timer2.Enabled:=true;

end;

procedure TForm1.embNavigateComplete2(ASender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

begin

timer1.enabled:=true;

end;

procedure TForm1.Edit1Change(Sender: TObject);

begin

if pos('5 value=',Edit1.Text)<>0 then

edit4.Text:=Edit1.Text ;

end;

procedure TForm1.Edit2Change(Sender: TObject);

begin

if pos('6 value=',Edit2.Text)<>0 then

edit5.Text:=Edit2.Text ;

end;

procedure TForm1.Edit3Change(Sender: TObject);

begin

if pos('1 value=',Edit3.Text)<>0 then

begin

edit6.Text:=Edit3.Text ;

end;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

if pos ('email google',memo1.Text)<>0 then

begin

timer1.Enabled:=false;

timer2.Enabled:=false;

//form1.Width:=1027;

//form1.Height:=598;

end

else

begin

//form1.Width:=456;

//form1.Height:=84;

end;

end;

procedure TForm1.embDocumentComplete(Sender: TObject;

const pDisp: IDispatch; var URL: OleVariant);

begin

timer1.Enabled:=true;

end;

obs: a intenção é deixar o timer sempre ligado mas na hora trava, o degub aponta para a seguinte parte:

procedure TForm1.Button2Click(Sender: TObject);

var

iall : IHTMLElement;

begin

button1.Click;

if Assigned(emb.Document) then

begin

iall := (emb.Document AS IHTMLDocument2).body;

while iall.parentElement <> nil do

begin

iall := iall.parentElement;

end;

memo1.Text := iall.outerHTML;

end;

end;

o button é controlado pelo timer que clika nele a cada 1 segundo

[Jhonas]

obs: a intenção é deixar o timer sempre ligado mas na hora trava, o degub aponta para a seguinte parte:

procedure TForm1.Button2Click(Sender: TObject);
var
iall : IHTMLElement;
begin
button1.Click;
if Assigned(emb.Document) then
begin
iall := (emb.Document AS IHTMLDocument2).body;

while iall.parentElement <> nil do
begin
iall := iall.parentElement;
 end;
memo1.Text := iall.outerHTML;
end;
end;

o button é controlado pelo timer que clika nele a cada 1 segundo voce está acionando pelo timer o button1 e o button2, entretanto o tempo necessario para a execução das rotinas está sendo maior que aquela que o timer dispõe experimente desabilitar o timer1 assim que ele começar

procedure TForm1.Timer1Timer(Sender: TObject);
begin

   timer1.Enabled:=false;
   button2.Click;
   timer2.Enabled:=true;

end;

abraço