[es] - Igranje s TWebBrowserom

anon68680

Član broj: 68680
Poruke: 528
*.dynamic.sbb.co.yu.

+14 Profil

^{03.11.2007. u 13:19 - pre 200 meseci}

Koristim TWebBrowser kako bih popunio neku formu i submitovao je. Problem se javlja sto kad uradim submit izbaci neki warning tipa: document.forms.0.email is null or not an object. I pita da li da nastavi sa scriptom ili da je ugasi. Zasto se ovo desava, i moze li se nekako iskljuciti? Evo koda:

Code:
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...