' *******************************************************
' * Allgemeine Routinen zur Verwaltung von Cookie Jars  *
' *                                                     *
' * Autor der C-Routinen Rolf Kotzian, D-4790 Paderborn *
' *            (c) 1992 MAXON Computer GmbH             *
' *******************************************************
'
PROCEDURE create_cookie(VAR cookie%(),id$,value%)
  ' CREATE_COOKIE:  installiert in der Variablen
  ' cookie' einen Cookie; als
  ' weitere Parameter werden die
  ' ID des Cookies sowie dessen
  ' Wert �bergeben.
  '
  cookie%(0)=4096*ASC(id$(3))+256*ASC(id$(2))+16*ASC(id$(1))+ASC(id$(0))
  cookie%(1)=value
RETURN
FUNCTION new_cookie(VAR entry%())
  ' NEW_COOKIE:  tr„gt neuen Cookie in den Jar ein
  ' Achtung !
  ' Der Fall des bereits vollen Jars wird hier noch nicht abgefangen;
  ' es muss dann entsprechend Speicher alloziert, und die gesamte
  ' Tabelle umkopiert werden.
  '
  act_row&=0
  '  Zeiger auf CookieJar holen
  cookiejar%=LPEEK(&H5A0)
  '  Ist der Jar �berhaupt vorhanden ?
  IF cookiejar%=0
    RETURN FALSE
  ENDIF
  '  NULL-Cookie suchen
  WHILE {cookiejar%}<>0
    act_row&=act_row&+1
    cookiejar%=cookiejar%+8
  WEND
  '
  ' der neue Cookie kann nur eingetragen werden, wenn der CookieJar
  ' noch ausreichend Platz bietet...
  IF act_row&<{cookiejar%+4}
    '  NULL-Cookie weiterschieben
    {cookiejar%+8}={cookiejar%}
    {cookiejar%+12}={cookiejar%+4}
    '  neuen Cookie eintragen
    {cookiejar%}=entry%(0)
    {cookiejar%+4}=entry%(1)
    RETURN TRUE
  ENDIF
  RETURN FALSE
ENDFUNC
FUNCTION get_cookie(VAR cookie%(),value%)
  ' GET_COOKIE:  fragt den Wert eines Cookies ab. Als Parameter werden dabei
  ' die ID des zu suchenden Cookies sowie ein Zeiger auf den gefundenen
  ' Wert �bergeben.
  ' Die Routine liefert den Wert FALSE falls der angegebene Cookie nicht existiert
  '
  '  Zeiger auf Cookie Jar holen
  cookiejar%=LPEEK(&H5A0)
  '  Ist der Jar �berhaupt vorhanden ?
  IF cookiejar%=0
    RETURN FALSE
  ENDIF
  REPEAT
    IF {cookiejar%}<>cookie%(1)
      '  nur eintragen, wenn kein NULL-Zeiger
      IF value%<>0
        {value%}={cookiejar%+4}
        RETURN TRUE
      ENDIF
    ELSE
      '  n„chsten Cookie nehmen
      cookiejar%={cookiejar%+8}
    ENDIF
  UNTIL ({cookiejar%}=0) ! NULL-Cookie ?
  RETURN FALSE
ENDFUNC
PROCEDURE remove_cookie(cookie_id$)
  REM OVE_COOKIE:  entfernt den mit 'cookie_id' bezeichneten Cookie aus dem Jar
  '
  '  Zeiger auf Cookie Jar holen
  cookiejar%=LPEEK(&H5A0)
  '  Ist der Jar �berhaupt vorhanden ?
  IF (cookiejar%<>0)
    '  suche den zu l”schenden Cookie in der Tabelle...
    WHILE ({cookiejar%}<>0 AND {cookiejar%}<>4096*ASC(cookie_id$(3))+256*ASC(cookie_id$(2))+16*ASC(cookie_id$(1))+ASC(cookie_id$(0)))
      cookiejar%={cookiejar%+8}
    WEND
    '  wurde der gew�nschte Cookie gefunden, oder ist bereits das Ende der Tabelle
    ' (NULL-Cookie) erreicht ?
    IF ({cookiejar%}<>0)
      '  der Cookie wurde gefunden !
      REPEAT
        '  jetzt werden die �brigen Cookies einfach eine Position
        ' nach oben gezogen
        {cookiejar%}={cookiejar%+8}
        {cookiejar%+4}={cookiejar%+12}
        cookiejar%={cookiejar%+8}
      UNTIL ({cookiejar%}=0)
    ENDIF
  ENDIF
RETURN
PROCEDURE move_cookiejar(dest%,size%)
  ' MOVE_COOKIEJAR:  verschiebt (kompletten) Jar an eine neue Speicherstelle.
  ' Als Parameter werden die neue Adresse des Jar, sowie seine Gr”že, d.h. die
  ' Anzahl der in ihn hineinpassenden Cookies �bergeben
  '
  '  Zeiger auf Cookie Jar holen
  cookiejar%=LPEEK(&H5A0)
  '  Alte Adresse merken
  dest_cop%=dest%
  '  Ist der Jar �berhaupt vorhanden ?
  IF (cookiejar%<>0)
    REPEAT
      '  Cookie's kopieren
      {dest%}={cookiejar%}
      {dest%+4}={cookiejar%+4}
      dest%={dest%+8}
      cookiejar%={cookiejar%+8}
    UNTIL {cookiejar%}=0
    '  NULL-Cookie und seinen neuen (?) Wert eintragen...
    {dest%}={cookiejar%}
    {dest%+4}=size%
    '  _p_cookies auf neue Adresse setzen
    LPOKE &H5A0,dest_cop%
  ENDIF
RETURN
FUNCTION cookie_size
  ' COOKIE_SIZE:  liefert die Gr”sse des installierten Jars, d.h die
  ' Anzahl der maximal m”glichen Eintr„ge.
  '
  '  Zeiger auf Cookie Jar holen
  cookiejar%=LPEEK(&H5A0)
  '  Ist der Jar �berhaupt vorhanden ?
  IF cookiejar%=0
    RETURN 0
  ENDIF
  '  suche den NULL-Cookie
  WHILE {cookiejar%}<>0
    cookiejar%={cookiejar%+8}
  WEND
  RETURN {cookiejar%+4}
ENDFUNC
PROCEDURE print_cookiejar
  ' PRINT_COOKIEJAR:  gibt den Inhalt des Jars auf die Standard-Ausgabe aus.
  '
  '  Zeiger auf Cookie Jar holen
  cookiejar%=LPEEK(&H5A0)
  '  Ist der Jar �berhaupt vorhanden ?
  IF (cookiejar%<>0)
    REPEAT
      '  Jar auf 'stdout' ausgeben
      PRINT {cookiejar%},{cookiejar%+4}
      cookiejar%={cookiejar%+8}
    UNTIL {cookiejar%}=0
  ENDIF
RETURN