TWebbrowser - Quellcode auslesen

[ferby]

Hallo,

ja ich weiß gibt schon eine Menge Threads dazu, aber ich bekomm es einfach nicht 100% hin.


Also was ich will:
1x Edit Feld, bei dem man die URL eingibt
1x Memo, hier wird der Quellcode angezeigt
1x Button, aktualisieren des Quellcodes.

Mein Programm:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Classes, Forms, ActiveX, ComObj, SysUtils, SHDocVw_tlb, Controls,
  StdCtrls, Dialogs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;
  Test: TWebBrowser;

implementation

{$R *.dfm}

function WB_GetHTMLCode(WebBrowser: TWebBrowser): string;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
  bool: boolean;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  s := '';
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    bool := Succeeded(ps.Save(sa, True));
    if bool then Result:=Result +#10+ ss.Datastring;
  finally
    ss.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  test.Navigate(edit1.text);
  memo1.Lines.Text:=wb_gethtmlcode(test);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Test:=TWebBrowser.Create(self);
end;

end.

Also meine Probleme:
1)
Beim ersten mal auf den Button drücken kommt ein Laufzeitfehler, keine Ahnung warum :-(
Beim zweiten mal drücken Funktioniert es

2)
Es wird nicht immer der vollständige Quellcode ausgelesen, sondern mittendrin hört es auf.
An was kann das liegen? Ich habe es auch schon mit widestring ausprobiert

3)
Wenn ich eine neue Adresse im Edit Feld eingebe muss ich immer 2x am Button drücken, bis
der Quellcode aktualisiert wird, warum??


Ich habe mal das ganze Projekt + exe im Anhang gegeben, damit ihr mein Problem vlt besser nachvollziehen könnt..

[quendolineDD]

Vielleicht solltest du nach dem wechseln auf eine Seite darauf warten, das der Browser fertig navigiert ist und die Seite vollständig geladen hat.

[ferby]

Hallo,

ich habe mit Twebbrowser noch nie gearbeitet sondern immer nur mit INDY.

Wie warte ich bis er fertig ist? Bzw, wie frag ich ab ob die Seite komplett geladen ist?

[quendolineDD]

Zitat:

Zitat von OH

Das Ereignis OnDocumentComplete wird ausgelöst, wenn das zu ladende Dokument den Status ReadyState_Complete erreicht.

Delphi-Syntax:

property OnDocumentComplete: TWebBrowserDocumentComplete;

Beschreibung

In der Ereignisbehandlungsroutine für OnDocumentComplete können Sie Aktionen durchführen, wenn ein Frame oder Dokument vollständig in die TWebBrowser-Komponente geladen ist. Bei einem Dokument ohne Frames wird dieses Ereignis nur einmal ausgelöst, nachdem das Dokument vollständig geladen wurde. Bei einem Dokument mit mehreren Frames wird das Ereignis einmal pro Frame und dann noch einmal nach dem Laden des gesamten Dokuments ausgelöst.

oder du machst die unelegantere Variante:

Delphi-Quellcode:

repeat
Application.ProcessMessages;
until WebBrowser1.ReadyState >= READYSTATE_COMPLETE;

[ferby]

Hallo,

hmm, bei mir wird test.ReadyState nie READYSTATE_COMPLETE (=4) sondern ist gleich nach dem aufruf READYSTATE_LOADING (=1) (is klar) und dann bleibt es aber bei READYSTATE_INTERACTIVE (=3)....

an was kann das liegen?





Allerdings habe ich mit

Delphi-Quellcode:

  repeat
    Application.ProcessMessages;
  until test.ReadyState = 3;

Meine Problemme 1 und 3 wegbekommen.

Jetzt hab ich nur noch das Problem, das zu lange Quellcodes einfach abgeschnitten werden

[ferby]

Keiner eine Ahnung warum der Quellcode abgeschnitten wird?

Also ich verwende jetzt diese Funktion

Delphi-Quellcode:

function WB_GetHTMLCode(WebBrowser: TWebBrowser): widestring;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
  bool: boolean;
begin
  // Warten bis Quellcode fertig heruntergeladen ist
  repeat
    Application.ProcessMessages;
  until WebBrowser.ReadyState >= 3;

  ps := WebBrowser.Document as IPersistStreamInit;
  s := '';
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    bool := Succeeded(ps.Save(sa, True));
    if bool then Result:=ss.Datastring;
  finally
    ss.Free;
  end;
end;

Und sie Funktioniert eigentlich, allerdings wenn ich eine Website eingebe, mit einen langen HTML Quellcode dann werden trotzdem nur ca.
4000 zeichen zurückgegeben, warum?

[ferby]

Hello,

