HTTP Proxy Server unter PB - Will keine Bilder laden

Torakas · Beitrag von **Torakas** » 22.02.2005 00:13

Hi Leute,

ich schreibe gerade einen kleinen HTTP Proxy Server der auch mehrere Browserclients verwalten koennte. Das Teil laeuft an sich wirklich gut, bis er grafiken runterladen muss vom Webserver. Das will überhaupt nicht.

Kann mir einer dabei helfen. Bitte bitte, es ist sehr wichtig. Danke schonmal.

Hier der Code:

Code: Alles auswählen

;- Proxyversuch
OnErrorGoto(?CatchError) 

Declare.s CreateServerMessage(Title.s, Head.s, Text.s)

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

Port = 6832

Structure ClientInformation
  WebserverID.l
  ClientID.l
  Host.s
EndStructure

NewList ClientInfo.ClientInformation()
NewList WebserverIDtoClientID.l()

ControlledCancelb.b
ToSendRequest.b


*ReceiveBuffer = AllocateMemory(61440)
*tmpstr = AllocateMemory(61440)

If CreateNetworkServer(Port)
  
  MessageRequester("PureBasic - Server", "Server created (Port "+Str(Port)+").", 0)
  
  Repeat
    
    Delay(10)
    
    SEvent.l = NetworkServerEvent()
    
    If SEvent
      
      ClientID.l = NetworkClientID()
      
      Select SEvent
        
        Case 1
          AddElement(ClientInfo())
          ClientInfo()\ClientID = ClientID.l
        
        Case 2
          Source.s = ""
          url.s = ""
          Rest.s = ""
          n.l = 0
          i.l = 0
          HTTPVersion.s = ""
          Filepath.s = ""
          FileTypes.s = ""
          UserAgent.s = ""
          Language.s = ""
          Charset.s = ""
          Encoding.s = ""
          Connection.s = ""
          Referer.s = ""
          Command.s = ""
          cookie.s = ""
          Host.s = ""
          Request.s = ""
          d.s = ""
          
          ResetList(ClientInfo())
          While NextElement(ClientInfo())
            If ClientInfo()\ClientID = ClientID.l
              Break
            EndIf
          Wend
          *ReceiveBuffer = AllocateMemory(61440)
          ReceiveNetworkData(ClientID.l, *ReceiveBuffer, 61440) ; Maximal 60KByte abholen
          Debug "==================== Empfangen vom Client Anfang ======================"
          Debug PeekS(*ReceiveBuffer)
          Debug "===================== Empfangen vom Client Ende ======================="
          
          d.s = PeekS(*ReceiveBuffer)
          Buffer.s = d.s
          Buffer.s = LCase(Buffer)
          
          ;- Ob es ein Kommando ist, das modifiziert werden muss, oder nicht
          If Left(Buffer.s, 3) <> "get" Or Left(Buffer.s, 4) = "post"
            If ClientInfo()\WebserverID <> 0
              SendNetworkData(ClientInfo()\WebserverID, *ReceiveBuffer, Len(PeekS(*ReceiveBuffer))) ; d.s)
            EndIf
          Else      

            Source.s = d.s
                  
            n.l = FindString(Source.s, Chr(13)+Chr(10), 0)
            Request.s = Right(Source.s, Len(Source.s) - (n.l + 1))
            Command.s = Left(Source.s, n.l - 1)
                
            If Left(Command.s, 3) = "GET"
              ;- wenn der Browser Daten will
              n.l           = FindString(Command.s, " HTTP/", 0)
              url.s         = Mid(Command.s, 5, Len(Command.s) - 4 - 9)
              HTTPVersion.s = (Right(Command.s, 8) + Chr(13)+Chr(10))
              Buffer.s      = Right(url.s, Len(url.s) - 7)
              Host.s        = Left(Buffer.s, FindString(Buffer.s, "/", 0) - 1)
              Filepath.s    = Right(Buffer.s, Len(Buffer.s) - Len(Host.s))
              If FindString(Host.s, ":", 0) > 0
                Port.l = Val(Mid(Host.s, FindString(Host.s, ":", 0) + 1, Len(Host.s)))
                Host.s = Left(Host.s, FindString(Host.s, ":", 0) - 1) 
              Else
                Port.l = 80
              EndIf
              
              ; Kommando einstellen
              Command.s     = "GET"
              
            ElseIf Left(Command.s, 4) = "POST"
              ;- wenn der Browser Daten schicken will
              n.l           = FindString(Command.s, " HTTP/", 0)
              url.s         = Mid(Command.s, 6, Len(Command.s) - 5 - 9)
              HTTPVersion.s = (Right(Command.s, 8) + Chr(13)+Chr(10))
              Buffer.s      = Right(url.s, Len(url.s) - 7)
              Host.s        = Left(Buffer.s, FindString(Buffer.s, "/", 0) - 1)
              Filepath.s    = Right(Buffer.s, Len(Buffer.s) - Len(Host.s))
              If FindString(Host.s, ":", 0) > 0
                Port.l = Val(Mid(Host.s, FindString(Host.s, ":", 0) + 1, Len(Host.s)))
                Host.s = Left(Host.s, FindString(Host.s, ":", 0) - 1)
              Else
                Port.l = 80
              EndIf
              
              ; Kommando einstellen
              Command.s     = "POST"
            EndIf
                      
            ;- Den Rest des HTTP-Requests aufspalten und die Informationen auswerten
            Repeat
              ; Solange wiederholen, Bis Request keine Zeilenumbrüche 
              ; mehr enthält
              n.l = FindString(Request.s, Chr(13)+Chr(10), 0)
              If n.l <> 0
                Buffer.s  = Left(Request.s, n.l - 1)
                Request.s = Right(Request.s, Len(Request.s) - (n.l + 1))
                ; Buffer.s  = Right(Buffer.s, Len(Buffer.s) - 1)
                
                If Left(Buffer.s, 7) = "Accept:"
                  ;- Die Datei-(MIME-)Typen, die der Browser akzeptiert
                  FileTypes.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 16) = "Accept-Language:"
                  ;- Die Sprache, Die neben Englisch noch akzeptiert wird
                  Language.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 16) = "Accept-Encoding:"
                  ;- Die Codierungen, Die akzeptiert werden
                  Encoding.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 8) = "Referer:"
                  ;- Der Referer (über welchen Link man die Seite aufgerufen hat)
                  Referer.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 11) = "User-Agent:"
                  ; Der Browser-Typ
                  UserAgent.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 7) = "Cookie:"
                  ; Der Browser-Typ
                  cookie.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 5) = "Host:"
                  ; Der Browser-Typ
                  Host2.s = (Buffer.s + Chr(13)+Chr(10))
                ElseIf Left(Buffer.s, 17) = "Proxy-Connection:"
                  ; Ganz wichtig, Connection muss auf "Keep-Alive" stehen
                  Connection.s = ("Connection:" + Right(Buffer.s, Len(Buffer.s) - 17) + Chr(13)+Chr(10) + Chr(13)+Chr(10))
                EndIf
              Else
                Break
              EndIf
            ForEver
                  
            If HiddeReferer.l = 1
              ; Referer austauschen (Verschleierung der Herkunft)
              Referer.s = ("Referer: " + "www.google.de" + Chr(13)+Chr(10)) ; Zum Beispiel
            EndIf
            *tmpstr = AllocateMemory(61440)
            ; http-Request zusammensetzen
            Request.s = Command.s + " " + Filepath.s + " " + HTTPVersion.s + FileTypes.s + Encoding.s + Referer.s + Language.s + cookie.s + UserAgent.s + Host2.s + Connection.s
          
            ; Wenn der Host immer noch der Gleiche und man noch immer mit ihm verbunden ist
            If Host = ClientInfo()\Host And ClientInfo()\WebserverID <> 0
              PokeS(*tmpstr, Request.s)
              SendNetworkData(ClientInfo()\WebserverID, *tmpstr, Len(PeekS(*tmpstr)))
            Else
              If ClientInfo()\WebserverID <> 0
                CloseNetworkConnection(ClientInfo()\WebserverID)
              EndIf
              ; Wenn der Webserver nicht erreichbar ist
              ClientInfo()\WebserverID = OpenNetworkConnection(Host.s, Port.l)
              
              If ClientInfo()\WebserverID = 0
                ;- Fehlernachricht an den Client senden
                Buffer.s = CreateServerMessage(Host.s + " nicht erreichbar", Host.s + " nicht erreichbar.", "Der Remote-Computer " + Host.s + " ist nicht erreichbar. Stellen Sie sicher dass Sie mit dem Internet verbunden sind und dass der Remotehost online ist. Bitte nutzen Sie diesen Server nur als HTTP-Proxy.")
                PokeS(*tmpstr, Buffer.s)
                SendNetworkData(ClientInfo()\WebserverID, *tmpstr, Len(PeekS(*tmpstr)))
              Else
                PokeS(*tmpstr, Request.s)
                SendNetworkData(ClientInfo()\WebserverID, *tmpstr, Len(PeekS(*tmpstr)))
                ClientInfo()\Host = Host.s
              EndIf
            EndIf
            FreeMemory(*tmpstr)
            FreeMemory(*ReceiveBuffer)
          EndIf
          
        Case 4
          ResetList(ClientInfo())
          While NextElement(ClientInfo()) 
            If ClientInfo()\ClientID = ClientID.l
              DeleteElement(ClientInfo())
              Break
            EndIf
          Wend 
      EndSelect
    EndIf
  
    ;- Kontrolliere ob was vom Webserver kommt. 
    ResetList(ClientInfo())
    While NextElement(ClientInfo())
        
      If ClientInfo()\WebserverID <> 0  
        CEvent.l = NetworkClientEvent(ClientInfo()\WebserverID)
        
        Select CEvent
          Case 2
            *ReceiveBuffer = AllocateMemory(61440)
            ReceiveNetworkData(ClientInfo()\WebserverID, *ReceiveBuffer, 61440) ; Maximal 60KByte abholen
            Debug "==================== Empfangen vom WebServer Anfang ======================"
            Debug PeekS(*ReceiveBuffer)
            Debug "==================== Empfangen vom Webserver Ende ======================"
            SendNetworkData(ClientInfo()\ClientID, *ReceiveBuffer, Len(PeekS(*ReceiveBuffer)))
            FreeMemory(*ReceiveBuffer)
        EndSelect
      EndIf
    Wend
    
  Until Quit = 1 
  
