function GetCurrentUserName:
string;
const
cnMaxUserNameLen = 254;
var
sUserName:
string;
dwUserNameLen: DWORD;
begin
dwUserNameLen := cnMaxUserNameLen - 1;
SetLength(sUserName, cnMaxUserNameLen);
GetUserName(PChar(sUserName), dwUserNameLen);
SetLength(sUserName, dwUserNameLen);
Result := sUserName;
end;
function SendPostData(Ahttp: TIdHTTP;
const AtoURL:
String;
const aParams: TStrings):
String;
//Ahttp: Die HTTP Komponente von Indy 8.0 bzw. 9.0
//AtoURL: An diese URL werden die Informationen gesendet
//Result: HTML-Ergebnis (Antwort des Scripts)
Var
lStream: TMemoryStream;
//HTML-Result des PHP-Scripts
lParams: TStringStream;
I: Integer;
begin
Result:='
';
if not Assigned(aHttp)
then
exit;
lStream := TMemoryStream.create;
lParams := TStringStream.create('
');
try
AHTTP.Request.ContentType := '
application/x-www-form-urlencoded';
//Dieser Stream wird letztendlich gesendet
//Stream mit Werten füllen
for I:=0
to aParams.Count-1
do
begin
if I = aParams.count-1
then
lParams.WriteString(aParams[I])
else
lParams.WriteString(aParams[I] + '
&');
end;
try
//Stream an das PHP-Script senden
AHTTP.Post(AtoURL,lParams,LStream);
except
on E:
Exception do
showmessage('
Fehler bei der Übertragung: ' + E.
Message);
end;
SetLength(Result,lStream.Size);
lStream.Position:=0;
lStream.ReadBuffer(Result[1],lStream.Size);
finally
lParams.Free;
lStream.Free;
end;
end;
function GetUrlContent(
const Url:
string):
string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer:
array[0..1024]
of Char;
BytesRead: dWord;
begin
Result := '
';
NetHandle := InternetOpen('
Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil, 0);
if Assigned(NetHandle)
then
begin
UrlHandle := InternetOpenUrl(NetHandle, PChar(
Url),
nil, 0, INTERNET_FLAG_RELOAD, 0);
if Assigned(UrlHandle)
then
{ UrlHandle valid? Proceed with download }
begin
FillChar(Buffer, SizeOf(Buffer), 0);
repeat
Result := Result + Buffer;
FillChar(Buffer, SizeOf(Buffer), 0);
InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
until BytesRead = 0;
InternetCloseHandle(UrlHandle);
end
else
{ UrlHandle is not valid. Raise an exception. }
raise Exception.CreateFmt('
Cannot open URL %s', [
Url]);
InternetCloseHandle(NetHandle);
end
else
{ NetHandle is not valid. Raise an exception }
raise Exception.Create('
Unable to initialize Wininet');
end;
procedure Tform1.kneipe_todo(todo,comboitem1,comboitem2 : integer;attrib1,attrib2 :
string);
var
todo_list : TStringlist;
begin
todo_list := Tstringlist.Create;
case todo
of
0 :
begin //Login
todo_list.add('
kneipe='+attrib1);
todo_list.Add('
passwort='+ attrib2);
todo_list.add('
submit_login=Login');
try
sendpostdata(IDHTTP1,'
/index.html',todo_list);
memo1.Lines.Add('
Login erfolgreich');
except
memo1.Lines.Add('
Login nicht erfolgreich');
showmessage('
Login nicht erfolgreich');
end;
end;
1 :
begin // Lager füllen
case comboitem2
of
0 : todo_list.add('
lager_art=bier');
1 : todo_list.add('
lager_art=schnaps');
2 : todo_list.add('
lager_art=wein');
3 : todo_list.add('
lager_art=longdrinks');
4 : todo_list.add('
lager_art=schampus');
end;
case comboitem1
of
0 : todo_list.Add('
wielang=min10');
1 : todo_list.Add('
wielang=min20');
2 : todo_list.Add('
wielang=stunde1');
3 : todo_list.Add('
wielang=stunden2');
4 : todo_list.Add('
wielang=stunden4');
5 : todo_list.Add('
wielang=stunden8');
6 : todo_list.Add('
wielang=stunden12');
end;
todo_list.add('
submit_bed=Bedienung+schicken');
try
//memo1.Lines.Add(todo_list[0] + todo_list[1] + todo_list[2]);
sendpostdata(IDHTTP1,'
/lagerfuellen/index.html',todo_list);
memo1.Lines.Add('
Lager gefüllt mit ' + combobox2.Items[comboitem2] + '
für eine Zeit von ' + combobox1.Items[comboitem1]);
except
showmessage('
Lager füllen nicht erfolgreich');
end;
end;
end;
todo_list.Clear;
todo_list.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if (labelededit1.Text <> '
')
and (labelededit2.Text <> '
')
and (labelededit3.Text <> '
')
then
kneipe_todo(0,0,0,labelededit2.Text,labelededit3.Text)
else
showmessage('
ALLE FELDER ausfüllen');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
login_var := TStringlist.Create;
lager_var := TStringlist.Create;
idHTTP1.Request.Accept := '
text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
idHTTP1.Request.AcceptCHarset := '
ISO-8859-1,utf-8;q=0.7,*;q=0.7';
idHTTP1.Request.AcceptEncoding := '
gzip,deflate';
idHTTP1.Request.AcceptLanguage := '
de-de,de;q=0.8,en-us;q=0.5,en;q=0.3';
idHTTP1.Request.Connection := '
keep-alive';
idHTTP1.Request.ContentType := '
application/x-www-form-urlencoded';
idHTTP1.Request.Host := '
www.kneipengame.com';
idHTTP1.Request.Referer := '
http://www.kneipengame.com/index.html';
idHTTP1.Request.UserAgent := '
Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.9.1.7) Gecko/20091221 Firefox/3.5.7 GTB6';
labelededit1.Text := GetCurrentUserName;
idHTTP1.CookieManager.AddCookie2( labelededit1.Text+'
@kneipengame.com','
www.kneipengame.com');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := true;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
timer1.Enabled := false;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
kneipe_todo(1,combobox1.ItemIndex,combobox2.ItemIndex,'
','
');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
memo1.Text := geturlcontent('
http://www.kneipengame.com/lagerfuellen/index.html');
end;
end.