Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

test_cookie.bas

Uploader:MitgliedThePuppetMaster
Datum/Zeit:28.06.2009 17:52:15
Hinweis: Dieser Quelltext ist Bestandteil des Projekts TSNE V2 / V3, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

'##############################################################################################################
'TEST-CLIENT mit cookie's für TSNE_V3
'##############################################################################################################


'Das beispiel ist grundlegend identisch mit dem "test_client.bas" beispiel. Daher erspare ich gröstenteils
'die beschreibugnen und konzentriere mich hier nur auf die cookie implementierung.


'Als server nutzen wir google, da dieser cookies versendet, empfängt udn verarbeiten kann.

'Cookies werden hier beschrieben: http://de.wikipedia.org/wiki/HTTP-Cookie
'sowie in den RFC's: http://tools.ietf.org/html/rfc2109
'##############################################################################################################
#include once "TSNE_V3.bi"



'##############################################################################################################
'Ein Typ definieren, das einem Cookie entspricht.
Type Cookie_Type
    V_Next          as Cookie_Type Ptr      'Nötig um eine Linked List zu erzeugen
    V_Prev          as Cookie_Type Ptr      'Nötig um eine Linked List zu erzeugen

    'es folgend die Cookie-Parameter (Optionl = Muss nicht zwingend gegeben sein)
    V_Name          as String               'der Name dieses Cookie's
    V_Version       as UInteger             'Cookie-Version
    V_Expires       as String               '(optional) Ablaufzeitpunkt als Datum dieses Cookies (wird bei erreichen gelöscht)
    V_MaxAge        as UInteger             '(optional) Ablaufzeitpunkt in Sekunden (-||-)
    V_Domain        as String               '(optional) Die Domain (z.B. Google.de)
    V_Path          as String               '(optional) Der Request-Path (z.B. /index.html)
    V_Port          as UShort               '(optional) Der Server-Port (z.B. 80)
    V_Comment       as String               '(optional) Ein Kommentar zu diesem Cookie
    V_CommentURL    as String               '(optional) Eine URL als Kommentar zu diesem Cookie
    V_Secure        as UByte                '(optional) 1 = dies ist ein sicheres Cookie. Wird meist nur bei HTTPS-Verbindungen gesendet
    V_Discard       as UByte                '(optional) 1 = Soblad das Programm beendet wird, MUSS dieses Cookie gelöscht werden!
End Type
'--------------------------------------------------------------------------------------------------------------
Dim Shared G_CookieF    as Cookie_Type Ptr
Dim Shared G_CookieL    as Cookie_Type Ptr



'##############################################################################################################
'Sucht nach einen Bereits vorhandenem Cookie, und gibt diesen als Klartext zurück
Function Cookie_Get(ByVal V_Domain as String, ByVal V_Path as String, ByVal V_Port as UShort = 80) as String
'Prüfen ob alle daten vorhanden sind.
If V_Domain = "" Then Return ""
If V_Path = "" Then Return ""
If V_Port = 0 Then Return ""

'Passendes Cookie suchen
Dim TPtr as Cookie_Type Ptr = G_CookieF
Do Until TPtr = 0
    'Domain prüfen
    If TPtr->V_Domain = Right(V_Domain, Len(TPtr->V_Domain)) Then
        'Port prüfen
        If TPtr->V_Port = V_Port Then
            'Path prüfen
            If (TPtr->V_Path = "") or (TPtr->V_Path = Left(V_Path, Len(TPtr->V_Path))) Then
                Return TPtr->V_Name
            End If
        End If
    End If
    TPtr = TPtr->V_Next
Loop
'Ansonsten nichts zurückgeben
Return ""
End Function

'Cookie: NID=24=Iv5X8T1V1tIeYyiUo9WTI4vRqG23-3l77pTWffp8FIvDOCNBGSo3Yt2YO-7PdclrWMgVvNZhFn7Pnxn9OY-qKcFQwjQLwYoCU2LWJPuhFgxXpca-9i8MGbM7LYeovrX4; SID=DQAAAFsAAAAIH_Dz9zSH3qWpMubXYtDZsBv8ki0O_q8fHwwz94bYWUe0fjT2RbqRZNPAWlsuJEWK_ZE6lfWVpidJwq