EndIf

End

Procedure.s CreateServerMessage(Title.s, Head.s, Text.s)

  Message.s = ""
  HTTPHeader.s = ""
  Tag.s = ""
  Monat.s = ""

  ; Tag einstellen
  Select DayOfWeek(Date()) 
    Case 0
      Tag = ";Sun"
    Case 1
      Tag.s = ";Mon"
    Case 2
      Tag.s = ";Tue"
    Case 3
      Tag.s = ";Wed"
    Case 4
      Tag.s = ";Thu"
    Case 5
      Tag.s = ";Fri"
    Case 6
      Tag.s = ";Sat"
  EndSelect
  
  Select Month(Date()) 
    Case 1
      MonthName.s = "Jan"
    Case 2
      MonthName.s = "Feb"
    Case 3
      MonthName.s = "Mrz"
    Case 4
      MonthName.s = "Apr"
    Case 5
      MonthName.s = "Mai"
    Case 6
      MonthName.s = "Jun"
    Case 7
      MonthName.s = "Jul"
    Case 8
      MonthName.s = "Aug"
    Case 9
      MonthName.s = "Sep"
    Case 10
      MonthName.s = "Okt"
    Case 11
      MonthName.s = "Nov"
    Case 12
      MonthName.s = "Dez"
  EndSelect
         
  ; Die Nachricht aus den Parametern im HTML-Format erstellen
  Message.s = "<html>" + Chr(13)+Chr(10)+ "<head><title>" + Title.s + "</title></head>" + Chr(13)+Chr(10)+ "<body>" + Chr(13)+Chr(10)+ "<br><br><h1>" + Head.s + "</h1>" + "<br><br><br>" + Chr(13)+Chr(10)+ Text.s + Chr(13)+Chr(10)+ "<br><br><br><i>by(e) proxy...</i>" + Chr(13)+Chr(10)+ "</body>" + Chr(13)+Chr(10)+ "</html>"
  
  ; Und den HTTPHeader, der die Einleitung für die Nachricht gibt
  HTTPHeader.s = "HTTP/1.1 OK" + Chr(13)+Chr(10)+ "Date: " + Tag.s + ", " + Str(DayOfWeek(Date())+1) + " " + MonthName.s + " " + Str(FormatDate("%yyyy %hh:&ii:&ss", Date())) + Chr(13)+Chr(10)+ "Accept-Ranges: bytes" + Chr(13)+Chr(10)+ "Content-Length: " + Str(Len(Message.s)) + Chr(13)+Chr(10)+ "Connection: Keep-Alive" + Chr(13)+Chr(10)+ "Content-Type: text/html" + Chr(13)+Chr(10)+ Chr(13)+Chr(10)
  
  ProcedureReturn (HTTPHeader.s + Message.s)
