unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, mshtml_tlb2;
type
TForm1 =
class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
CheckBox1: TCheckBox;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
doc: IHTMLDocument2;
JSParam1, JSParam2, JSParam3, JSParam4, JSParam5, JSParam6, JSParam7:
String;
implementation
{$R *.dfm}
function ReplaceText(
const S,ReplacePiece,ReplaceWith:
String):
String;
Var
Position: Integer;
TempStr:
String;
begin
Position := Pos(ReplacePiece,S);
if Position > 0
then Begin
TempStr := S;
Delete(TempStr,1,Position-1+Length(ReplacePiece));
Result :=
Copy(S,1,Position-1)+ReplaceWith+ReplaceText(TempStr,ReplacePiece,ReplaceWith)
End else Result := S;
end;
procedure delay(msec:longint);
var
start,stop:longint;
begin
start := gettickcount;
repeat
stop := gettickcount;
application.processmessages;
until (stop - start ) >= msec;
end;
function deleteLineBreaks(
const S:
string):
string;
var
Source, SourceEnd: PChar;
begin
Source := Pointer(S) ;
SourceEnd := Source + Length(S) ;
while Source < SourceEnd
do
begin
case Source^
of
#10: Source^ := #32;
#13: Source^ := #32;
end;
Inc(Source) ;
end;
Result := S;
End;
procedure script(S:
string);
{ Calls JavaScript Foo() function }
var
Doc: IHTMLDocument2;
// current HTML document
HTMLWindow: IHTMLWindow2;
// parent window of current HTML document
JSFn:
string;
// stores JavaScipt function call
begin
// Get reference to current document
Doc := Form1.WebBrowser1.Document
as IHTMLDocument2;
if not Assigned(Doc)
then
Exit;
// Get parent window of current document
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow)
then begin
Exit; ShowMessage('
not assigned');
end;
// Run JavaScript
try
JSFn := S;
// build function call
if (Length(JSFn) > 0)
and (JSFn[1] <> '
/')
Then HTMLWindow.execScript(JSFn, '
JavaScript');
// execute function
except
// handle exception in case JavaScript fails to run
end;
end;
procedure exeJS(filename:
String; doc: IHTMLDocument2);
var myJSFile: TStringList;
i: integer;
line, thisline:
String;
begin
myJSFile := TStringList.Create;
myJSFile.LoadFromFile(filename);
i:=0;
while i<myJSFile.Count
do
begin
thisline := myJSFile[i];
if (
not ((Length(thisline) > 0)
and (thisline[1] <> '
/')))
then
begin
myJSFile.Delete(i);
dec(i);
end;
inc(i);
end;
line := deleteLineBreaks(myJSFile.Text);
line := ReplaceText(line, '
%1', JSParam1); line := ReplaceText(line, '
%2', JSParam2); line := ReplaceText(line, '
%3', JSParam3); line := ReplaceText(line, '
%4', JSParam4); line := ReplaceText(line, '
%5', JSParam5); line := ReplaceText(line, '
%6', JSParam6); line := ReplaceText(line, '
%7', JSParam7);
if(form1.CheckBox1.Checked)
then InputBox('
InputBox', '
sourceLine', line);
script(line);
{for i := 0 to myJSFile.Count - 1 do
begin
line := myJSFile[i];
script(line);
end;}
end;
procedure exeJSLine(line:
String; doc: IHTMLDocument2);
begin
script(line);
end;
function findElementName(document:IHTMLDocument2;
name:
string): Olevariant;
var items: OleVariant;
i: integer;
begin
result := null;
result := document.all.item(
name, 0);
end;
function returntrue():boolean;
begin
result := true;
end;
procedure waitForBrowser();
begin
Delay(500);
While(Form1.WebBrowser1.Busy)
do Delay(1);
end;
procedure navigate(
URI:
String);
begin
Form1.WebBrowser1.Navigate(
URI);
waitForBrowser();
doc := Form1.WebBrowser1.Document
as IHTMLDocument2;
end;
procedure logIntoOgame();
begin
navigate('
www.ogame.de');
exeJS('
JS\loginscript.js', doc);
waitForBrowser();
end;
procedure changeToPlanet(gala, system, plani: integer;
name:
String);
begin
JSParam1 := IntTostr(gala);
JSParam2 := IntTostr(system);
JSParam3 := IntTostr(plani);
JSParam4 :=
name;
exeJS('
JS/changetoplanet.js', doc);
waitForBrowser;
end;
procedure gotoOverview();
begin
JSParam1 := '
"overview"';
JSParam2 := '
""';
exeJS('
JS/gotoPage.js', doc);
waitForBrowser;
end;
procedure gotoFleet();
begin
JSParam1 := '
"flotten1"';
JSParam2 := '
"Flotte"';
exeJS('
JS/gotoPage.js', doc);
waitForBrowser;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
logIntoOgame();
changeToPlanet(8,278,8,'
"Kolonie"');
gotoFleet;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
exeJS('
JS/markshipdepart.js', doc);
end;
procedure TForm1.FormCreate(Sender: TObject);
var myPos: TPoint;
myControl: TControl;
begin
end;
end.