'##############################################################################################################
'Diese Funktion fügt ein Cookie (sofern es noch nicht vorhanden ist, zur LinkedList hinzu und gibt den Pointer zurück
Function Cookie_Add(V_DataD() as String, V_ParamD() as String, V_DataC as UInteger) as Cookie_Type Ptr
Dim TCookie as Cookie_Type
'Parameter untersuchen
With TCookie
    For X as UInteger = 1 to V_DataC
        Select Case LCase(V_DataD(X))
            Case "version":     .V_Version      = ValUInt(V_ParamD(X))
            Case "expires":     .V_Expires      = V_ParamD(X)
            Case "max-age":     .V_MaxAge       = ValUInt(V_ParamD(X))
            Case "domain":      .V_Domain       = V_ParamD(X)
            Case "path":        .V_Path         = V_ParamD(X)
            Case "port":        .V_Port         = CUShort(ValUInt(V_ParamD(X)))
            Case "comment":     .V_Comment      = V_ParamD(X)
            Case "commenturl":  .V_CommentURL   = V_ParamD(X)
            Case "secure":      .V_Secure       = CUByte(ValUInt(V_ParamD(X)))
            Case "discard":     .V_Discard      = CUByte(ValUInt(V_ParamD(X)))
            Case else
                'Alle anderen Cezeichnugnen entsprechen dem NAME. da die Bezeichnugn des Namen unbekannt ist, wird er auch hinzugefügt
                .V_Name = V_DataD(X) & "=" & V_ParamD(X)
        End Select
    Next
    If .V_Port = 0 Then .V_Port = 80
    'Regulär müsste auch die Version vorhanden sein. Da google jedoch diesen parameter nicht sendet, prüfen wir, ob ein Wert vorhanden ist. Wenn nicht, dann setzen wir ihn
    If .V_Version = 0 Then .V_Version = 1

    'Prüfen, ob alle nötigen angaben vorhanden sind
    If .V_Name = "" Then Return 0
    If .V_Version = 0 Then Return 0
    'Prüfen ob Cookie bereits vorhanden ist. Wenn ja, dann Pointer zurück geben.
    Dim TName as String = LCase(.V_Name)
    Dim TPtr as Cookie_Type Ptr = G_CookieF
    Do Until TPtr = 0
        If TPtr->V_Name = TName Then Return TPtr
        TPtr = TPtr->V_Next
    Loop
    'Ansonsten neuen eintrag erzeugen
    If G_CookieL <> 0 Then
        G_CookieL->V_Next = CAllocate(SizeOf(Cookie_Type))
        G_CookieL->V_Next->V_Prev = G_CookieL
        G_CookieL = G_CookieL->V_Next
    Else
        G_CookieL = CAllocate(SizeOf(Cookie_Type))
        G_CookieF = G_CookieL
    End If
    *G_CookieL = TCookie
End With
Return G_CookieL
End Function



'##############################################################################################################
Dim G_Client as UInteger
Dim Shared G_Data as String
Dim Shared G_Head as String