EndProcedure


CatchError:
Msg$ = "There was an error:"+Chr(13)+Chr(10)+Chr(13)+Chr(10)
Msg$ + "Description: " + GetErrorDescription()+Chr(13)+Chr(10)
Msg$ + "Total number of errors: "+Str(GetErrorCounter())+Chr(13)+Chr(10)
Msg$ + "Error in linenr: "+Str(GetErrorLineNR())+Chr(13)+Chr(10)+Chr(13)+Chr(10)
Msg$ + "The program will end now."

MessageRequester("Error!", Msg$)

; Now end the program, because we can't jump back after OnErrorGoto()
End

Gruß,
Torakas

bluejoke · Beitrag von **bluejoke** » 22.02.2005 17:37

Was kommte denn für eine Fehlermedlung?
Oder funzt alles und nur der Browser zeigts nicht richtig an?

Im letzten Fall könnt ich mir vorstellen, das der Header für das Bild nicht korrekt ist.

stbi · Beitrag von **stbi** » 23.02.2005 17:48

Ohne den Code jetzt genau analysiert zu haben ist mir aufgefallen, dass Du in CreateServerMessage() im Header ein

Content-Type: text/html"

zurückgibst ... das stimmt für Bilder oder andere Binärdateien latürnich nicht. Reich doch einfach durch, was Du vom Zielserver als Antwort bekommen hast!

