unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
MSHTML,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.OleCtrls, SHDocVw;
type
TForm1 =
class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
CheckBox1: TCheckBox;
WebBrowser2: TWebBrowser;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
procedure WebFormSetFieldValue( document: IHTMLDocument2;
const formNumber: integer;
const fieldName, newValue:
string) ;
procedure SetMyProfile(
Name:
string; Checkbox: TCheckbox);
function WebFormGet(
const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement;
procedure CallFoo( );
procedure CallStartSearch( );
procedure ClickImage(wb : TWebBrowser; sImageName :
String);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
WWWdocument: IHTMLDocument2;
implementation
{$R *.dfm}
function TFORM1.WebFormGet(
const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement;
var
forms : IHTMLElementCollection;
begin
forms := document.Forms
as IHTMLElementCollection;
result := forms.Item(formNumber,'
')
as IHTMLFormElement ;
end;
procedure TForm1.WebFormSetFieldValue(document: IHTMLDocument2;
const formNumber: integer;
const fieldName, newValue:
string) ;
var
form : IHTMLFormElement;
field: IHTMLElement;
begin
form := WebFormGet(formNumber, WebBrowser2.Document
AS IHTMLDocument2) ;
field := form.Item(fieldName,'
')
as IHTMLElement;
if field =
nil then Exit;
if field.tagName = '
INPUT'
then
begin
(field
as IHTMLInputElement).value := newValue;
ShowMessage(DateTimeToStr(Now)+'
: -> CN ausgefüllt! ');
end;
//if field.tagName = 'SELECT' then (field as IHTMLSelectElement) := newValue;
//if field.tagName = 'TEXTAREA' then (field as IHTMLTextAreaElement) := newValue;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Here the event js handling routine is called. HOW???
//CallFoo( );
ClickImage(WebBrowser2, '
text_normal_metro.png');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
WWWdocument := WebBrowser2.Document
as IHTMLDocument2;
WebFormSetFieldValue(WWWdocument ,0,'
NamesearchpageTextbox', Edit2.text) ;
SetMyProfile('
RadTextTile_Namesearchpage_Defaultprofile_ClientState', Checkbox1);
end;
procedure TForm1.CallFoo( );
{ Calls JavaScript foo() function }
var
Doc: IHTMLDocument2;
// current HTML document
HTMLWindow: IHTMLWindow2;
// parent window of current HTML document
JSFn:
string;
// stores JavaScipt function call
begin
// Get reference to current document
Doc := WebBrowser2.Document
as IHTMLDocument2;
if not Assigned(Doc)
then
Exit;
// Get parent window of current document
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow)
then
Exit;
// Run JavaScript
try
//JSFn := Format('foo("%s",%d)', [S, I]); // build function call
// QUESTION 1
// WHAT FUNCTION NAME must I enter here ??????
JSFn := '
btn_StartpageTextSearch.close(true)';
// build function call
HTMLWindow.execScript(JSFn, '
JavaScript');
// execute function
except on Err:
Exception do
begin
ShowMessage('
Sorry: Exception: '+Err.Classname + '
:' + Err.
Message);
end;
end;
end;
procedure TForm1.CallStartSearch( );
{ Calls JavaScript foo() function }
var
Doc: IHTMLDocument2;
// current HTML document
HTMLWindow: IHTMLWindow2;
// parent window of current HTML document
JSFn:
string;
// stores JavaScipt function call
begin
// Get reference to current document
Doc := WebBrowser2.Document
as IHTMLDocument2;
if not Assigned(Doc)
then
Exit;
// Get parent window of current document
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow)
then
Exit;
// Run JavaScript
try
//JSFn := Format('foo("%s",%d)', [S, I]); // build function call
// QUESTION 2
// WHAT FUNCTION NAME must I enter here ??????
JSFn := '
btn_StartpageTextSearch.close(true)';
// build function call
HTMLWindow.execScript(JSFn, '
JavaScript');
// execute function
except on Err:
Exception do
begin
ShowMessage('
Sorry: Exception: '+Err.Classname + '
:' + Err.
Message);
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
//Webbrowser2.Navigate(Edit1.text);
CallStartSearch( );
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Webbrowser2.Navigate(Edit1.text);
end;
procedure TForm1.SetMyProfile(
Name:
string; Checkbox: TCheckbox);
begin
if Checkbox.checked
then
WebFormSetFieldValue(WWWdocument ,0,
Name, '
{"selected":true}')
else
WebFormSetFieldValue(WWWdocument ,0,
Name, '
{"selected":false}') ;
end;
procedure TForm1.ClickImage(wb : TWebBrowser; sImageName :
String);
var
iDoc: IHtmlDocument2;
i: integer;
ov: OleVariant;
iDisp: IDispatch;
iColl: IHTMLElementCollection;
InputImage: HTMLInputImage;
begin
wb.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
if not Assigned(iDoc)
then begin
Exit;
end;
ov := '
INPUT';
iDisp := iDoc.all.tags(ov);
if Assigned(IDisp)
then begin
IDisp.QueryInterface(IHTMLElementCollection, iColl);
if Assigned(iColl)
then begin
for i := 1
to iColl.Get_length
do begin
iDisp := iColl.item(pred(i), 0);
iDisp.QueryInterface(HTMLInputImage, InputImage);
if Assigned(InputImage)
then begin
if InputImage.
Name = sImageName
then begin
InputImage.Click;
// klick es
end;
end;
end;
end;
end;
end;
end.