Ir para conteúdo
Fórum Script Brasil
  • 0

ajuda pega fonte htm


philberX

Pergunta

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

Link para o comentário
Compartilhar em outros sites

3 respostass a esta questão

Posts Recomendados

  • 0

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

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...