TWebBrowser: Quelltext auslesen

F.Art · Beiträge: 434

folgende funktion nutze ich um den Quelltext auszulesen

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:

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

procedure TForm1.StartClick(Sender: TObject);
begin
WB_GetHTMLCode(WebBrowser, Quelltext.Lines);
end;

aber wenn ich nun eine frame seite geladen habe läd er nur den quelltext von den frames. aber ich möchte den text aus dem Haupt haben.
wie mache ich das?

CABALxx · Beiträge: 174 D7 Ent

willst du das "frame - gerüst" also sowas

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

<html>

  <head>
    <title>deppenvomdienst.tk</title>
    <meta name="description" content="Deppen vom Dienst">
    <meta name="keywords" content="FUN">

<script language = "JavaScript">
  <!-- hide start
  function popup() {
    window.open("http://banners.dot.tk/bmcbanner?fldpromonr=1&fldbannernr=0&flddomainnr=2922467&ip=217.236.143.161","bannerpopup","height=100,width=486,scrollbars=no");
  }
  // hide end -->
</script>

  </head>

  <frameset onLoad="JavaScript:popup()" rows="*,1" framespacing="0" border="0" frameborder="NO">
    <frame src="http://home.graffiti.net/deppenvomdienst:graffiti.net/index2.htm" name="dot_tk_frame_content" scrolling="auto" noresize>
  </frameset>

  <noframes>
    <body>
    </body>
  </noframes>

</html>

oder den eigentlich quelltext der Frameseiten also sowas

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

<html>
<head>
<title>Screenshots Section</title>
</head>
<body bgcolor=#0000E0 link=#00E000 vlink=#00E000 alink=00E000>

<font face="Arial">
<font size=14>
<div align="center" style="font-size:50pt; color:#E00000">
Fun Bilder<br><br>
Leider noch im Aufbau

</font>
</body>
</html>

weil ich hätte für beides ne lösung

für das reine frame gerüst

markieren

Delphi-Quelltext

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := IdHTTP1.Get('http://www.deppenvomdienst.tk');
end;

und für die eigentlichen frameseiten

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:

uses  
  ActiveX;  

 
function TForm1.GetFrame(FrameNo: Integer): IWebbrowser2;  
var  
  OleContainer: IOleContainer;  
  enum: IEnumUnknown;  
  unk: IUnknown;  
  Fetched: PLongint;  
begin  
  while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do  
    Application.ProcessMessages;  
  if Assigned(Webbrowser1.document) then  
  begin  
    Fetched := nil;  
    OleContainer := Webbrowser1.Document as IOleContainer;  
    OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum);  
    Enum.Skip(FrameNo);  
    Enum.Next(1, Unk, Fetched);  
    Result := Unk as IWebbrowser2;  
  end   
  else   
    Result := nil;  
end;  

 
// Testseite laden  
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  Webbrowser1.Navigate('http://www.warebizprogramming.com/tutorials/html/framesEx1.htm');  
end;  

 
// Alle Frameseiten in einzelne Dateien speichern  
procedure TForm1.Button2Click(Sender: TObject);  
var  
  IpStream: IPersistStreamInit;  
  AStream: TMemoryStream;  
  iw: IWebbrowser2;  
  i: Integer;  
  sl: TStringList;  
begin  
  for i := 0 to Webbrowser1.OleObject.Document.frames.Length - 1 do  
  begin  
    iw := GetFrame(i);  
    AStream := TMemoryStream.Create;  
    try  
      IpStream := iw.document as IPersistStreamInit;  
      if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) then   
      begin  
        AStream.Seek(0, 0);  
        sl := TStringList.Create;  
        sl.LoadFromStream(AStream);  
        sl.SaveToFile('c:\frame' + IntToStr(i) + '.txt');  
        //  memo1.Lines.LoadFromStream(AStream);  
        sl.Free;  
      end;  
    except  
    end;  
    AStream.Free;  
  end;  
end;  

 
end.

Zu diesem code für die eigentlichen frameseiten nochmals VIELEN DANK AN [b]toms
Advanced-Member

nachzulesen
www.delphi-forum.de/...22293&highlight=

F.Art · Beiträge: 434

Für die Frame Spalte zB Menü oder Hauptteil.
Ich brauche aber das für die TWebBrowser.

CABALxx · Beiträge: 174 D7 Ent

Also der Längere code liest diese "einzelnen Frame seiten " nach ihrem Quelltext aus und das auch mit dem TWebBrowser....

F.Art · Beiträge: 434

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

function GetFrame(FrameNo: Integer): IWebbrowser2;
var
  OleContainer: IOleContainer;
  enum: IEnumUnknown;
  unk: IUnknown;
  Fetched: PLongint;
