|
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
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
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 |
![]() |
![]() |