|
Antwort |
Registriert seit: 3. Jan 2013 199 Beiträge Delphi 10.4 Sydney |
#11
Sooo also. Das ist der gesammte Code (Habe gerade erst angefangen mit dieser Form)
Ich weiss das die beiden Timer nicht gerade sehr optimal sind aber so lädt der Webbrowser zuerst 100% fertig bevor was versucht wird auszufüllen. Obwohl ihr das sicher selber feststellt: Button1 läuft durch --> Timer1 --> Timer2 (Hier findet der Fehler statt)
Delphi-Quellcode:
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, ExtCtrls, ComCtrls, ImgList; type TForm1 = class(TForm) webbrowser1: TEmbeddedWB; Edit1: TEdit; Edit2: TEdit; Button1: TButton; Edit3: TEdit; Label1: TLabel; Timer1: TTimer; Timer2: TTimer; Edit7: TEdit; Label2: TLabel; TreeView1: TTreeView; ImageList1: TImageList; Button2: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} function VariantIsObject(const value:OleVariant):boolean; begin result := (VarType(value) = varDispatch); end; procedure Browser2TreeView(WebBrowser: tembeddedwb; root:TTreeNodes); var i,j, k :Integer; FormItem, Element, SubElement: OleVariant; child, child2, child3 : TTreeNode; s_type : string; begin Assert(Assigned(WebBrowser)); Assert(Assigned(root)); root.Clear; //count forms on document for I:=0 to WebBrowser.OleObject.Document.forms.Length -1 do begin FormItem := WebBrowser.OleObject.Document.forms.Item(I); if VariantIsObject(FormItem.Name) then child := root.AddChild(nil, 'Form'+IntToStr(i)+': '+FormItem.Name.Name) else child := root.AddChild(nil, 'Form'+IntToStr(i)+': '+FormItem.Name); child.ImageIndex := 3; For j:= 0 to FormItem.Length-1 do begin try Element := FormItem.Item(j); child2 := root.AddChild(child, Element.Name+' = '+Element.Value); s_type := Element.Type; if s_type = 'submit' then child2.ImageIndex := 1 else if s_type = 'text' then child2.ImageIndex := 0 else if s_type = 'file' then child2.ImageIndex := 2 else if s_type = 'hidden' then child2.ImageIndex := 4 else if s_type = 'checkbox' then child2.ImageIndex := 5 else if s_type = 'radio' then child2.ImageIndex := 6 else if s_type = 'select-one' then child2.ImageIndex := 7 else child2.ImageIndex := -1; child3 := root.AddChild(child2, 'Type='+s_type); child3.ImageIndex := -1; if s_type = 'text' then begin child3 := root.AddChild(child2, 'MaxLen='+IntToStr(Element.maxLength)); child3.ImageIndex := -1; end else if s_type = 'select-one' then begin for k := 0 to Element.Options.Length-1 do begin SubElement := Element.Options.Item(k); child3 := root.AddChild(child2, SubElement.Text+ ' = <'+SubElement.Value+'>'); child3.ImageIndex := -1; end; end; except on E:Exception do root.AddChild(child, E.Message); end; end; end; if root.Count > 0 then root.GetFirstNode.Expand(True); end; function FillForm(WebBrowser1: tembeddedwb; FieldName: string; Value: string): Boolean; var i, j: Integer; FormItem: Variant; begin Result := False; //no form on document if WebBrowser1.OleObject.Document.all.tags('FORM').Length = 0 then begin Exit; end; //count forms on document for I := 0 to WebBrowser1.OleObject.Document.forms.Length - 1 do begin FormItem := WebBrowser1.OleObject.Document.forms.Item(I); for j := 0 to FormItem.Length - 1 do begin try //when the fieldname is found, try to fill out if FormItem.Item(j).Name = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; except Exit; end; end; end; end; function FillForm2(webbrowser: TEmbeddedwb; const FieldName: string; Value: OleVariant): Boolean; var i, j: Integer; FormItem: Variant; begin Result := False; //no form on document if form1.WebBrowser1.OleObject.Document.all.tags('FORM').Length = 0 then begin Exit; end; //count forms on document for I := 0 to form1.WebBrowser1.OleObject.Document.forms.Length - 1 do begin FormItem := form1.WebBrowser1.OleObject.Document.forms.Item(I).elements; for j := 0 to FormItem.Length - 1 do begin try //when the fieldname is found, try to fill out if FormItem.Item(j).Name = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; except Exit; end; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin webbrowser1.Navigate('http://www.chesspoint.ch/admin/index.php?route=catalog/product&token=5184945becdf9423f277847b7489f08a&filter_model='+edit3.Text); repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; if FillForm(form1.WebBrowser1, 'username', edit1.text) = False then ShowMessage('Error. Field USERNAME not available or no Form found.'); if FillForm(form1.WebBrowser1, 'password', edit2.Text) = False then ShowMessage('Error. Field PASSWORD not available or no Form found.'); webbrowser1.oleobject.document.forms.item(0).submit; repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; timer1.enabled:=true; end; procedure TForm1.Button2Click(Sender: TObject); begin Browser2TreeView(WebBrowser1, TreeView1.Items); end; procedure TForm1.FormCreate(Sender: TObject); begin Set8087CW($133F); end; procedure TForm1.Timer1Timer(Sender: TObject); begin repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; webbrowser1.Navigate('http://www.chesspoint.ch/admin/index.php?route=catalog/product/update&token=5184945becdf9423f277847b7489f08a&product_id=312&filter_model='+edit3.Text); repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; if FillForm(form1.WebBrowser1, 'username', edit1.text) = False then ShowMessage('Error. Field USERNAME not available or no Form found.'); if FillForm(form1.WebBrowser1, 'password', edit2.Text) = False then ShowMessage('Error. Field PASSWORD not available or no Form found.'); webbrowser1.oleobject.document.forms.item(0).submit; timer2.enabled:=true; timer1.Enabled:=false; end; procedure TForm1.Timer2Timer(Sender: TObject); begin timer2.Enabled:=false; repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; // Deaktiviert da Fehler ausgelöst wird // if FillForm2(form1.WebBrowser1, 'quantity', edit7.text) = False then // ShowMessage('Error. Field QUANTITY not available or no Form found.'); // end; end.
Robert
|
Zitat |
Registriert seit: 4. Dez 2012 Ort: Augsburg, Bayern, Süddeutschland 419 Beiträge Delphi XE4 Ultimate |
#12
Hi gee21,
Zitat:
Button1 läuft durch --> Timer1 --> Timer2 (Hier findet der Fehler statt)
Dein Problem liegt da:
Delphi-Quellcode:
Du kannst nicht davon ausgehen, dass Code der für die TWebBrowser-Komponente geschrieben wurde mit dem TEmbeddeWB funktioniert. Leg doch mal eine TWebBrowser-Kombonente auf Dein Form bau die Parameterlisten wieder aufs Orginal (TWebBrowser) um und dann wirst Du sehen, die Sache läuft. Ansonsonsten musst Du den Code auf die TEmbeddedWB Komponente umschreiben.
type
TForm1 = class(TForm) webbrowser1: TEmbeddedWB; [...] end; procedure Browser2TreeView(WebBrowser: TWebBrowser; root:TTreeNodes); // Orginal von sx2008 procedure Browser2TreeView(WebBrowser: tembeddedwb; root:TTreeNodes); // Deine Variante Gruß
Volker Zeller
|
Zitat |
Registriert seit: 3. Jan 2013 199 Beiträge Delphi 10.4 Sydney |
#13
Ach so. Ja das stimmt natürlich.
Jetzt funktioniert auch die Funktion von SX (Als Bild im Anhang)
Robert
|
Zitat |
Registriert seit: 4. Dez 2012 Ort: Augsburg, Bayern, Süddeutschland 419 Beiträge Delphi XE4 Ultimate |
#14
Hi gee21,
und jetzt noch die Funktionen
Delphi-Quellcode:
so
function FillForm(WebBrowser1: tembeddedwb; FieldName: string; Value: string): Boolean;
function FillForm2(webbrowser: TEmbeddedwb; const FieldName: string; Value: OleVariant): Boolean;
Delphi-Quellcode:
Die Funktionen dann aufrufen (mit der TWebBrowser-Komponente) und es sollte funktionieren
function FillForm(WebBrowser1: TWebBrowser; FieldName: string; Value: string): Boolean;
function FillForm2(webbrowser: TWebBrowser; const FieldName: string; Value: OleVariant): Boolean; Gruß
Volker Zeller
|
Zitat |
Registriert seit: 3. Jan 2013 199 Beiträge Delphi 10.4 Sydney |
#15
Hi gee21,
und jetzt noch die Funktionen
Delphi-Quellcode:
so
function FillForm(WebBrowser1: tembeddedwb; FieldName: string; Value: string): Boolean;
function FillForm2(webbrowser: TEmbeddedwb; const FieldName: string; Value: OleVariant): Boolean;
Delphi-Quellcode:
Die Funktionen dann aufrufen (mit der TWebBrowser-Komponente) und es sollte funktionieren
function FillForm(WebBrowser1: TWebBrowser; FieldName: string; Value: string): Boolean;
function FillForm2(webbrowser: TWebBrowser; const FieldName: string; Value: OleVariant): Boolean; Gruß Das habe ich schon gemacht gehabt als ich das Bild geschossen habe. (Da ich den Embbeded Webbrowser entfernt hatte und den TWebbrowser wieder draufgesetzt habe, musste ich diese Zeilen bereits ändern) Ebenfalls jetzt mit dem Twebbrowser ist es so, das wenn mein Code die den Fehler auslöst, auch die Funktion von SX nicht mehr funktioniert. (Ungültige Variantenoperation) Irgendwie etwas verwirrend. Kann es evt an folgendem liegen? (Ich habe diesen Schnipsel eingesetzt weil ansonsten ein "Gleitkomma Divisions durch null" Fehler kommt)
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
begin Set8087CW($133F); end; Also vielleicht zur Sicherheit nocheinmal mein aktueller Code: (Sorry)
Delphi-Quellcode:
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, ExtCtrls, ComCtrls, ImgList, SHDocVw; type TForm1 = class(TForm) Edit1: TEdit; Edit2: TEdit; Button1: TButton; Edit3: TEdit; Label1: TLabel; Timer1: TTimer; Timer2: TTimer; Edit7: TEdit; Label2: TLabel; TreeView1: TTreeView; ImageList1: TImageList; Button2: TButton; WebBrowser1: TWebBrowser; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} function VariantIsObject(const value:OleVariant):boolean; begin result := (VarType(value) = varDispatch); end; procedure Browser2TreeView(WebBrowser: twebbrowser; root:TTreeNodes); var i,j, k :Integer; FormItem, Element, SubElement: OleVariant; child, child2, child3 : TTreeNode; s_type : string; begin Assert(Assigned(WebBrowser)); Assert(Assigned(root)); root.Clear; //count forms on document for I:=0 to WebBrowser.OleObject.Document.forms.Length -1 do begin FormItem := WebBrowser.OleObject.Document.forms.Item(I); if VariantIsObject(FormItem.Name) then child := root.AddChild(nil, 'Form'+IntToStr(i)+': '+FormItem.Name.Name) else child := root.AddChild(nil, 'Form'+IntToStr(i)+': '+FormItem.Name); child.ImageIndex := 3; For j:= 0 to FormItem.Length-1 do begin try Element := FormItem.Item(j); child2 := root.AddChild(child, Element.Name+' = '+Element.Value); s_type := Element.Type; if s_type = 'submit' then child2.ImageIndex := 1 else if s_type = 'text' then child2.ImageIndex := 0 else if s_type = 'file' then child2.ImageIndex := 2 else if s_type = 'hidden' then child2.ImageIndex := 4 else if s_type = 'checkbox' then child2.ImageIndex := 5 else if s_type = 'radio' then child2.ImageIndex := 6 else if s_type = 'select-one' then child2.ImageIndex := 7 else child2.ImageIndex := -1; child3 := root.AddChild(child2, 'Type='+s_type); child3.ImageIndex := -1; if s_type = 'text' then begin child3 := root.AddChild(child2, 'MaxLen='+IntToStr(Element.maxLength)); child3.ImageIndex := -1; end else if s_type = 'select-one' then begin for k := 0 to Element.Options.Length-1 do begin SubElement := Element.Options.Item(k); child3 := root.AddChild(child2, SubElement.Text+ ' = <'+SubElement.Value+'>'); child3.ImageIndex := -1; end; end; except on E:Exception do root.AddChild(child, E.Message); end; end; end; if root.Count > 0 then root.GetFirstNode.Expand(True); end; function FillForm(WebBrowser1: twebbrowser; FieldName: string; Value: string): Boolean; var i, j: Integer; FormItem: Variant; begin Result := False; //no form on document if WebBrowser1.OleObject.Document.all.tags('FORM').Length = 0 then begin Exit; end; //count forms on document for I := 0 to WebBrowser1.OleObject.Document.forms.Length - 1 do begin FormItem := WebBrowser1.OleObject.Document.forms.Item(I); for j := 0 to FormItem.Length - 1 do begin try //when the fieldname is found, try to fill out if FormItem.Item(j).Name = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; except Exit; end; end; end; end; function FillForm2(webbrowser: twebbrowser; const FieldName: string; Value: OleVariant): Boolean; var i, j: Integer; FormItem: Variant; begin Result := False; //no form on document if form1.WebBrowser1.OleObject.Document.all.tags('FORM').Length = 0 then begin Exit; end; //count forms on document for I := 0 to form1.WebBrowser1.OleObject.Document.forms.Length - 1 do begin FormItem := form1.WebBrowser1.OleObject.Document.forms.Item(I).elements; for j := 0 to FormItem.Length - 1 do begin try //when the fieldname is found, try to fill out if FormItem.Item(j).Name = FieldName then begin FormItem.Item(j).Value := Value; Result := True; end; except Exit; end; end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin webbrowser1.Navigate('http://www.chesspoint.ch/admin/index.php?route=catalog/product&token=5184945becdf9423f277847b7489f08a&filter_model='+edit3.Text); repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; if FillForm(form1.WebBrowser1, 'username', edit1.text) = False then ShowMessage('Error. Field USERNAME not available or no Form found.'); if FillForm(form1.WebBrowser1, 'password', edit2.Text) = False then ShowMessage('Error. Field PASSWORD not available or no Form found.'); webbrowser1.oleobject.document.forms.item(0).submit; repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; timer1.enabled:=true; end; procedure TForm1.Button2Click(Sender: TObject); begin Browser2TreeView(WebBrowser1, TreeView1.Items); end; procedure TForm1.FormCreate(Sender: TObject); begin Set8087CW($133F); end; procedure TForm1.Timer1Timer(Sender: TObject); begin repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; // Funktioniert leider nicht da anscheinend der Token pro Seitenwechsel immer geändert wird. Daher einfach jedes mal neue Anmeldung mit Username und PW anstatt Toke auslesen //sTemp := edit4.Text; //Delete(sTemp, 1, Pos('token=',sTemp) + 5); // entfernt alles bis zu der Such-Position und ein Zeichen mehr //edit5.Text := Copy (sTemp, 1, Pos(' ', sTemp)); // kopiert alles bis zum nächsten Leerzeichen // //sTemp := edit4.Text; //Delete(sTemp, 1, Pos('product_id=',sTemp) + 11); // entfernt alles bis zu der Such-Position und ein Zeichen mehr //edit6.Text := Copy (sTemp, 1, Pos('&', sTemp)); // kopiert alles bis zum nächsten Leerzeichen webbrowser1.Navigate('http://www.chesspoint.ch/admin/index.php?route=catalog/product/update&token=5184945becdf9423f277847b7489f08a&product_id=312&filter_model='+edit3.Text); repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; if FillForm(form1.WebBrowser1, 'username', edit1.text) = False then ShowMessage('Error. Field USERNAME not available or no Form found.'); if FillForm(form1.WebBrowser1, 'password', edit2.Text) = False then ShowMessage('Error. Field PASSWORD not available or no Form found.'); webbrowser1.oleobject.document.forms.item(0).submit; timer1.Enabled:=false; end; procedure TForm1.Timer2Timer(Sender: TObject); begin timer2.Enabled:=false; repeat; Application.ProcessMessages; Sleep(0); until WebBrowser1.ReadyState=4; // Deaktiviert da Fehler ausgelöst wird if FillForm2(form1.WebBrowser1, 'quantity', edit7.text) = False then ShowMessage('Error. Field QUANTITY not available or no Form found.'); end; end.
Robert
|
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |