uses WinInet
procedure SetCookie(sValue: String);
var bReturn: Boolean; pURL, pValue: PChar;
begin
pURL := PChar('http://localhost/');
pValue := PChar(sValue+' expires = Sat, 01-Jan-2020 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;
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('https://www.bz-berlin.de/');
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 := PAnsiChar(pData);
end;
end;
Cookie setzten :
procedure TForm1.Button1Click(Sender: TObject);
begin
SetCookie('myCookie');
end;
Cookie löschen :
procedure TForm1.Button2Click(Sender: TObject);
var sString: String;
begin
sString := 'myCookie';
//sString := GetCookie; // HIER FÜR LOKALE CACHE SUCHE
if(sString <> '') then begin
try
ShowMessage(sString);
except
on E: Exception do ShowMessage(E.Message+' '+IntToStr(E.HelpContext));
end;
end;
end;
Keine Kommentare:
Kommentar veröffentlichen