unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls, mshtml, ActiveX;
type
TForm1 = class(TForm)
Button1: TButton;
WebBrowser1: TWebBrowser;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
function GetFormByNumber(document: IHTMLDocument2;
formNumber: integer): IHTMLFormElement;
procedure SetFieldValue(theForm: IHTMLFormElement;
const fieldName: string; const newValue: string);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
CurDispatch: IDispatch;
implementation
{$R *.dfm}
function tform1.GetFormByNumber(document: IHTMLDocument2;
formNumber: integer): IHTMLFormElement;
var
forms: IHTMLElementCollection;
begin
forms := document.Forms as IHTMLElementCollection;
if formNumber < forms.Length then
result := forms.Item(formNumber,'') as IHTMLFormElement
else
result := nil;
end;
procedure tform1.SetFieldValue(theForm: IHTMLFormElement;
const fieldName: string; const newValue: string);
var
field: IHTMLElement;
inputField: IHTMLInputElement;
selectField: IHTMLSelectElement;
textField: IHTMLTextAreaElement;
begin
field := theForm.Item(fieldName,'') as IHTMLElement;
if Assigned(field) then
begin
if field.tagName = 'INPUT' then
begin
inputField := field as IHTMLInputElement;
inputField.value := newValue;
end
else if field.tagName = 'SELECT' then
begin
selectField := field as IHTMLSelectElement;
selectField.value := newValue;
end
else if field.tagName = 'TEXTAREA' then
begin
textField := field as IHTMLTextAreaElement;
textField.value := newValue;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
WebBrowser1.Navigate('www.nekisajt.com');
end;
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if CurDispatch = nil then
CurDispatch := pDisp;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if (pDisp = CurDispatch) then
begin
//desavanja pri zavrsetku ucitavanja sajta
CurDispatch:= nil;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
document: IHTMLDocument2;
theForm: IHTMLFormElement;
index: integer;
begin
document := WebBrowser1.Document as IHTMLDocument2;
theForm := GetFormByNumber(WebBrowser1.Document as IHTMLDocument2,0);
SetFieldValue(theForm,'email','[email protected]');
SetFieldValue(theForm,'password','password');
theForm.submit;
end;
end.
Cudna stvar se takodje desava kad pokusam da ovo popunjavanje forme i submitovanje stavim da se desava pri zavrsetku ucitavanja sajta. Dobijem neki AccessViolation 0000000, i nikako ne mogu da skapiram u cemu je problem...