ich bin jetzt echt am verzweifeln, jetzt auch schon wieder eine Stunde lang am Quellcode herumprobiert :-(


Ich habe noch immer das gleiche Problem: Es wird nicht der komplette Quellcode angezeigt, sondern mittendrin wird er abgeschnitten,
und bis jetzt habe ich keine Ahnung an was das liegt :-(

Ich habe mal mein ganzes Projekt mit Exe raufgeladen, vlt findet wer den Fehler.
Es ist eigentlich eh ein recht kurzer Quellcode, nur leider muss ich da irgendetwas übersehen...

[quendolineDD]

WideString hat ca. ~2^30 maximale Anzahl an Zeichen. Daher dürfte es wohl nicht kommen :)
Edit:
Aber vielleicht kann das Memo nicht mehr zeichen darstellen? Das könnte ich mir schon eher vorstellen ...

[ferby]

Hallo,

habe ich beides schon ausprobiert,
geht werder mit widestring, noch ist das memo voll, da ich nacher im memo noch was reinschreiben kann.

[Apollonius]

Lass dir mal die Größe des String-Streams anzeigen.

[ferby]

Hallo,

thx jetzt hab ich mal die Ursache des Problems, der String-Stream wird nie größer als 4096 und deshlab wird immer abgeschnitten....

Aber wie löße ich das Problem jetzt?

[ferby]

Hello,

hmm, ich glaub es liegt nichtmal an dem StringStream, da ich den länger als 4096 Zeichen machen kann.

Wo kann den hier eine Begrenzung sein?

Delphi-Quellcode:

function WB_GetHTMLCode(WebBrowser: TWebBrowser): string;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
begin
  // Warten bis Quellcode fertig heruntergeladen ist
  repeat
    Application.ProcessMessages;
  until WebBrowser.ReadyState >= 3;

  ps := WebBrowser.Document as IPersistStreamInit;
  ss := TStringStream.Create('');

  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    Succeeded(ps.Save(sa, True));
    Result:=ss.Datastring;
  finally
    ss.Free;
  end;
end;

Bzw, wie erweitere ich diese Grenze sodas ich mehr als 4096 Zeichen Speichern kann?

[marabu]

Hallo Ferdinand,

zwar hat dein Thread schon einen Bart, aber wenn du noch grübeln solltest:

Der Zugriffsfehler beim ersten Klicken entsteht durch deinen zu frühen Zugriff auf das Document, welches noch nicht existiert (Document = nil). Später dann greifst du beim ersten Klicken immer auf das zuvor geladene Teildokument (wird ja nie vollständig geladen) zu.

Du fügst deinen WebBrowser zur Laufzeit hinzu, klinkst ihn aber nicht in die Nachrichtenkette ein (Parent = nil) - so kommt es früher oder später zu Problemen. Wie du bemerkst, kannst du nur auf das erste Markup-Paket zugreifen, das dein Browser empfängt. Füge den Browser zur Entwurfszeit ein oder mache sein Control zu einem message-only window.

Und nicht zuletzt: Wenn du auf das Dokument eines WebBrowsers beim Ereignis OnDocumentComplete() zugreifst, dann tust du es garantiert zum richtigen Zeitpunkt.

Delphi-Quellcode:

type
  TDemoForm = class(TForm)
    Button: TButton;
    Edit: TEdit;
    procedure ButtonClick(Sender: TObject);
    procedure DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
  private
    wb: TWebBrowser;
  end;

// ...

function WB_GetHTMLCode(WebBrowser: TWebBrowser): string;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
  bool: boolean;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  s := '';
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    bool := Succeeded(ps.Save(sa, True));
    if bool then Result:=Result +#10+ ss.Datastring;
  finally
    ss.Free;
  end;
end;

procedure TDemoForm.ButtonClick(Sender: TObject);
begin
  WB.Navigate(Edit.text);
end;

procedure TDemoForm.DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  with Sender as TWebBrowser do
    if pDisp = DefaultInterface then
      ShowMessage(wb_gethtmlcode(WB));
end;

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  wb := TWebBrowser.Create(self);
  wb.ParentWindow := HWND(HWND_MESSAGE);
  wb.OnDocumentComplete := DocumentComplete;
end;

Die von Lars verwendete Bedingung (State >= 4) ist in Ordnung, deine (State >= 3) in Verbindung mit dem behinderten Nachrichtenfluss ist Schuld am verkürzten Markup.

Freundliche Grüße

[ferby]

hallo,

danke für die antwort, werd den code mal ausprobieren.

ich habe das ganze mittlerweile so gelößt:

URLDownloadToFile(nil,PChar(Website),PChar(TempDat ei),0,nil);

und lade dann einfach den Quellcode aus der Datei

[peter314]

Hallo allerseits,
wollt kein neuen Thread aufmachen, weil das Thema hier eigentlich schon zur genüge breitgetreten ist, aber irgendwie will das bei mir nicht.
Ich hab jetzt schon mit jeder Funktion die ich hier gefunden habe versucht den Quelltext der aktuellen Seite meines TWebBrowsers auszulesen, aber beim ausführen erhalte ich immer ein Access Violation.

Code:

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw_TLB, ActiveX, ComObj;
{...}
procedure TForm1.Button1Click(Sender: TObject);
var
htmlcode: string;
begin
 WebBrowser1.Navigate('http://wortsuche.com/by-length/4a/');
 htmlcode:= WebBrowser1.OleObject.Document.documentElement.innertext;
 Showmessage(Copy(htmlcode,1,20));
end;

Ich weiß einfach nicht mehr weiter. Über Lösungsvorsschläge würd ich mich sehr freuen.

Dank im Vorraus,
Peter314

[peter314]

Okay hab das Problem gefunden!
Der Webbrowser hat noch nicht fertig geladen, wenn das Programm bereits den Quelltext auslesen will. Das geht natürlich nicht.

greets Peter

Die Frage hat sich damit natürlich gelöst, nur wie schließt man jetzt die "offene Frage"?

[Sir Rufo]

Ja, so steht es doch auch hier im Thread