this slowpoke moves

Local Cookie Set & Delete

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

Beliebte Posts

Translate