begin
  while WebBrowser.ReadyState <> READYSTATE_COMPLETE do
    Application.ProcessMessages;
  if Assigned(Webbrowser1.document) then
  begin
    Fetched := nil;
    OleContainer := Webbrowser.Document as IOleContainer;
    OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum);
    Enum.Skip(FrameNo);
    Enum.Next(1, Unk, Fetched);
    Result := Unk as IWebbrowser2;
  end
  else
    Result := nil;
end;

Hier gibt er mir noch ein Fehler aus.
[Fehler] main.pas(75): Objekt oder Klassentyp erforderlich
in dieser Zeile
while WebBrowser.ReadyState <> READYSTATE_COMPLETE do

CABALxx · Beiträge: 174 D7 Ent

hast du das activeX in die uses clausel gesetzt? weil bei mir funktioniert der Code einwandtfrei...

F.Art · Beiträge: 434

Ja AktiveX ist drinne

CABALxx · Beiträge: 174 D7 Ent

Also

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, OleCtrls, SHDocVw, ActiveX;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    Button1: TButton;
    WebBrowser1: TWebBrowser;
    Label1: TLabel;
    Timer2: TTimer;
    Timer3: TTimer;
    Button2: TButton;
    Label2: TLabel;
    Timer4: TTimer;
    Button3: TButton;
    Timer5: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer4Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer5Timer(Sender: TObject);
  private
  function GetFrame(FrameNo: Integer): IWebbrowser2;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Zeit: Integer;
implementation

{$R *.dfm}

// Proceduren von timer 1,2 ,4 sind wichtig und die buttons
// timer 3 ist nicht mehr involviert


function TForm1.GetFrame(FrameNo: Integer): IWebbrowser2;
var
  OleContainer: IOleContainer;
  enum: IEnumUnknown; 
  unk: IUnknown;
  Fetched: PLongint;
begin 
  while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do
    Application.ProcessMessages;
  if Assigned(Webbrowser1.document) then 
  begin 
    Fetched := nil; 
    OleContainer := Webbrowser1.Document as IOleContainer;
    OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum);
    Enum.Skip(FrameNo);
    Enum.Next(1, Unk, Fetched);
    Result := Unk as IWebbrowser2;
  end  
  else 
    Result := nil; 
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
  s : TStringList;
  IpStream: IPersistStreamInit;
  AStream: TMemoryStream;
  iw: IWebbrowser2;
  i: Integer;
  sl: TStringList;
begin
  for i := 0 to Webbrowser1.OleObject.Document.frames.Length - 1 do
  begin
    iw := GetFrame(i);
    AStream := TMemoryStream.Create;
    try
      IpStream := iw.document as IPersistStreamInit;
      if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) then
      begin
        AStream.Seek(0, 0);
        sl := TStringList.Create;
        sl.LoadFromStream(AStream);
        sl.SaveToFile('c:\frame' + IntToStr(i) + '.txt');
       // memo1.Lines.LoadFromStream(AStream);
        sl.Free;
      end; 
    except
    end;
    AStream.Free;
  end;
  begin
s:= TStringList.Create;
s.LoadFromFile('C:\frame1.txt');

Memo1.lines.AddStrings(s);
end;
end;

das ist der komplette Code von Toms den ich in einem von meinen Programmen eingebaut habe und der auch funktioniert !!!!

Es kann aber sein das ich irgendwelche Komponenten und teile oder was auch immer nachträglich installiert habe.... da weiss ich aber leider nicht mehr welche alle :oops:

F.Art · Beiträge: 434

Jetzt habe ich ein weiteres Problem.
Ich habe eine Page die diese Funktion nicht zu lässt.
Ich möchte nur im WebBrowser einen bestimmten Text suchen lassen und es soll dann eine Meldung kommen.
Wie könnte ich das lösen?

CABALxx · Beiträge: 174 D7 Ent

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

{....}  

 
  private  
    procedure SearchAndHighlightText(aText: string);  
      
{....}  

 
procedure TForm1.SearchAndHighlightText(aText: string);  
var  
  i: Integer;  
begin  
  for i := 0 to WebBrowser1.OleObject.Document.All.Length - 1 do  
  begin  
    if Pos(aText, WebBrowser1.OleObject.Document.All.Item(i).InnerText) <> 0 then  
    begin  
      WebBrowser1.OleObject.Document.All.Item(i).Style.Color := '#FFFF00';  
      WebBrowser1.OleObject.Document.All.Item(i).ScrollIntoView(True);  
    end;  
  end;  
end;  

 
procedure TForm1.Button1Click(Sender: TObject);  
begin  
  SearchAndHighlightText('some text...');  
end;

is nur ein beispiel

wenn du mit "pos" arbeitest und nach nem string suchen lässt und dieser string da ist gibt das dingen ne zahl grösser als 0 wieder

F.Art · Beiträge: 434

Den Code hatte ich auch schon getestet und ihn später auf dies gekürzt.

markieren

Delphi-Quelltext

1:
2:

if Pos(Edit1.Text, WebBrowser.OleObject.Document.All.Item.InnerText) <> 0 
   then ShowMessage('gefunden');

