unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, MSHTML;
type
TForm1 =
class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
DocumentLoaded: boolean;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetHtmlText(WebBrowser: TWebBrowser; ElementName:
string = '
'; HTMLText : boolean = false):
string;
var
m_pHtmlDoc2 : IHTMLDocument2;
HTMLElement : IHTMLElement;
HTMLTxtRange : IHTMLTxtRange;
begin
result := '
';
try
if assigned(WebBrowser.Document)
then begin // check document
m_pHtmlDoc2 := WebBrowser.Document
as IHTMLDocument2;
// document get
if assigned(m_pHtmlDoc2)
then begin
if ElementName = '
'
then
HTMLElement := m_pHtmlDoc2.body
as IHTMLElement
// select body for all text
else
HTMLElement := m_pHtmlDoc2.all.item(ElementName,0)
as IHTMLElement;
if assigned(HTMLElement)
then begin // check
m_pHtmlDoc2.selection.empty;
// clear old selection
HTMLTxtRange := IHTMLTxtRange(m_pHtmlDoc2.selection.createRange);
if assigned(HTMLTxtRange)
then begin
HTMLTxtRange.moveToElementText(HTMLElement);
// move selection to Element
HTMLTxtRange.select;
// select
if HTMLText
then
result := HTMLTxtRange.htmlText
// get the TEXT
else
result := HTMLTxtRange.text;
// get the PLAIN TEXT
m_pHtmlDoc2.selection.empty;
// remove selection
end;
end;
end;
end;
except
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('
http://www.mufa.de');
repeat
Application.ProcessMessages;
until DocumentLoaded;
WebBrowser1.OleObject.document.forms.item(1).elements.item('
login_username').value:='
Username';
WebBrowser1.OleObject.document.forms.item(1).elements.item('
login_password').value:='
Password';
WebBrowser1.OleObject.document.forms.item(1).submit;
repeat
Application.ProcessMessages;
until DocumentLoaded;
WebBrowser1.Navigate('
http://www.mufa.de/free-sms.html');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('
http://www.mufa.de');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Memo1.Text:=GetHtmlText(WebBrowser1);
end;
end.