'##############################################################################################################
Declare Sub TSNE_Disconnected   (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_Connected      (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_NewData        (ByVal V_TSNEID as UInteger, ByRef V_Data as String)



'##############################################################################################################
Print "[INIT] Client..."
Dim BV as Integer

'Wir senden die folgende Anfrage 2x hintereinander. Einmal um ein cookie zu empfangen, udn ein zweites mal um das cookie mit zu senden.
G_Client = 0
G_Data = ""
G_Head = ""
Print "[Connecting]"
BV = TSNE_Create_Client(G_Client, "www.google.de", 80, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData, 60)
If BV <> TSNE_Const_NoError Then
    Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    End -1
Else: Print "[OK]"
End If
Print "[WAIT] ..."
TSNE_WaitClose(G_Client)
Print "[WAIT] OK"


'Beim erneutem senden kann man in der Konsole sehen, das in der antwort von Google KEIN neues cookie gesetzt wird.
'Das zeigt an, das unser cookie akzeptiert wurde.
G_Client = 0
G_Data = ""
G_Head = ""
Print "[Connecting]"
BV = TSNE_Create_Client(G_Client, "www.google.de", 80, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData, 60)
If BV <> TSNE_Const_NoError Then
    Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    End -1
Else: Print "[OK]"
End If
Print "[WAIT] ..."
TSNE_WaitClose(G_Client)
Print "[WAIT] OK"


Print "[END]"
End



'##############################################################################################################
Sub TSNE_Disconnected(ByVal V_TSNEID as UInteger)
Print "[DIS]"
End Sub



'##############################################################################################################
Sub TSNE_Connected(ByVal V_TSNEID as UInteger)
Print "[CON]"
Dim CRLF as String = Chr(13, 10)
Dim D as String
'Nach einem vorhandenem Cookie suchen
Dim TCookie as String = Cookie_Get("www.google.de", "/")
D += "GET / HTTP/1.0" & CRLF
D += "Host: www.google.de" & CRLF
'Wenn ein Cookie gefunden wurde, dann wird es in die Anfrage eingebaut
If TCookie <> "" Then D += "Cookie: " & TCookie & CRLF
D += "connection: close" & CRLF
D += CRLF

Print "[SEND] ..."
Print ">" & D & "<"
Dim BV as Integer = TSNE_Data_Send(V_TSNEID, D)
If BV <> TSNE_Const_NoError Then
    Print "[FEHLER] " & TSNE_GetGURUCode(BV)
Else: Print "[SEND] OK"
End If
End Sub



'##############################################################################################################
Sub TSNE_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
'Print "[NDA]: >" & V_Data & "<"
'Prüfen, ob Header noch nicht gefunden wurde
If G_Head = "" Then
    'Dann neue daten anhängen
    G_Data += V_Data
    'udn nach dem ende des headers suchen
    Dim XPos as UInteger = InStr(1, G_Data, Chr(13, 10, 13, 10))
    'gefunden?
    If XPos > 0 then
        'Dann header abschneiden udn speichern
        G_Head = Left(G_Data, XPos - 1)
        Dim T as String
        'Header nach Cookie durchsuchen
        Do
            'Zeilenende suchen
            XPos = InStr(1, G_Head, Chr(13, 10))
            'Kein zeilenende gefnuden? dann suche verlassen (fertig)
            If XPos = 0 Then Exit Do
            'ansonsten, zeile zwischenkopieren
            T = Left(G_Head, XPos - 1)
            'und vom rest abschneiden
            G_Head = Mid(G_Head, XPos + 2)
            'In Zeile nach ":" suchen. (Parameterende)
            XPos = InStr(1, T, ":")
            'Gefunden?
            If XPos > 0 Then
                'Ist die zeile ein zu setzendes cookie?
                If LCase(Left(T, XPos - 1)) = "set-cookie" Then
                    Print "COOKIE >"; Trim(Mid(T, XPos + 1)); "<"
                    'Cookieparameter abschneiden udn leerzeichen abtrennen
                    T = Trim(Mid(T, XPos + 1))
                    'Variablen zum zerschneiden der Cookieparameter
                    Dim BC as UByte
                    Dim DD() as String
                    Dim DV() as String
                    Dim DC as UInteger
                    Dim X as UInteger
                    Dim Y as UInteger = 1
                    'Cookieparameter zeichen für zeichen abarbeiten um ";" zu suchen
                    For X = 1 to Len(T)
                        Select Case T[X - 1]
                            Case 34 '"
                                'Wenn Zeichen ein " ist, dann dürfen folgt ein text. Hier darf kein gefudnenes ";" zum trennen verwendet werden

                                'Wurde erneut ein " gefunden, dann ist der string zu ende
                                If BC = 0 Then BC = 1 else BC = 0

                            Case 59 ';
                                'es wurde ein ; gefunden
                                'Ist das Zeichen nicht in einem Text eingeschlossen?
                                If BC = 0 Then
                                    'Dann parameter abtrennen und speichern
                                    DC += 1
                                    Redim Preserve DD(DC) as String
                                    Redim Preserve DV(DC) as String
                                    DD(DC) = Trim(Mid(T, Y, X - Y))
                                    'Nach einen Parameter trenner suchen
                                    XPos = InStr(1, DD(DC), "=")
                                    'Gefunden?
                                    If XPos > 0 then
                                        'Dann parameter abschneiden und seperat speichern
                                        DV(DC) = Mid(DD(DC), XPos + 1)
                                        DD(DC) = Left(DD(DC), XPos - 1)
                                    Else 'Eigentlich ist es ein fehler, wenn kein parameter vorhanden ist. Wir sidn jedoch kulant und akzeptieren es auch so
                                    End If
                                    Y = X + 1
                                End If
                        End Select
                    Next
                    'Ist noch ein Parameter übrig, das noch nicht hinzugefügt wurde?
                    If X <> Y Then
                        'Dann hinzufügen
                        DC += 1
                        Redim Preserve DD(DC) as String
                        Redim Preserve DV(DC) as String
                        DD(DC) = Trim(Mid(T, Y))
                        XPos = InStr(1, DD(DC), "=")
                        If XPos > 0 then
                            DV(DC) = Mid(DD(DC), XPos + 1)
                            DD(DC) = Left(DD(DC), XPos - 1)
                        End If
                    End If
                    'Cookieparameter ausgeben
                    Print
                    For X = 1 to DC
                        Print X; " >"; DD(X); "<___>"; DV(X); "<"
                    Next
                    Print

                    'Cookie hinzufügen
                    Cookie_Add(DD(), DV(), DC)

                    'und schleife verlassen
                    Exit Do
                End If
            End If
        Loop
    End If
End If
End Sub