Leider scheint es als würde er nur das Framegestell durchsuchen aber nicht die Frameseite Haupt. Was gibt es für möglichkeiten den im richtigen Framefenster suchen zu lassen?

CABALxx · Beiträge: 174 D7 Ent

das problem kenne ich gut !!!

daran bin ich auch ewig gescheitert

der threat hier

www.delphi-forum.de/...22293&highlight=

da der beitrag von toms
das genau der code den du da brauchst

......

F.Art · Beiträge: 434

Den Code von Toms habe ich auch schon in die Finger bekommen.
Leider geht es damit auch nicht bei der Seite, auf anderen ging dies auch gut.
Es muss doch einen Weg geben der den aktuellen Text aus einem TWebBrowser checken kann?
Einfach dur den Text der dargestellt wird.
Der Code von Toms entwirft bei dieser Seite keine txt Dateien.

CABALxx · Beiträge: 174 D7 Ent

ich hatte nen ähnliches problem auch:

ich kann mir folgendes vorstellen:

es gibt ja diesen da

markieren

Delphi-Quelltext

1:	idHTTP.get....

das man den vielleicht ändert auf bestimmte frames? weil anzahl und frame nummer kann man ja feststellen mit

markieren

Delphi-Quelltext

1:	framelength

oder so und das man dem idHTTP noch parameter über das zu suchende frame mitgibt?

kannste ja mal probiern ich werds mir nachher mal ankucken wennsch zeit hab

F.Art · Beiträge: 434

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

procedure TForm1.Button1Click(Sender: TObject);
var  
  IpStream: IPersistStreamInit;  
  AStream: TMemoryStream;  
  iw: IWebbrowser2;  
  i: Integer;  
  sl: TStringList;  
begin  
  for i := 0 to Webbrowser.OleObject.Document.frames.Length - 1 do
  begin  
    iw := GetFrame(i);
    AStream := TMemoryStream.Create;
    try
      IpStream := iw.document as IPersistStreamInit;  
      if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) then   
      begin  
        AStream.Seek(0, 0);  
        sl := TStringList.Create;  
        sl.LoadFromStream(AStream);  
        sl.SaveToFile('frame' + IntToStr(i) + '.txt');
          memo1.Lines.LoadFromStream(AStream);
        sl.Free;
      end;  
    except  
    end;
    AStream.Free;
  end;  
end;

Jetzt speichert dieser Code die Frame auf die HD ab. Ich muss nur mein Webfilter an lassen sonst speichert er nicht. Warum weis ich auch nicht.

Aber nun noch ne kleinigkeit, ich möchte das nicht abspeichern sondern direkt in das Memo kopieren lassen.

Wie mache ich das noch?

CABALxx · Beiträge: 174 D7 Ent

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, activex, StdCtrls, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
  function GetFrame(FrameNo: Integer): IWebbrowser2;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function TForm1.GetFrame(FrameNo: Integer): IWebbrowser2;
var  
  OleContainer: IOleContainer;  
  enum: IEnumUnknown;  
  unk: IUnknown;
  Fetched: PLongint;  
begin  
  while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do  
    Application.ProcessMessages;
  if Assigned(Webbrowser1.document) then  
  begin  
    Fetched := nil;  
    OleContainer := Webbrowser1.Document as IOleContainer;
    OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum);  
    Enum.Skip(FrameNo);  
    Enum.Next(1, Unk, Fetched);  
    Result := Unk as IWebbrowser2;
  end   
  else   
    Result := nil;  
end;






procedure TForm1.Button1Click(Sender: TObject);
var
  IpStream: IPersistStreamInit;  
  AStream: TMemoryStream;  
  iw: IWebbrowser2;
  i: Integer;  
  sl: TStringList;  
begin

  begin  
    iw := GetFrame(i);
    AStream := TMemoryStream.Create;  
    try  
      IpStream := iw.document as IPersistStreamInit;
      if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) then
      begin
        AStream.Seek(0, 0);

        memo1.Lines.LoadFromStream(AStream);

      end;
    except
    end;
    AStream.Free;
  end;
end;


end.

ich habn nicht getestet aber der debugger gibt OK

i ist die nummer des frames...kannste ja dann deiner anwendung anpassen...

F.Art · Beiträge: 434

Danke funzt super, so

CABALxx · Beiträge: 174 D7 Ent

kein problem

hab das problem auch schon mal gehabt und zwar sehr lange is echt übel....

F.Art · Beiträge: 434

Kann mir Jemand noch erklären warum der Script von Toms nur geht wenn ich die Firewall an habe. Wenn ich die Firewall ausschalte und auf die Seite gehe wo ich die Frames laden will kommt ein Scriptfehler Meldung und die Seite läuft weiterhin nur die Frames werden nicht geladen. Und weis Jemand wie ich das auch gängig machen kann?

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme