[ anon68680 @ 03.11.2007. 13:19 ] @
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...
[ _deran_ @ 03.11.2007. 23:22 ] @
meni radi na mom primeru. daj tacno koji je to sajt da probamo...
[ anon68680 @ 04.11.2007. 11:38 ] @
Ne dobijas nikakve errore?
http://www.yuwie.com/login.asp
[ Vladica Savić @ 04.11.2007. 12:22 ] @
Ja imam slican problem, ovako radi, ali je problem kad ima veci broj formi u HTML dokumentu i polja koja treba popuniti.

Npr. ja umesto funkije koja je u gornjem primeru GetFormByNumber koristim GetFormByName (mislim tako mi je bolje da ne pogresim sta gde treba da unesem)
Code:
function GetFormByName(document: IHTMLDocument2;
    const formName: string): IHTMLFormElement;
var
  forms: IHTMLElementCollection;
begin
  forms := document.Forms as IHTMLElementCollection;
  result := forms.Item(formName,'') as IHTMLFormElement
end;


Tekst koji zelim mi lepo prikaze da je popunio u zeljeno polje
Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  document: IHTMLDocument2;
  theForm: IHTMLFormElement;
  index: integer;
begin
  document := WebBrowser1.Document as IHTMLDocument2;
  theForm := GetFormByName(WebBrowser1.Document as IHTMLDocument2,'myForm');
  theForm := GetFormByName(WebBrowser1.Document as IHTMLDocument2,'chatForm');
  SetFieldValue(theForm,'chatbarText','Proba za unos automatskog teksta...');
  theForm.submit;
end;


I kad da posalje taj tekst koji je uneo u polje nista se ne desi?!

Zasto?
[ _deran_ @ 04.11.2007. 12:33 ] @
stavis negde WebBrowser1.Navigate('http://www.yuwie.com/login.asp');


Code:

uses  ... MSHTML;

...

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  Doc: IHTMLDocument2;
  HTMLWindow: IHTMLWindow2;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  try
    HTMLWindow.execScript('document.forms[0].email.value="[email protected]";', 'JavaScript');
    HTMLWindow.execScript('document.forms[0].password.value="sifra";', 'JavaScript');
    HTMLWindow.execScript('document.forms[0].submit();', 'JavaScript');
  except
    showmessage('greska!');
  end;
end;




javascript pomaze :)

mozes i sa document.getElementById("id_od_polja") da mu pristupis ako je zadan id, ako nije onda document.naziv_za_formular.naziv_za_polje ili ako form nema naziv onda po broju kao u primeru.
samo moras dodati negde da ti prepozna da li je ucitana stranica za login ili neka druga da ne radi svaki put ovo
[ Vladica Savić @ 04.11.2007. 12:56 ] @
Ma ok je to, stavio sam ja WebBrowser1.Navigate('Neka adresa');
Kako ide ovaj deo u kodu sa document.getElementById("id_od_polja") :)
[ _deran_ @ 04.11.2007. 14:35 ] @
to je javascript

ako imas u html-u npr
Code:

<form name=frm action=sajt.php>
<input name=tekst value="default vrednost" id=tekst>
</form>


onda tom objektu na stranici mozes zadati value:
Code:

document.getElementById("tekst").value = "nova vrednost";

ili
Code:

document.frm.tekst.value = "nova vrednost";

ili ako je to prvi form na stranici i nema ime niti ID, kao sto je onamo slucaj:
Code:

document.forms[0].tekst.value = "nova vrednost";


document.all nije preporucljivo koristiti...
[ Vladica Savić @ 04.11.2007. 15:13 ] @
Code:
document.frm.tekst.value = "nova vrednost";

Ok, ali gde stavljam taj deo, na neki on click za button ili gde tacno?
jel ide nesto tipa theForm.submit;
Pitanje mozda izgleda glupo, ali pitam jer nisam radio ovako nesto do sad
[ anon68680 @ 04.11.2007. 15:28 ] @
Evo probao sam preko JavaScripta da popunim formu, ali opet ista greska, samo sto sada bilo da kliknem Yes ili No ono nece da radi vec podigne neki Exception... pogledajte:



i onda ja clicknem Yes i dobijem:



a koristio sam onaj cod koji je _deran_ prilozio:

Code:

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  Doc: IHTMLDocument2;
  HTMLWindow: IHTMLWindow2;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  try
    HTMLWindow.execScript('document.forms[0].email.value="[email protected]";', 'JavaScript');
    HTMLWindow.execScript('document.forms[0].password.value="sifra";', 'JavaScript');
    HTMLWindow.execScript('document.forms[0].submit();', 'JavaScript');
  except
    showmessage('greska!');
  end;
end;


Jos jedna cudna stvar je sto se ovo desava samo kad unesem tacan email i password, a kada su pogresni samo mi prikaze da taj email ne postoji u njihovoj bazi ili sta vec.
[ _deran_ @ 04.11.2007. 16:46 ] @
@VladaLe
napravis proceduru, recimo:

Code:

procedure TForm1.startuj_script(script: string);
var
  Doc: IHTMLDocument2;
  HTMLWindow: IHTMLWindow2;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  try
    HTMLWindow.execScript(script, 'JavaScript');
  except
  end;
end;


i onda mozes na onclick nekog button-a da stavis
Code:

startuj_script('document.frm.tekst.value = "nova vrednost";');

ali vodi racuna o tome da na toj stranici onda postoji taj objekat, tj da je stranica ucitana. ili jos bolje, u javascript-u napravi da ako postoji taj objekat neka mu promeni value:
Code:

startuj_script('if (document.frm.tekst) { document.frm.tekst.value = "nova vrednost"; }');


ako imas vise twebbrowser-a mozes kao parametar preneti u kojem da se izvrsava...

@krza
koji Exception?
da li ga izbaci delphi ili taj sajt?
probaj taj isti nalog da otvoris u IE
nemam otvoren nalog tamo pa ne mogu da probam...
[ Vladica Savić @ 04.11.2007. 17:10 ] @
Googlajuci naleteo sam na ove Clever Internet Suite komponente, jel se neko igrao i sa njima malo
[ anon68680 @ 04.11.2007. 17:17 ] @
postavio sam image-a samo su linkovi filtrirani...

Anyway, gresku prijavljuje samo kad se ulogujem preko TWebBrowsera, ako koristim IE da se ulogujem, nema nikakvih errora. Probao sam takodje i u IE preko javascripte da popunim polja i da submitujem umesto da clicknem, ali opet nema nikakvog errora, znaci mora da je nesto vezano za TWebBrowser komponentu jer mi se to desavalo i ranije koliko se secam....
[ anon68680 @ 04.11.2007. 17:22 ] @
Evo i screenshota ( koristio sam onaj tvoj proggie iz attachmenta)

[ Vladica Savić @ 04.11.2007. 17:25 ] @
Neni pokaze gresku pri logovanju posto nemam nalog tamo, sto bi i trebalo sa pogresnim podacima, a kad pokusam da podesim za drugi sajt neki za koje imam podatke isto dobijem tu gresku koja je gore na screenshotu...
[ _deran_ @ 04.11.2007. 18:02 ] @
treba "document.forms[0].email.value" a ne "document.forms.0.email.value" 0 nije naziv nego redni broj, ali bilo bi bolje gde moze da se koristi naziv ili ID ako je zadan. prepravljao si primer koji sam dao?
[ anon68680 @ 04.11.2007. 18:07 ] @
Probao sam da upgrade-ujem na IE i na trenutak sam pomislio da radi, ali jok. _deran_, nisam menjao kod, on sam iz nekog razloga ispisuje forms.0. umesto forms[0] kad prijavi tu gresku.
[ anon68680 @ 04.11.2007. 18:10 ] @
Hmm, cini se da nemam ovaj problem ako koristim TEmbeddedWB komponentu. Izgleda da je problem bio u TWebBrowser.

Hvala na pomoci.
[ anon68680 @ 04.11.2007. 18:21 ] @
Grrrr ovo stvarno ume da iznervira.
Evo sad sam prebacio taj kod u ovaj program koji radim, zamenio TWebBrowser sa TEmbeddedWB i u onDocumentComplete stavio:

procedure TForm1.Embeddedwb1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Doc: IHTMLDocument2;
HTMLWindow: IHTMLWindow2;
begin
if CurDispatch=pdisp then
begin
Doc := embeddedwb1.Document as IHTMLDocument2;
if not Assigned(Doc) then
Exit;
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow) then
Exit;
HTMLWindow.execScript('document.forms[0].email.value = "****";', 'JavaScript');
HTMLWindow.execScript('document.forms[0].password.value = "****";', 'JavaScript');
Embeddedwb1.OleObject.document.forms.item(0).elements.item(5).click;
// HTMLWindow.execScript('document.forms[0].submit();', 'JavaScript');
end;
end;

I kad dodje do onog dela da treba da clickne, odnosno da submituje formu podigne EOleException 80020101 !!!! Sta mu je vise?!
[ anon68680 @ 04.11.2007. 18:33 ] @
cetvrti post u nizu :)
Resio sam i ovaj problem :), stvar je bila u tome sto nisam odredio pri kom URLu da ispunjava ovu formu pa je zabrljavio kad se ulogovao i pokusao i u tom urlu da ispuni formu koja sad ne postoji. Kod izgleda ovako nekako:

definisao sam "login : integer" i form1.oncreate stavio login:=0;

zatim:

procedure TForm1.EmbeddedWB1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Doc: IHTMLDocument2;
HTMLWindow: IHTMLWindow2;
begin
Doc := embeddedwb1.Document as IHTMLDocument2;
if not Assigned(Doc) then
Exit;
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow) then
Exit;
try
if (URL='http://www.yuwie.com/login.asp') and (login=0) then
begin
HTMLWindow.execScript('document.forms[0].email.value="****";', 'JavaScript');
HTMLWindow.execScript('document.forms[0].password.value="****";', 'JavaScript');
HTMLWindow.execScript('document.forms[0].submit();', 'JavaScript');
login:=1;
end;
except
showmessage('greska!');
end;
end;

i to je to. Jos jednom, hvala svima :)

[Ovu poruku je menjao krza dana 04.11.2007. u 20:03 GMT+1]
[ Vladica Savić @ 04.11.2007. 18:51 ] @
Evo kako izgleda forma gde ja hocu da ubacim neki tekst.
Code:
<form name="chatForm" id="chatForm" onsubmit="return false;" action="">
<input value="212.200.88.252" name="name" id="name" onblur="checkName();" type="hidden">
<input maxlength="500" id="chatbarText" name="chatbarText" onblur="checkStatus('');" onfocus="checkStatus('active');" type="text">
<input onclick="sendComment();" id="submit" name="submit" value="šubmit" type="submit">
</form>

Dakle zelim da ubacim tekst u chatbarText a on je u formi chatForm i da to postujem.
Kada pokusam ovo izbaci mi gresku...
Code:

procedure TForm1.Button1Click(Sender: TObject);
var
  Doc: IHTMLDocument2;
  HTMLWindow: IHTMLWindow2;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  try
    HTMLWindow.execScript('document.getElementById("chatbarText").value="Testing bla bla...";', 'JavaScript');
    HTMLWindow.execScript('documentforms["chatForm"].sendComment();', 'JavaScript');
    except
    showmessage('greska!');
  end;
end;


U cemu je problem? (Tekst koji sam stavio onde gore "Testing bla bla bla...." postavi gde treba, ali nece da postuje to )
[ _deran_ @ 04.11.2007. 19:02 ] @
umesto
Code:

HTMLWindow.execScript('documentforms["chatForm"].sendComment();', 'JavaScript');

stavi
Code:

HTMLWindow.execScript('sendComment();', 'JavaScript');  //ako treba, ne znam sta radi ovo
HTMLWindow.execScript('document.chatForm.submit();', 'JavaScript');
[ anon68680 @ 04.11.2007. 19:06 ] @
ili probaj sa .click
[ Vladica Savić @ 04.11.2007. 19:20 ] @
Radi sa .click
Hvala puno
[ Vladica Savić @ 06.11.2007. 22:48 ] @
Da nastavimo ovu malu igru sa TWebBrowserom.
Zanima me, u cilju sto brzeg ucitavanja i mogucnosti sto brzeg postovanja podataka da li mozemo da iskljucimo nekako i ucitavanje nazovimo to "nepotrebnih" delova web strane strane npr. slika i sl.?
[ _deran_ @ 07.11.2007. 07:10 ] @
ako hoces samo da postujes podatke da bi server nesto odradio a ne interesuju te slike itd (i nije https) onda koristi idhttp post (vraca html stranice)
[ Vladica Savić @ 07.11.2007. 13:13 ] @
Kako? Moze li mali primer?
[ anon68680 @ 07.11.2007. 15:51 ] @
Pretpostavljam da sa TWebBrowserom to ne mozes, s obzirom da on koristi IE engine, ili kako se to vec 'strucno kaze'. Mada mozes da probas da recimo u IE iskljucis ucitavanje slika pa da vidis kakav je resultat.
[ _deran_ @ 07.11.2007. 19:18 ] @
Citat:
VladaLe: Kako? Moze li mali primer? :)


stavis tidhttp na form i onda:
Code:


var sl:tstrings;
     a:widestring;
...


sl:=tstringlist.create;
 try
   sl.add('param1=value1');
   sl.add('param2=value2');
   sl.add('paramN=valueN');
   a:=idhttp1.post('http://www.sajt.com', sl);
 finally
   sl.free;
 end;



i onda u varijabli 'a' imas HTML te stranice iz koje mozes da vadis da li je to uspesno sto si probao ili nije -ako ti sajt da uopste to obavestenje.
npr if pos('registracija uspesna',a)>0 then uspesno:=true else uspesno:=false; ili tako nesto
zavisi od sajta, negde moze da prodje i samo a:=idhttp1.post('http://www.sajt.com/index.php?param1=value1&param2=value2');
kucam sve napamet pa mozda nesto bas nije tako...

[Ovu poruku je menjao _deran_ dana 08.11.2007. u 16:20 GMT+1]
[ martinj @ 22.11.2007. 09:31 ] @
Jel zna neko kako odstampati stranu sa frejmovima iz TWebBrowser-a?
Imam jednostavnu prezentaciju koja se ucitava sa diska. Na levom frejmu je navigacija a na desnom sadrzaj koji treba stampati..
Kad pokrenem stampu (WBPrintWithDialog(WebBrowser1);) stampa se samo levi frejm...

Code:

procedure WBPrintWithDialog(WB: TWebBrowser) ;
var
   vIn, vOut: OleVariant;
begin
   WB.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, vIn, vOut) ;
end;
[ anon68680 @ 22.11.2007. 11:04 ] @
Da probas preko javascript?


Code:
 
 ... uses MSHTML;

var
  Doc: IHTMLDocument2;
  HTMLWindow: IHTMLWindow2;
 begin
  Doc := webbrowser1.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;

 HTMLWindow.execScript('print();', 'JavaScript');

[ anon68680 @ 22.11.2007. 11:14 ] @
A mozes i da napravis screenshot webbrowsera pa onda da ostampas sliku. Evo jednog coda sa neta:

Code:

uses ActiveX;

procedure WebBrowserScreenShot(const wb: TWebBrowser; const fileName: TFileName) ;
var
  viewObject : IViewObject;
  r : TRect;
  bitmap : TBitmap;
begin
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject) ;
    if Assigned(viewObject) then
    try
      bitmap := TBitmap.Create;
      try
        r := Rect(0, 0, wb.Width, wb.Height) ;

        bitmap.Height := wb.Height;
        bitmap.Width := wb.Width;

        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0) ;

        with TJPEGImage.Create do
        try
          Assign(bitmap) ;
          SaveToFile(fileName) ;
        finally
          Free;
        end;
      finally
        bitmap.Free;
      end;
    finally
      viewObject._Release;
    end;
  end;
end;


Malo ga treba editovati da ucita taj bmp u TImage pa onda da pozoves neku print funkciju tipa:

Code:

uses
  Printers;

procedure TForm1.Button1Click(Sender: TObject);
var
  ScaleX, ScaleY: Integer;
  RR: TRect;
begin
  with Printer do
  begin
    BeginDoc;
    try
      ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
      RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY);
      Canvas.StretchDraw(RR, Image1.Picture.Graphic);
    finally
      EndDoc; 
    end;
  end;
end;


Ima nekoliko coda koji se vrte po netu u vezi sa stampanjem webbrowsera, ali ne znam koliko je koji efikasan tako da ces morati sam da prelistas net.