unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, HTTPApp, StdCtrls,
ActiveX, ComCtrls;
type
TForm1 =
class(TForm)
WebDispatcher1: TWebDispatcher;
WebBrowser1: TWebBrowser;
Button2: TButton;
Richedit1: TRichEdit;
Label1: TLabel;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
var Fehler,res :
string;
var i : integer;
implementation
{$R *.dfm}
/////////////////////////////////////
// CODE AUSLESEN
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.FormCreate(Sender: TObject);
begin
richedit1.Text := '
';
end;
procedure TForm1.Button2Click(Sender: TObject);
var link :
string;
begin
link := edit1.text;
webbrowser1.Navigate(link);
WB_GetHTMLCode(Webbrowser1, richedit1.Lines);
if richedit1.Lines[70] = '
<center><h2>Ein Fehler ist aufgetreten:</h2>
<font color="red">'
then begin
label1.caption := '
DOWN!!!' ;
end
end;
end.