Torakas · Beitrag von **Torakas** » 24.02.2005 00:29

stbi hat geschrieben:Ohne den Code jetzt genau analysiert zu haben ist mir aufgefallen, dass Du in CreateServerMessage() im Header ein
Content-Type: text/html"
zurückgibst ... das stimmt für Bilder oder andere Binärdateien latürnich nicht. Reich doch einfach durch, was Du vom Zielserver als Antwort bekommen hast!

Das ist nicht der Fehler gewesen. Ich hab jetzt den Headerteil so umgeschrieben das er alles unbekannt direkt so durchreicht wie er es bekommen hat. Desweitern habe ich noch gesehen das er den Body sage ich mal rüberschickt. z.B. POST informationen die an den Server gehen sollten. Dies habe ich auch reingebaut aber das brachte auch keinen Erfolg.

Aber wie man oben sehen kann arbeite ich mit reservierten Speicheradressen und genau da liegt der knackpunkt. Warum auch immer.

Ich habe jetzt mal diese teile durch z.B.

Code: Alles auswählen

tmppuffer.s = Space(61440)
laenge.l = 0
laenge.l = ReceiveNetworkData(ClientInfo()\WebserverID, tmppuffer.s, 61440)  ; Maximal 60KByte abholen

Und siehe da, er frisst es besser. Er laed die kompletten Bilder vom Server und gibt sie an den Client weiter. Trotzdem bliebt er hin und wieder haengen und laed nicht mehr weiter.

Eine neue Version werde ich morgen oder so mal posten. Dann koennt ihr mal schauen und vielleicht habt ihr eine Idee woran es liegen koennte.

Achja, ich sehe das als Bug das ich die Information nicht in eine Speicheradresse laden kann und dort wieder auslesen kann. Dies klappt auch nicht wenn ich sage welche laenge das ausgelesene hatte. Ich bekomme trotzdem nur einen Teil davon wieder.

Gruß,
Torakas

ps. Dieser Beitrag wurde über meinem Proxy als Test geschrieben und funkt soweit gut

stbi · Beitrag von **stbi** » 24.02.2005 10:44

ok, die Länge der zurückgelieferten Daten mit PeekS() festzustellen konnte nicht funktionieren, aber so wie Du es jetzt hast, ist es korrekt. Du hättest auch den allokierten Buffer drinlassen können, das war schon ok so, muss man nicht mit space() machen, aber letztendlich ist es wurscht.

Wenn Du den Code überarbeitet hast, schaue ich es mir nochmal an (und diesmal genauer

).

Torakas · Beitrag von **Torakas** » 24.02.2005 14:04

stbi hat geschrieben:ok, die Länge der zurückgelieferten Daten mit PeekS() festzustellen konnte nicht funktionieren, aber so wie Du es jetzt hast, ist es korrekt. Du hättest auch den allokierten Buffer drinlassen können, das war schon ok so, muss man nicht mit space() machen, aber letztendlich ist es wurscht.

Wenn Du den Code überarbeitet hast, schaue ich es mir nochmal an (und diesmal genauer ).

das mit dem allokierten Buffer hat nicht geklappt auch wenn ich ihm beim auslesen mit PeekS gesagt hab wielang der String ist. Da hat er bei einer Laenge von sagen wir mal 1024 nur 20 Zeichen ausgeben oder so. Den Rest hat er einfach verworfen obwohl ich im gesagt hab das er mir 1024 Zeichen aus dem Speicher geben soll.

Ich muss den Programmcode noch bissel aendern da ich noch funktionen drinne hab die nichts im Listing zu suchen haben... Daher weiss ich noch nicht wann genau ich es schaffe dies zu posten. Muss noch ein IRCBot umbauen auf nonWindows Funktion in einem Bereich und dann kann ich das andere Posten.

Gruß,
Torakas

uweb · Beitrag von **uweb** » 13.12.2005 20:40

Hallo,

da sich hier nichts mehr getan hat und das Thema mich aber interessiert habe ich einfach selbst weiter gemacht.
Ich hoffe Torakas verzeiht mir. Es dürfte klar sein, daß sein Anteil an diesem Teilerfolg maßgeblich ist.

Das Problem war, wenn ich mich recht erinnere, daß Bilder Bytes mit dem Wert 0 enthalten können und Strings damit enden.

Allerdings läuft es bei mir auch nicht ganz rund.

Auf den ersten Blick funktiert es zwar aber der Fortschrittsbalken im Browser kommt nie rechts an.
Merkwürdig finde ich auch das ReceiveLaenge und SendLaenge zwar immer gleich groß sind aber bei mehrfachem Aufruf von z.B. Google z.T. unterschiedlich groß sind.

Ich bin für jede Hilfe dankbar !

Uwe

PS:
Wer es genau wissen will sollte

MyDebug:
Return

löschen und xMyDebug: durch MyDebug: ersetzen.

PPS:
Der Grund weshalb ich einiges etwas umständlich aufwendig mache ist der, daß ich mir gewisse Strukturen anzugewöhnen will, weil ich es sonst bei größeren Programmen sehr schnell sehr schwer habe. An den Regeln für die Strukturen arbeite ich noch.

Code: Alles auswählen

;- Enumeration, Dim, NewList
Enumeration;Gadgets
 #cmdQuit 
EndEnumeration 

Enumeration;Fehler
 #InitNetwork
 #CreateNetworkServer
EndEnumeration 

Structure Fehlerstruktur
    Titel.s
    Text.s 
EndStructure

Dim Fehler.Fehlerstruktur(100)

Structure ClientInformation 
 WebserverID.l 
 ClientID.l 
 Host.s 
EndStructure

NewList ClientInfo.ClientInformation() 
NewList WebserverIDtoClientID.l() 


;- Variablen und Konstanten

ControlledCancelb.b 
ToSendRequest.b 

*ReceiveBuffer = AllocateMemory(61440) 
*tmpstr = AllocateMemory(61440) 

laenge.l = 0 

Port = 6832


Procedure InitFehler() 

 Fehler(InitNetwork)\Titel = "Netzwerk-Fehler"
 Fehler(InitNetwork)\Text  = "Netzwerk konnte nicht initialisiert werden !"

 Fehler(CreateNetworkServer)\Titel = "Proxy-Fehler"
 Fehler(CreateNetworkServer)\Text  = "Proxy konnte nicht erstellt werden !"

EndProcedure;InitFehler()
  

Procedure Fehlermeldung(Nummer) 
 MessageRequester(Fehler(Nummer)\Titel, Fehler(Nummer)\Text, 0)
EndProcedure;Fehlermeldung()


Procedure cmdQuit_Click() 
;...
End 
EndProcedure;cmdQuit_Click()

