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.