unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinInet, StdCtrls, Buttons;
type
TForm1 =
class(TForm)
Button1: TButton;
Button2: TButton;
BitBtn1: TBitBtn;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Funktion zum stzen des Cookies
//Funktioniert einwandfrei
//Cookie wird auf Festplatte geschrieben und bleibt auch
//Inhalt ist korrekt
procedure SetCookie(sValue:
String);
var
bReturn: Boolean;
pURL, pValue: PChar;
begin
pURL := PChar('
http://localhost/');
pValue := PChar(sValue+'
; expires = Sat, 01-Jan-2007 00:00:00 GMT');
bReturn := InternetSetCookie(pURL, '
TestData', pValue);
if(
not bReturn)
then ShowMessage('
FALSE SetCookie');
end;
function GetCookie:
String;
var
pURL, pName, pData: PAnsiChar;
cSize, cError: Cardinal;
bResult: Boolean;
begin
pURL := PAnsiChar('
http://localhost/');
pName := PAnsiChar('
TestData');
cSize := 255;
pData := '
';
bResult := FALSE;
//ShowMessage('1 try');
try
//Erster Aufruf mit nil um korrekte cSize zu erhalten
InternetGetCookie(pUrl, pName,
nil, cSize);
except
on E:
Exception do begin
cError := Windows.GetLastError();
if(cError = ERROR_NO_MORE_ITEMS)
then begin
ShowMessage('
ERROR_NO_MORE_ITEMS');
end;
if(cError = ERROR_INSUFFICIENT_BUFFER)
then begin
ShowMessage('
ERROR_INSUFFICIENT_BUFFER');
end;
ShowMessage(E.
Message+'
'+IntToStr(E.HelpContext));
exit;
end;
end;
//Neu setzen da nach erstem auruf von InternetGetCookie
//variablen leer sind ;_;
pURL := PAnsiChar('
http://localhost/');
pName := PAnsiChar('
TestData');
//ShowMessage('2 try');
try
//löst eine exception aus... aber warum.. es ergibt keinen sinn
bResult := InternetGetCookie(pUrl, pName, pData, cSize);
except
on E:
Exception do begin
cError := Windows.GetLastError();
if(cError = ERROR_NO_MORE_ITEMS)
then begin
ShowMessage('
ERROR_NO_MORE_ITEMS');
end;
if(cError = ERROR_INSUFFICIENT_BUFFER)
then begin
ShowMessage('
ERROR_INSUFFICIENT_BUFFER');
end;
ShowMessage(E.
Message+'
'+IntToStr(E.HelpContext));
exit;
end;
end;
if(bResult = FALSE)
then begin
ShowMessage('
GET COOKIE FALSE');
exit;
end;
if(bResult = TRUE)
then begin
ShowMessage('
GET COOKIE TRUE - Cookie:'+pData);
Result := PChar(pData);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetCookie('
dooof20_dumm1');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
sString:
String;
begin
sString := '
';
sString := GetCookie;
if(sString <> '
')
then begin
try
ShowMessage(sString);
except
on E:
Exception do ShowMessage(E.
Message+'
'+IntToStr(E.HelpContext));
end;
end;
end;
end.