Procedure InitFenster()
 
 If OpenWindow(0,0,0,230,90,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Beispiel...")

  If CreateGadgetList(WindowID())
   ButtonGadget  (#cmdQuit, 10, 10,200, 20, "Good By !")
  EndIf;CreateGadgetList

  If CreateMenu(0, WindowID())
   MenuTitle("Menu")
    MenuItem(1, "Eintrag 1")
    MenuItem(2, "Eintrag 2")
    MenuItem(3, "Eintrag 3")
  EndIf;CreateMenu

 Else;OpenWindow
  End
 EndIf;OpenWindow

EndProcedure;InitFenster()  






Procedure.s CreateServerMessage(Title.s, Head.s, Text.s) 

 Message.s = "" 
 HTTPHeader.s = "" 
 Tag.s = "" 
 Monat.s = "" 

 ; Tag einstellen 
 Select DayOfWeek(Date()) 
  Case 0 
   Tag = ";Sun" 
  Case 1 
   Tag.s = ";Mon" 
  Case 2 
   Tag.s = ";Tue" 
  Case 3 
   Tag.s = ";Wed" 
  Case 4 
   Tag.s = ";Thu" 
  Case 5 
   Tag.s = ";Fri" 
  Case 6 
   Tag.s = ";Sat" 
 EndSelect 
 
 Select Month(Date()) 
  Case 1 
   MonthName.s = "Jan" 
  Case 2 
   MonthName.s = "Feb" 
  Case 3 
   MonthName.s = "Mrz" 
  Case 4 
   MonthName.s = "Apr" 
  Case 5 
   MonthName.s = "Mai" 
  Case 6 
   MonthName.s = "Jun" 
  Case 7 
   MonthName.s = "Jul" 
  Case 8 
   MonthName.s = "Aug" 
  Case 9 
   MonthName.s = "Sep" 
  Case 10 
   MonthName.s = "Okt" 
  Case 11 
   MonthName.s = "Nov" 
  Case 12 
   MonthName.s = "Dez" 
 EndSelect 
     
 ; Die Nachricht aus den Parametern im HTML-Format erstellen 
 Message.s = "<html>" + Chr(13)+Chr(10)+ "<head><title>" + Title.s + "</title></head>" + Chr(13)+Chr(10)+ "<body>" + Chr(13)+Chr(10)+ "<br><br><h1>" + Head.s + "</h1>" + "<br><br><br>" + Chr(13)+Chr(10)+ Text.s + Chr(13)+Chr(10)+ "<br><br><br><i>by(e) proxy...</ i>" + Chr(13)+Chr(10)+ "</body>" + Chr(13)+Chr(10)+ "</html>" 
 
 ; Und den HTTPHeader, der die Einleitung für die Nachricht gibt 
 HTTPHeader.s = "HTTP/1.1 OK" + Chr(13)+Chr(10)+ "Date: " + Tag.s + ", " + Str(DayOfWeek(Date())+1) + " " + MonthName.s + " " + Str(FormatDate("%yyyy %hh:&ii:&ss", Date())) + Chr(13)+Chr(10)+ "Accept-Ranges: bytes" + Chr(13)+Chr(10)+ "Content-Length: " + Str(Len(Message.s)) + Chr(13)+Chr(10)+ "Connection: Keep-Alive" + Chr(13)+Chr(10)+ "Content- Type: text/html" + Chr(13)+Chr(10)+ Chr(13)+Chr(10) 
 
 ProcedureReturn (HTTPHeader.s + Message.s) 
EndProcedure;CreateServerMessage()

;- Main

OnErrorGoto(?CatchError)

If InitNetwork() = 0 
 Fehlermeldung(#InitNetwork) 
 End 
EndIf;InitNetwork() = 0

If CreateNetworkServer(Port) = 0
 MessageRequester("Netzwerk-Fehler", "Netzwerk konnte nicht initialisiert werden !", 0) 
 MessageRequester(Fehler(#CreateNetworkServer)\Titel, Fehler(#CreateNetworkServer)\Text, 0)
 Fehlermeldung(#CreateNetworkServer)
 End
EndIf;CreateNetworkServer() = 0

InitFenster()

Repeat
  
 Gosub Proxy
 
 WEvent = WindowEvent()

 Select WEvent 
  
  Case #PB_Event_Gadget 
   Select EventGadgetID() 
    Case #cmdQuit : cmdQuit_Click()   
   EndSelect 
     
 EndSelect 

;Until Quit = 1 
Until WEvent = #PB_Event_CloseWindow 
MessageRequester("Ende", "Until EventID = #PB_Event_CloseWindow - erreicht", 0) 
;- Speicher muß noch freigegeben werden
End  
 
;- *Proxy
Proxy:

 SEvent.l = NetworkServerEvent() 
;  0 : Nichts ist passiert
;  1 : Ein neuer Client wurde mit dem Server verbunden
;  2 : Roh-Daten wurden empfangen (können mittels ReceiveNetworkData() gelesen werden)
;  3 : Eine Datei wurde empfangen (kann mittels ReceiveNetworkFile() gelesen werden)
;  4 : Ein Client hat den Server verlassen (Verbindungstrennung)

 If SEvent 
  
  ClientID.l = NetworkClientID() 
  
  Select SEvent 
   
   Case 1 
    AddElement(ClientInfo()) 
    ClientInfo()\ClientID = ClientID.l 

   Case 2
    Gosub ServerRohDatenVerarbeiten
    
   Case 3
;-  ServerDateiVerarbeiten existiert noch nicht

   Case 4 
    ResetList(ClientInfo()) 
    While NextElement(ClientInfo()) 
     If ClientInfo()\ClientID = ClientID.l 
      DeleteElement(ClientInfo()) 
      Break 
     EndIf 
    Wend 
    
  EndSelect;SEvent 

 EndIf;SEvent
  
   
 ;--- Kontrolliere ob was vom Webserver kommt. 
 ResetList(ClientInfo()) 
 While NextElement(ClientInfo()) 
    
  If ClientInfo()\WebserverID <> 0 
   CEvent.l = NetworkClientEvent(ClientInfo()\WebserverID) 
;    0 : Nichts ist passiert
;    2 : Roh-Daten wurden empfangen (können mittels ReceiveNetworkData() gelesen werden)
;    3 : Eine Datei wurde empfangen (kann mittels ReceiveNetworkFile() gelesen werden)

   Select CEvent 

    Case 2
     *ReceiveBuffer = AllocateMemory(61440)
     ReceiveLaenge.l = ReceiveNetworkData(ClientInfo()\WebserverID, *ReceiveBuffer, 61440) ; Maximal 60KByte abholen 

     Debug "==================== Empfangen vom WebServer :" 
     Gosub MyDebug:

     SendLaenge=SendNetworkData(ClientInfo()\ClientID, *ReceiveBuffer, ReceiveLaenge)
     Debug "==================== und gesendet an Client :"     
     Debug "SendLaenge = " + Str(SendLaenge) + " und ReceiveLaenge = " + Str(ReceiveLaenge)
     If ReceiveLaenge <> SendLaenge
      MessageRequester("Error", "Fehler bei SendNetworkData() an Client", 0)
     EndIf
     FreeMemory(*ReceiveBuffer)

    Case 3
;-    ClientDateiVerarbeiten existiert noch nicht

   EndSelect;CEvent

  EndIf;ClientInfo()\WebserverID <> 0 
 
 Wend;NextElement(ClientInfo())
  
Return



;- *RohDatenVerarbeiten
ServerRohDatenVerarbeiten:

 Source.s = "" 
 url.s = "" 
 Rest.s = "" 
 n.l = 0 
 i.l = 0 
 HTTPVersion.s = "" 
 Filepath.s = "" 
 FileTypes.s = "" 
 UserAgent.s = "" 
 Language.s = "" 
 Charset.s = "" 
 Encoding.s = "" 
 Connection.s = "" 
 Referer.s = "" 
 Command.s = "" 
 cookie.s = "" 
 Host.s = "" 
 Request.s = "" 
 d.s = "" 
 
 ResetList(ClientInfo()) 
 While NextElement(ClientInfo()) 
  If ClientInfo()\ClientID = ClientID.l 
   Break 
  EndIf 
 Wend 
 *ReceiveBuffer = AllocateMemory(61440) 
 ReceiveLaenge.l = ReceiveNetworkData(ClientID.l, *ReceiveBuffer, 61440) ; Maximal 60KByte abholen 

  Debug "==================== Empfangen vom ClientServer :"
  Gosub MyDebug:
    


; UB : gehe zunächst mal von Text (.s) aus
 
 d.s = PeekS(*ReceiveBuffer) 
 Buffer.s = d.s 
 Buffer.s = LCase(Buffer) 
 
 ;--- Ob es ein Kommando ist, das modifiziert werden muss, oder nicht 
 If Left(Buffer.s, 3) <> "get" Or Left(Buffer.s, 4) = "post" 
  If ClientInfo()\WebserverID <> 0 
   SendNetworkData(ClientInfo()\WebserverID, *ReceiveBuffer, Len(PeekS(*ReceiveBuffer))) ; d.s) 
  EndIf 
 Else   

  Source.s = d.s 
     
  n.l = FindString(Source.s, Chr(13)+Chr(10), 0) 
  Request.s = Right(Source.s, Len(Source.s) - (n.l + 1)) 
  Command.s = Left(Source.s, n.l - 1) 
    
  If Left(Command.s, 3) = "GET" 
   ;--- wenn der Browser Daten will 
   n.l      = FindString(Command.s, " HTTP/", 0) 
   url.s     = Mid(Command.s, 5, Len(Command.s) - 4 - 9) 
   HTTPVersion.s = (Right(Command.s, 8) + Chr(13)+Chr(10)) 
   Buffer.s   = Right(url.s, Len(url.s) - 7) 
   Host.s    = Left(Buffer.s, FindString(Buffer.s, "/", 0) - 1) 
   Filepath.s  = Right(Buffer.s, Len(Buffer.s) - Len(Host.s)) 
   If FindString(Host.s, ":", 0) > 0 
    Port.l = Val(Mid(Host.s, FindString(Host.s, ":", 0) + 1, Len(Host.s))) 
    Host.s = Left(Host.s, FindString(Host.s, ":", 0) - 1) 
   Else 
    Port.l = 80 
   EndIf 
   
   ; Kommando einstellen 
   Command.s   = "GET" 
   
  ElseIf Left(Command.s, 4) = "POST" 
   ;--- wenn der Browser Daten schicken will 
   n.l      = FindString(Command.s, " HTTP/", 0) 
   url.s     = Mid(Command.s, 6, Len(Command.s) - 5 - 9) 
   HTTPVersion.s = (Right(Command.s, 8) + Chr(13)+Chr(10)) 
   Buffer.s   = Right(url.s, Len(url.s) - 7) 
   Host.s    = Left(Buffer.s, FindString(Buffer.s, "/", 0) - 1) 
   Filepath.s  = Right(Buffer.s, Len(Buffer.s) - Len(Host.s)) 
   If FindString(Host.s, ":", 0) > 0 
    Port.l = Val(Mid(Host.s, FindString(Host.s, ":", 0) + 1, Len(Host.s))) 
    Host.s = Left(Host.s, FindString(Host.s, ":", 0) - 1) 
   Else 
    Port.l = 80 
   EndIf 
   
   ; Kommando einstellen 
   Command.s   = "POST" 
  EndIf 
       
  ;--- Den Rest des HTTP-Requests aufspalten und die Informationen auswerten 
  Repeat 
   ; Solange wiederholen, Bis Request keine Zeilenumbrüche 
   ; mehr enthält 
   n.l = FindString(Request.s, Chr(13)+Chr(10), 0) 
   If n.l <> 0 
    Buffer.s = Left(Request.s, n.l - 1) 
    Request.s = Right(Request.s, Len(Request.s) - (n.l + 1)) 
    ; Buffer.s = Right(Buffer.s, Len(Buffer.s) - 1) 
    
    If Left(Buffer.s, 7) = "Accept:" 
     ;--- Die Datei-(MIME-)Typen, die der Browser akzeptiert 
     FileTypes.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 16) = "Accept-Language:" 
     ;--- Die Sprache, Die neben Englisch noch akzeptiert wird 
     Language.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 16) = "Accept-Encoding:" 
     ;--- Die Codierungen, Die akzeptiert werden 
     Encoding.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 8) = "Referer:" 
     ;--- Der Referer (über welchen Link man die Seite aufgerufen hat) 
     Referer.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 11) = "User-Agent:" 
     ; Der Browser-Typ 
     UserAgent.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 7) = "Cookie:" 
     ; Der Browser-Typ 
     cookie.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 5) = "Host:" 
     ; Der Browser-Typ 
     Host2.s = (Buffer.s + Chr(13)+Chr(10)) 
    ElseIf Left(Buffer.s, 17) = "Proxy-Connection:" 
     ; Ganz wichtig, Connection muss auf "Keep-Alive" stehen 
     Connection.s = ("Connection:" + Right(Buffer.s, Len(Buffer.s) - 17) + Chr(13)+Chr(10) + Chr(13)+Chr(10)) 
    EndIf 
   Else 
    Break 
   EndIf 
  ForEver 
     
  If HiddeReferer.l = 1 
   ; Referer austauschen (Verschleierung der Herkunft) 
   Referer.s = ("Referer: " + "www.google.de" + Chr(13)+Chr(10)) ; Zum Beispiel 
  EndIf 
  *tmpstr = AllocateMemory(61440) 
  ; http-Request zusammensetzen 
  Request.s = Command.s + " " + Filepath.s + " " + HTTPVersion.s + FileTypes.s + Encoding.s + Referer.s + Language.s + cookie.s + UserAgent.s + Host2.s + Connection.s 
 
  ; Wenn der Host immer noch der Gleiche und man noch immer mit ihm verbunden ist 
  If Host = ClientInfo()\Host And ClientInfo()\WebserverID <> 0 
   PokeS(*tmpstr, Request.s) 
   SendNetworkData(ClientInfo()\WebserverID, *tmpstr, Len(PeekS(*tmpstr))) 
  Else 
   If ClientInfo()\WebserverID <> 0 
    CloseNetworkConnection(ClientInfo()\WebserverID) 
   EndIf 
   ; Wenn der Webserver nicht erreichbar ist 
   ClientInfo()\WebserverID = OpenNetworkConnection(Host.s, Port.l) 
   
   If ClientInfo()\WebserverID = 0 
    ;--- Fehlernachricht an den Client senden 
    Buffer.s = CreateServerMessage(Host.s + " nicht erreichbar", Host.s + " nicht erreichbar.", "Der Remote-Computer " + Host.s + " ist nicht erreichbar. Stellen Sie sicher dass Sie mit dem Internet verbunden sind und dass der Remotehost online ist. Bitte nutzen Sie diesen Server nur als HTTP-Proxy.") 
    PokeS(*tmpstr, Buffer.s) 
    SendNetworkData(ClientInfo()\WebserverID, *tmpstr, Len(PeekS(*tmpstr))) 
   Else 
    PokeS(*tmpstr, Request.s) 
    SendNetworkData(ClientInfo()\WebserverID, *tmpstr, Len(PeekS(*tmpstr))) 
    ClientInfo()\Host = Host.s 
   EndIf 
  EndIf 
  FreeMemory(*tmpstr) 
  FreeMemory(*ReceiveBuffer) 
 EndIf 
Return


;- Fehlerbehandlung

xMyDebug:
  If Len(PeekS(*ReceiveBuffer)) = ReceiveLaenge
   Debug PeekS(*ReceiveBuffer) 
  Else
   For k = 0 To ReceiveLaenge
    B = PeekB(*ReceiveBuffer+k)
    Debug "Byte " + RSet(Str(k),5,"0") + ":   " + RSet(Hex(B),2,"0") + "  " + RSet(StrU(B, #Byte),3,"0") + "  " + Str(B)
   Next
  EndIf
Return

MyDebug:
Return


CatchError: 
Msg$ = "There was an error:"+Chr(13)+Chr(10)+Chr(13)+Chr(10) 
Msg$ + "Description: " + GetErrorDescription()+Chr(13)+Chr(10) 
Msg$ + "Total number of errors: "+Str(GetErrorCounter())+Chr(13)+Chr(10) 
Msg$ + "Error in linenr: "+Str(GetErrorLineNR())+Chr(13)+Chr(10)+Chr(13)+Chr(10) 
Msg$ + "The program will end now." 

MessageRequester("Error!", Msg$) 

; Now end the program, because we can't jump back after OnErrorGoto() 
End

edit :

Sorry für das Chaos im Code. Aber es ist eben eine Baustelle.
Es wäre nett, wenn sich trotzdem jemand die Mühe machen würde.
BITTE !!!

In meiner Fehlerbehandlung steckt übrigens auch noch ein Bug. Bei

Code: Alles auswählen

If CreateNetworkServer(Port) = 0
 MessageRequester("Netzwerk-Fehler", "Netzwerk konnte nicht initialisiert werden !", 0)
 MessageRequester(Fehler(#CreateNetworkServer)\Titel, Fehler(#CreateNetworkServer)\Text, 0)
 Fehlermeldung(#CreateNetworkServer)
 End
EndIf;CreateNetworkServer() = 0

funktiert nur die erste Fehlermeldung.