Observateur de dialogue client-serveur HTTP

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Observateur de dialogue client-serveur HTTP

Message par djes »

~ Observateur de dialogue client-serveur HTTP ~

Realtime HTTP client-server spotter

Suite au sujet de falsam sur la mise à jour unicode de l'atomic web server (voir http://www.purebasic.fr/french/viewtopi ... =6&t=16482), j'ai commencé à retravailler un vieux code de serveur web pour voir en direct le dialogue entre un serveur et un navigateur.

Vous avez donc à gauche la partie serveur, à droite la partie navigateur, et vous pouvez observer en direct le dialogue entre les deux, dont les fameux "headers" (entêtes) qui sont habituellement cachés aux internautes.
Par défaut, le serveur affiche la page index.html incluse dans les exemples de PureBasic pour l'Atomic Web Server. Cela peut se changer avec les gadgets en haut et bien sûr dans le source.

A noter qu'une fois le programme lancé, il est possible d'utiliser un autre navigateur local (tel que chrome) sur l'adresse http://localhost:8080 (port par défaut), ce qui vous permet de voir les autres types d'entête des autres navigateurs.

Attention, ce code n'est pas exempt de bugs.

A noter également que le serveur inclus est un véritable serveur http multithread, avec gestion des fichiers, même s'il ne prend en charge qu'un petit ensemble de commandes. Pour aller plus loin, faire une recherche sur le forum sur les serveurs faits en PB (dont simple webserver ++ de falsam), et sur la bibliothèque HTTP de DarkPlayer, entre autres

Version 1 (14/02/2017) : serveur et client fonctionnels
Version 1.1 (01/01/2019) : petit nettoyage de code et nouvelle fonction HexToDec par ollivier

Code : Tout sélectionner

; ****************************************************************************
;
; Realtime HTTP client-server spotter ; HTTP server demo
; (c)djes 2017
;
; ~ENGLISH
; Displays a realtime HTTP client/server dialog
; Left side shows incoming and outcoming strings from integrated server
; Right side is the client, a navigator who interprets pages.
;
; You have to give the path to your HTML files (index.html by default)
;
; ~FRENCH
; Affiche un dialogue HTTP client/serveur en temps réel
; Le côté gauche affiche les chaînes entrantes et sortantes du serveur intégré
; Le côté droit est le client (un navigateur) qui interprête les pages.
;
; Vous devez spécifier le chemin de vos fichiers HTML (index.html par défaut)
;
;TODO : realtime requests editing and uploading
;
; ****************************************************************************

EnableExplicit

Enumeration
  #WEBGADGET
  #BUTTON_BACKWARD
  #BUTTON_FORWARD
  #BUTTON_HOME
  #BUTTON_PRINT
  #BUTTON_SEARCH
  #BUTTON_QUIT
  #STRING_URL
  #STRING_SERVERBASEDIR
  #BUTTON_SERVERBASEPATHREQUEST
  #SCINTILLA_SERVERINPUTLOG
  #SCINTILLA_SERVEROUTPUTLOG
EndEnumeration

#ENTERKEY_EVENT = 15

#BS_FLAT = $8000 

#TH32CS_SNAPHEAPLIST = $1 
#TH32CS_SNAPPROCESS = $2 
#TH32CS_SNAPTHREAD = $4 
#TH32CS_SNAPMODULE = $8 
#TH32CS_SNAPALL = #TH32CS_SNAPHEAPLIST | #TH32CS_SNAPPROCESS | #TH32CS_SNAPTHREAD | #TH32CS_SNAPMODULE 
#TH32CS_INHERIT = $80000000 
#INVALID_HANDLE_VALUE = - 1 
#PROCESS32LIB = 9999 

#PACKET_SIZE = 524288

Structure SentFile
  ClientID.l
  Header$
  FileNumber.l
  FileLength.l
  *FileBuffer
  *HeaderOffset
EndStructure

; NOTE : I've chosen to add processes to this list so that it can be played with as necessary... 

Global NewList Process32.PROCESSENTRY32 () 

Global EOL$, hWnd
Global BaseDirectory$, StartPage$

EOL$ = Chr(13) + Chr(10)

; ****************************************************************************
; ; From code by 'PB'...
; ; (h$ can be 0 - FFFFFFF)
; 
; Procedure.i HexToDec (h$)
;   Define r.i, d.i, a$
;   If Left (h$, 1) = "%" : h$ = Right (h$, Len (h$) - 1) : EndIf
;   h$ = UCase (h$)
;   For r = 1 To Len (h$)
;     d = d << 4 : a$ = Mid (h$, r, 1)
;     If Asc (a$) > 60
;       d = d + Asc (a$) - 55
;     Else
;       d = d + Asc (a$) - 48
;     EndIf
;   Next
;   ProcedureReturn d
; EndProcedure 

Procedure.i HexToDec (h$)
  h$ = ReplaceString(h$, "%", "")
  ProcedureReturn Val("$" + h$)
EndProcedure

; ****************************************************************************

Procedure.s UnHexURL(url$)
  Define pos.i, hexx$, url$
  Repeat
    pos = FindString (url$, "%", 0)
    If pos
      hexx$ = Mid (url$, pos, 3)
      url$ = ReplaceString (url$, hexx$, Chr (HexToDec (hexx$)))
    EndIf
  Until pos = 0
  ProcedureReturn url$
EndProcedure

; ****************************************************************************

Procedure.s AlphaOnly(chaine$)
  Define d$ = "", i.i, c.i
  For i = 1 To Len(chaine$)
    c = Asc(Mid(chaine$, i, 1))
    ;convertit quelques accents
    If (c >= 192 And c <= 197) Or (c >= 224 And c <= 229) : c = Asc("a") : EndIf
    If c = Asc("Ç") Or c = Asc("ç") : c = Asc("c") : EndIf
    If (c >= $C8 And c <= $CB) Or (c >= $E8 And c <= $EB) : c = Asc("e") : EndIf
    If (c >= 204 And c <= 207) Or (c >= 236 And c <= 239) : c = Asc("i") : EndIf
    If (c >= 210 And c <= 214) Or (c >= 242 And c <= 246) : c = Asc("o") : EndIf
    If (c >= 217 And c <= 220) Or (c >= 249 And c <= 252) : c = Asc("u") : EndIf
    If (c >= 65 And c <= 90) Or (c >= 97 And c <= 122) : d$ = d$ + Chr(c) : EndIf ;ne garde que les caractères alpha
  Next
  ProcedureReturn d$
EndProcedure 

; ****************************************************************************

Procedure.s TransformSeparators(chaine$)
  Define d$ = "", i.i, c.i, d$
  For i = 1 To Len(chaine$)
    c = Asc(Mid(chaine$, i, 1))
    ;convertit les caractères spéciaux en séparateurs ( + )
    If (c >= 0 And c <= 36) Or (c >= 38 And c <= 42) Or (c >= 44 And c <= 47) Or (c >= 58 And c <= 64) Or (c >= 91 And c <= 96) Or (c >= 123 And c <= 191) : c = Asc(" + ") : EndIf
    d$ = d$ + Chr(c)
  Next
  ProcedureReturn d$
EndProcedure  

; ****************************************************************************

Procedure.i BuildRequestHeader( *Buffer, DataLength.l, ContentType$ )
  Define Length.i
  Length = PokeS( *Buffer, "HTTP/1.1 200 OK" + EOL$, -1, #PB_UTF8) : *Buffer + Length
  ;Length = PokeS( *Buffer, "Date : Wed, 07 Aug 1996 11 : 15 : 43 GMT" + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, "Server: DjesMiniServ" + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, "Content-Length: " + Str(DataLength) + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, "Content-Type: " + ContentType$ + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, EOL$, -1, #PB_UTF8) : *Buffer + Length
  
  ; Length = PokeS( *Buffer, "Last - modified : Thu, 27 Jun 1996 16 : 40 : 50 GMT" + Chr(13) + Chr(10) , *Buffer) : *Buffer + Length
  ; Length = PokeS( *Buffer, "Accept - Ranges : bytes" + EOL$ , *Buffer) : *Buffer + Length
  ; Length = PokeS( *Buffer, "Connection : close" + EOL$) : *Buffer + Length
  
  ProcedureReturn *Buffer
EndProcedure

; ****************************************************************************

Procedure.i BuildNotFoundHeader( *Buffer, DataLength.l )
  Define Length.i
  Length = PokeS( *Buffer, "HTTP/1.1 404 Not Found" + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, "Content-Type: text/html" + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, "Content-Length: " + Str(DataLength) + EOL$, -1, #PB_UTF8) : *Buffer + Length
  Length = PokeS( *Buffer, EOL$, -1, #PB_UTF8) : *Buffer + Length
  ProcedureReturn *Buffer
EndProcedure

; ****************************************************************************

Procedure FileSendingThread( *ThreadVariables.SentFile)
  Define nb.i, i.i
  Define ClientID.i = *ThreadVariables\ClientID
  Define FileNumber.i = *ThreadVariables\FileNumber
  Define FileLength.i = *ThreadVariables\FileLength
  Define *FileBuffer = *ThreadVariables\FileBuffer
  Define *HeaderOffset = *ThreadVariables\HeaderOffset
  ; Envoie d'abord l'entête HTTP (mieux pour les gros fichiers, ça évite de faire patienter le client)
  SendNetworkData(ClientID, *FileBuffer, *HeaderOffset - *FileBuffer)
  ; Envoie le fichier en parts de #PACKET_SIZE octets
  nb = FileLength / #PACKET_SIZE
  If nb > 0
    For i = 1 To nb
      ReadData(FileNumber, *HeaderOffset, #PACKET_SIZE)
      While SendNetworkData(ClientID, *HeaderOffset, #PACKET_SIZE) < #PACKET_SIZE
        Delay(100)
      Wend
    Next i
  EndIf
  ;reste
  i = FileLength%#PACKET_SIZE
  If i > 0
    ReadData(FileNumber, *HeaderOffset, i)
    While SendNetworkData(ClientID, *HeaderOffset, i) < i
      Delay(100)
    Wend
  EndIf
  CloseFile(FileNumber)
  FreeMemory(*ThreadVariables)
EndProcedure

; ****************************************************************************

Procedure NavigationCallback(Gadget, URL.s) 
  SetGadgetText(#STRING_URL, URL)
  ProcedureReturn #True
EndProcedure 

; ****************************************************************************

Procedure Navigator(x, y, w, h, URL.s)
  Define i.i, s.l
  ;If WebGadget(#WEBGADGET, 0, 0, ScreenWidth, ScreenHeight, "file://" + Index)
  If WebGadget(#WEBGADGET, x, y, w, h, URL)
    SetGadgetAttribute(#WEBGADGET, #PB_Web_NavigationCallback, @NavigationCallback())
    ButtonGadget(#BUTTON_BACKWARD, x + 1, 1, 40, 30, "Back")
    GadgetToolTip(#BUTTON_BACKWARD, "Page précédente")
    ButtonGadget(#BUTTON_FORWARD, x + 43, 1, 40, 30, "Forw")
    GadgetToolTip(#BUTTON_FORWARD, "Page suivante")
    ButtonGadget(#BUTTON_HOME, x + 85, 1, 40, 30, "Home")
    GadgetToolTip(#BUTTON_HOME, "Page d'accueil")
    ButtonGadget(#BUTTON_PRINT, x + 127, 1, 40, 30, "Print")
    GadgetToolTip(#BUTTON_PRINT, "Imprimer")
    ButtonGadget(#BUTTON_SEARCH, x + 170, 1, 64, 30, "Search")
    GadgetToolTip(#BUTTON_SEARCH, "Rechercher")
    ButtonGadget(#BUTTON_QUIT, x + w - 32, 1, 30, 30, "Quit")
    GadgetToolTip(#BUTTON_QUIT, "Quitter")
    StringGadget(#STRING_URL, x + 234, 8, 320, 16, URL)
    ;"Aplatit" les boutons
    For i = #BUTTON_BACKWARD To #BUTTON_QUIT
      s = GetWindowLong_(GadgetID(i), #GWL_STYLE) 
      SetWindowLong_(GadgetID(i), #GWL_STYLE, #BS_FLAT|s ) 
      HideGadget(i, 0) ; Need to redraw the gadget after changing it's style : ( 
    Next 
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

; ****************************************************************************

Procedure ServerGadgets(x, y, w, h)
  InitScintilla()
  ScintillaGadget(#SCINTILLA_SERVERINPUTLOG, x, y, w, h/2, 0)
  ScintillaGadget(#SCINTILLA_SERVEROUTPUTLOG, x, y + h / 2, w, h/2, 0)
  TextGadget( #PB_Any, x + 1, 1, 320, 16, "Server base directory")
  StringGadget(#STRING_SERVERBASEDIR, x + 1, 16, 320, 16, BaseDirectory$)
  ButtonGadget(#BUTTON_SERVERBASEPATHREQUEST, x + 321, 15, 18, 18, "...")
EndProcedure

; ****************************************************************************

Procedure ServerInputLog(Text.s)
  ScintillaSendMessage(#SCINTILLA_SERVERINPUTLOG, #SCI_APPENDTEXT, Len(Text), UTF8(Text))
EndProcedure

; ****************************************************************************

Procedure ServerOutputLog(Text.s)
  ScintillaSendMessage(#SCINTILLA_SERVEROUTPUTLOG, #SCI_APPENDTEXT, Len(Text), UTF8(Text))
EndProcedure

; ****************************************************************************

Procedure ServerSendString(ClientID, head$, body$)
  ServerOutputLog("- Header start" + EOL$)
  SendNetworkString(ClientID, head$)
  ServerOutputLog("- Header end" + EOL$)
  ServerOutputLog("- Content start" + EOL$)
  SendNetworkString(ClientID, body$)
  ServerOutputLog(body$ + EOL$)
  ServerOutputLog("- Content end" + EOL$)
EndProcedure

; ****************************************************************************
;
Procedure ServerSendFile(ClientID.i, File$) 
  Define *ThreadVariables.SentFile
  
  Define RequestedFile$ = UnHexURL(Right(File$, Len(File$) - 1)) ; Enlève un car à la chaîne et convertit les car spéciaux %
  Define DefaultPage$ = "index.html"
  
  Define ContentType$
  Define.i FileNumber, FileLength
  Define *FileBuffer, *HeaderOffset
  Define Error$
  
  If RequestedFile$ = ""
    RequestedFile$ = DefaultPage$
  Else
    RequestedFile$ = ReplaceString(RequestedFile$, "/", "\")
  EndIf
  
  ;Exemple de remplacement de fichier
  ; If Right(RequestedFile$, 11) = "function.js" 
  ;   BaseDirectory$ = "" 
  ;   RequestedFile$ = "fakefunction.js" 
  ; EndIf
  
  ;Exemple de commande serveur directe
  ; If Right(RequestedFile$, 4) = "Quit" 
  ;   End
  ; EndIf
  
  ;type MIME du fichier demandé
  Select LCase(GetExtensionPart(RequestedFile$))
    Case "gif"
      ContentType$ = "image/gif" 
    Case "zip"
      ContentType$ = "multipart/x-zip"
    Case "bmp"
      ContentType$ = "image/bmp"
    Case "png"
      ContentType$ = "image/png"
    Case "jpg"
      ContentType$ = "image/jpeg"
    Case "jpeg"
      ContentType$ = "image/jpeg"
    Case "tif"
      ContentType$ = "image/tif"
    Case "tiff"
      ContentType$ = "image/tif"
    Case "wav"
      ContentType$ = "audio/wav"
    Case "txt"
      ContentType$ = "text/plain"
    Case "doc"
      ContentType$ = "application/msword"
    Case "xls"
      ContentType$ = "application/vnd.ms-excel"
    Case "js"
      ContentType$ = "text/javascript"
    Case "zip"
      ContentType$ = "application/zip"
    Case "exe"
      ContentType$ = "application/octet-stream"
    Case "pdf"
      ContentType$ = "application/pdf"
    Case "mov"
      ContentType$ = "video/quicktime"
    Case "qt"
      ContentType$ = "video/quicktime"
    Case "avi"
      ContentType$ = "video/avi"
    Case "mpg"
      ContentType$ = "video/mpg"
    Case "mpeg"
      ContentType$ = "video/mpeg"
    Case "swf"
      ContentType$ = "application/x-shockwave-flash"
    Case "htm"
      ContentType$ = "text/html"
    Case "html"
      ContentType$ = "text/html"
    Default
      ContentType$ = "application/octet-stream"
  EndSelect
  
  ;Si le type est du genre à être accepté directement par le navigateur
  If ContentType$ <> "misc"
    ;Test if the file exists, and if not display the error message
    FileNumber + 1
    If ReadFile(FileNumber, BaseDirectory$ + RequestedFile$)
      ServerOutputLog("--- Sending " + BaseDirectory$ + RequestedFile$ + " file" + EOL$)
      FileLength = Lof(FileNumber)
      If FileLength > 0
        ; Réserve la mémoire puis crée un thread qui va s'occuper d'envoyer le fichier. Nous pouvons passer aux requêtes suivantes
        *FileBuffer = AllocateMemory(#PACKET_SIZE + 512) ; taille de l'header + taille d'un paquet
        If *FileBuffer <> 0
          *HeaderOffset = BuildRequestHeader( *FileBuffer, FileLength, ContentType$)
          ServerOutputLog("- Header start" + EOL$)
          ServerOutputLog(PeekS(*FileBuffer, *HeaderOffset - *FileBuffer, #PB_UTF8))
          ServerOutputLog("- Header end" + EOL$)
          *ThreadVariables = AllocateMemory(SizeOf(SentFile))
          *ThreadVariables\ClientID = ClientID
          *ThreadVariables\FileNumber = FileNumber
          *ThreadVariables\FileLength = FileLength
          *ThreadVariables\FileBuffer = *FileBuffer
          *ThreadVariables\HeaderOffset = *HeaderOffset
          ServerOutputLog("- Content to send : " + Str(FileLength) + " bytes" + EOL$)
          CreateThread(@FileSendingThread(), *ThreadVariables)
          ServerOutputLog("- Content sent (not shown here)" + EOL$)
        EndIf
      EndIf
    Else
      ServerOutputLog("--- ERROR 404 - File requested " + BaseDirectory$ + RequestedFile$ + " not found" + EOL$)
      ; Essaye de trouver le fichier 404.htm sinon envoie un message standard
      If ReadFile(0, BaseDirectory$ + "404.htm")
        FileLength = Lof(0)
        *FileBuffer = AllocateMemory(FileLength + 512)
        If *FileBuffer <> 0
          ServerOutputLog("--- Sending found 404.htm file" + EOL$)
          *HeaderOffset = BuildNotFoundHeader( *FileBuffer, FileLength)
          ServerOutputLog("- Header start" + EOL$)
          ServerOutputLog(PeekS(*FileBuffer, *HeaderOffset - *FileBuffer, #PB_UTF8))
          ServerOutputLog("- Header end" + EOL$)
          ReadData(0, *HeaderOffset, FileLength)
          CloseFile(0)
          ServerOutputLog("- Content to send : " + Str(FileLength) + " bytes" + EOL$)
          SendNetworkData(ClientID, *FileBuffer, *HeaderOffset - *FileBuffer + FileLength)
          ServerOutputLog("- Content sent (not shown here)" + EOL$)
          FreeMemory(*FileBuffer)
        EndIf
      Else
        ServerOutputLog("--- 404.htm error file not found" + EOL$)
        Error$ = "<HTML><BODY>File not found</BODY></HTML>" + EOL$
        *FileBuffer = AllocateMemory(Len(Error$) + 512)
        If *FileBuffer <> 0
          ServerOutputLog("--- Sending a minimal 404 error page" + EOL$)
          *HeaderOffset = BuildNotFoundHeader( *FileBuffer, Len(Error$))
          ServerOutputLog("- Header start" + EOL$)
          ServerOutputLog(PeekS(*FileBuffer, *HeaderOffset - *FileBuffer, #PB_UTF8))
          ServerOutputLog("- Header end" + EOL$)
          PokeS( *HeaderOffset, Error$, -1, #PB_UTF8|#PB_String_NoZero)        
          ServerOutputLog("- Content start" + EOL$)
          SendNetworkData(ClientID, *FileBuffer, *HeaderOffset - *FileBuffer + Len(Error$))
          ServerOutputLog(Error$ + EOL$ + "- Content end" + EOL$)
          FreeMemory(*FileBuffer)
        EndIf
      EndIf
    EndIf
    
  EndIf
EndProcedure

; ****************************************************************************

Procedure HandleIncomingRequest(ClientID.i, *IncomingRequestBuffer) 
  
  Define File$ = ""
  Define http$ = ""
  Define program$ = ""
  Define command$
  Define parameter$
  Define.i eop = 0, eoc = 0, deb = 0, fin, count, loc
  Define c$
  Define head$
  Define body$
  
  Define Incoming$ = PeekS( *IncomingRequestBuffer, -1, #PB_UTF8)
  
  ServerInputLog(Incoming$)
  
  If Incoming$ <> ""
    eoc = FindString(Incoming$, " ", 0) ; End of command part of Incoming$
    If eoc > 0
      command$ = LCase(Left (Incoming$, eoc)) ; Command part of Incoming$
      parameter$ = Mid(Incoming$, eoc + 1, Len(Incoming$) - eoc - 1) ; Parameter part of Incoming$
    EndIf
  EndIf
  
  Select command$
    Case "get "
      eop = FindString(parameter$, " ", 0) ; End of first parameter ("GET")
      If eop > 0
        File$ = Mid(parameter$, 1, eop - 1) ; First parameter ("/thisfile.txt")
        http$ = Mid(parameter$, eop + 1, Len(parameter$) - eop - 1) ; Second parameter 
      Else
        File$ = Mid(parameter$, eop + 1, Len(parameter$) - eop - 1) ; Second parameter 
      EndIf
    Case "post "
      eop = FindString(parameter$, " ", 0) ; End of first parameter ("POST")
      If eop > 0
        File$ = Mid(parameter$, 1, eop - 1) ; First parameter ("/thisfile.txt")
        http$ = Mid(parameter$, eop + 1, Len(parameter$) - eop - 1) ; Second parameter 
      Else
        File$ = Mid(parameter$, eop + 1, Len(parameter$) - eop - 1) ; Second parameter 
      EndIf
    Case "user-agent: "
      program$ = Mid(Incoming$, eoc + 1, Len(Incoming$) - eoc - 1)
  EndSelect
  
  ; Default page
  If File$ = "/" : File$ = "/" + StartPage$ : EndIf
  
  ;S'il n'y pas de fichier spécifié, il s'agit sans doute d'un autre type de requête
  
  If File$ <> "" Or http$ <> ""
    
    Dim words$(16)
    ;- extraction des mots envoyés par la page, ici, recherche du champ "text"
    deb = FindString(File$, "text=", 0)
    
    If deb <> 0
      fin = FindString(File$, "&", 0)
      If fin = 0 : fin = Len(File$) : EndIf ;si il n'y a pas de '&', c'est qu'il n'y a pas d'autres paramètres (on n'a pas appuyé sur le submit)"
      File$ = Mid(File$, deb + 5, fin - deb - 4)
      ;Debug File$
      
      ;nettoie la chaine pour la recherche
      File$ = TransformSeparators(LCase(UnHexURL(File$)))
      
      count = 0
      loc = FindString (File$, " + ", 0)
      While loc <> 0 And count<16
        c$ = AlphaOnly(Mid(File$, 1, loc - 1))
        If Len(c$)>1
          words$(count) = c$
        EndIf
        File$ = Right(File$, Len(File$) - loc)
        loc = FindString(File$, " + ", 0)
        count = count + 1
      Wend
      ;dernier mot
      If count < 16
        c$ = AlphaOnly(LCase(UnHexURL(File$)))
        words$(count) = c$
      EndIf
      
      ServerOutputLog("--- Search command" + EOL$)
      ;écrit l'en tête de la page de résultats
      head$ = "HTTP/1.1 200 OK" + EOL$
      head$ = head$ + "Server: DjesMiniserv" + EOL$
      ;contient la taille de la page à envoyer; sera modifié à la fin avec la taille réelle comprenant l'entête
      head$ = head$ + "Accept-Ranges: bytes" + EOL$
      ; SendNetworkString(ClientID, "Connection : close" + EOL$) ;pour les connexions non persistantes
      ; head$ = head$ + "Connection: close" + EOL$
      head$ = head$ + "Content-Type: text/html" + EOL$
      head$ = head$ + "Content-Length: *% *% *%" + EOL$
      head$ = head$ + EOL$
      body$ = "<html>" + EOL$
      body$ = body$ + EOL$
      body$ = body$ + "<head>" + EOL$
      body$ = body$ + "</head>" + EOL$
      body$ = body$ + "<body bgcolor=#003366 link=#AAAAFF vlink=#AAAAFF>" + EOL$
      body$ = body$ + "<FONT COLOR='#FFFFFF'><H3>R&eacute;sultat de la recherche</H3></FONT>"
      body$ = body$ + "</body>" + EOL$
      body$ = body$ + "</html>" + EOL$
      ;Debug Str(Len(body$))
      head$ = ReplaceString(head$, " *% *% *%", Str(Len(body$)))
      ;attention aux chaines de plus de 65535 cars!
      ServerSendString(ClientID, head$, body$)
    Else
      ;si il y a un fichier spécifié, va le chercher et l'envoie au client
      ServerSendFile(ClientID, File$)
    EndIf
  Else
    ServerOutputLog("--- Unknown command" + EOL$)
    head$ = "HTTP/1.1 200 OK" + EOL$
    head$ = head$ + "Server : DjesMiniserv" + EOL$
    head$ = head$ + "Accept - Ranges : bytes" + EOL$
    head$ = head$ + "Content - Length : *% *% *%" + EOL$
    head$ = head$ + "Content - Type : text/html" + EOL$
    head$ = head$ + EOL$
    body$ = "<html>" + EOL$
    body$ = body$ + EOL$
    body$ = body$ + "<head>" + EOL$
    body$ = body$ + "</head>" + EOL$
    body$ = body$ + "<body bgcolor = '#003366'>" + EOL$
    body$ = body$ + "<font color = '#FFFFFF'>Unknown command</font>" + EOL$
    body$ = body$ + "</body>" + EOL$
    body$ = body$ + "</html>" + EOL$
    head$ = ReplaceString(head$, " *% *% *%", Str(Len(body$)))
    ServerSendString(ClientID, head$, body$)
  EndIf
EndProcedure

; ****************************************************************************
;-*** START

If InitNetwork() = 0
  MessageRequester("Error", "Network functions can't be initialised.", 0)
  End
EndIf

;Chemin de notre programme
;Define ApplicationDirectory.s = GetPathPart(ProgramFilename()) : If Right(ApplicationDirectory, 1) <> "\" : ApplicationDirectory + "\" : EndIf

BaseDirectory$ = #PB_Compiler_Home + "Examples\Sources - Advanced\Atomic Web Server\WWW\"
StartPage$ = "index.html"

Define MyServerPort.w = 8080
Define BaseURL.s = "http://127.0.0.1:" + StrU(MyServerPort, #PB_Word) + "/"

Define Quit = 0

Define ScreenWidth.i = GetSystemMetrics_(#SM_CXSCREEN), ScreenHeight.i = GetSystemMetrics_(#SM_CYSCREEN)
Define MyWindowWidth.i = ScreenWidth * 0.75
Define MyWindowHeight.i = ScreenHeight * 0.75
Define hBrush.i

Define DefaultNavigatorName.s

Define Socket.i
Define.i WEvent, SEvent, ClientID
Define *IncomingRequestBuffer
Define Done.i
Define i.i
Define RequestLength.i
Define Error.l
Define Path$

*IncomingRequestBuffer = AllocateMemory(8192)
If *IncomingRequestBuffer = 0
  MessageRequester("Error", "Can't allocate 8192 bytes of memory.", 0)
  End
EndIf

Socket = CreateNetworkServer(0, MyServerPort, #PB_Network_TCP, "127.0.0.1")
If Socket
  
  hWnd.i = OpenWindow(0, 0, 0, MyWindowWidth, MyWindowHeight, "Realtime HTTP Spotter", #PB_Window_SystemMenu | #PB_Window_ScreenCentered )
  If hWnd
    
    ;     ;Couleur de fond
    ;     hBrush = CreateSolidBrush_(RGB(00, $33, $66)) 
    ;     SetClassLong_(hWnd, #GCL_HBRBACKGROUND, hBrush) 
    ;     InvalidateRect_(hWnd, #Null, #True)
    
    AddKeyboardShortcut(0, #PB_Shortcut_Return, #ENTERKEY_EVENT)
    
    ServerGadgets(0, 40, MyWindowWidth/2, MyWindowHeight)
    ServerInputLog("*** Server input log" + EOL$)
    ServerOutputLog("*** Server output log" + EOL$)
    ServerOutputLog("--- Server started" + EOL$)
    
    ;Différentes manips de la fenêtre
    ; SetWindowLong_(WindowID(), #GWL_EXSTYLE, #WS_EX_TOOLWINDOW) ; enlève l'icone de la barre des tâches (avec l'option invisible de la fenêtre)
    ; ShowWindow_(WindowID(), #SW_SHOW)
    ; BackWindow(WindowID())  ; met la fenêtre à l'arrière plan 
    
    ;Essaye de créer une fenêtre web
    If Navigator(MyWindowWidth/2, 40, MyWindowWidth/2, MyWindowHeight, BaseURL + StartPage$)
      DefaultNavigatorName = "WebGadget"
      ; Fred the genius stored the Interface pointer to IWebBrowser2 in the DATA 
      ; member of the windowstructure of the WEBGADGET containerwindow, so we can get 
      ; that easily : 
      ;récupère le pointeur du gadget
      ; WebObject.IWebBrowser2 = GetWindowLong_(GadgetID(#WEBGADGET), #GWL_USERDATA) 
    Else
      MessageRequester("Error", "Can't integrate a navigator window", 0)
      End
    EndIf
    
    ;Fait que les événements réseaux réveillent la fenêtre
    ; #FD_ALL = #FD_READ|#FD_WRITE|#FD_OOB|#FD_ACCEPT|#FD_CONNECT|#FD_CLOSE
    #FD_ALL = #FD_OOB|#FD_ACCEPT|#FD_CONNECT|#FD_CLOSE
    WSAAsyncSelect_(Socket, WindowID(0), #WM_NULL, #FD_ALL)
    
    Delay(2000)
    
    Repeat
      
      ;- Window events
      
      WEvent = WindowEvent()
      If WEvent = 0 : Delay(10) : EndIf
      
      If WEvent = #PB_Event_Gadget 
        Select EventGadget()
          Case #BUTTON_BACKWARD 
            SetGadgetState(#WEBGADGET, #PB_Web_Back)
            ;SetGadgetState(#WEBGADGET, #PB_Web_Refresh) 
          Case #BUTTON_FORWARD 
            SetGadgetState(#WEBGADGET, #PB_Web_Forward) 
            ;SetGadgetState(#WEBGADGET, #PB_Web_Refresh) 
          Case #BUTTON_HOME
            SetGadgetText(#WEBGADGET, "\") 
            ;SetGadgetState(#WEBGADGET, #PB_Web_Refresh) 
          Case #BUTTON_SEARCH
            SetGadgetText(#WEBGADGET, BaseURL + "search.htm") 
            ;SetGadgetState(#WEBGADGET, #PB_Web_Refresh) 
          Case #BUTTON_SERVERBASEPATHREQUEST
            Path$ = PathRequester("Please select the new server base directory", BaseDirectory$)
            If Path$
              BaseDirectory$ = Path$
              SetGadgetText(#STRING_SERVERBASEDIR, BaseDirectory$)
            EndIf
          Case #STRING_URL
            If EventType() = #PB_EventType_LostFocus
              SetGadgetText(#WEBGADGET, GetGadgetText(#STRING_URL))
            EndIf
          Case #BUTTON_QUIT
            Quit = 1 
        EndSelect
      EndIf
      
      ;Shortcuts and menu events (like enter key in a string gadget...)
      If WEvent = #PB_Event_Menu
        Select EventMenu()
          Case #ENTERKEY_EVENT
            If GetActiveGadget() = #STRING_URL
              SetGadgetText(#WEBGADGET, GetGadgetText(#STRING_URL))
            EndIf
            If GetActiveGadget() = #STRING_SERVERBASEDIR
              BaseDirectory$ = GetGadgetText(#STRING_SERVERBASEDIR)
            EndIf
        EndSelect
      EndIf
      
      ;- Server events
      
      SEvent = NetworkServerEvent()
      
      If SEvent
        ClientID = EventClient()
        
        Select SEvent
            
          ;New client
          Case #PB_NetworkEvent_Connect
            
          ;A client is leaving
          Case #PB_NetworkEvent_Disconnect
            ;CloseNetworkConnection(ClientID)
            
          ;Raw data has been received
          Case #PB_NetworkEvent_Data
            Done = #False   
            ; If done then close Socket, either gracefull or due to an error
            Repeat
              FillMemory(*IncomingRequestBuffer, 4096, 0, #PB_Integer)
              RequestLength = ReceiveNetworkData(ClientID, *IncomingRequestBuffer, 4096)
              If RequestLength > 0
                HandleIncomingRequest(ClientID, *IncomingRequestBuffer)
              ElseIf RequestLength = 0
                Done = #True
              Else
                Error = WSAGetLastError_()         
                If Error = #WSAEWOULDBLOCK                        
                  ; We are non-blocking so : no more data to read
                  Delay(100)
                  Done = #True                                          
                  ; So close the socket
                ElseIf Error <> 0
                  Done = #True 
                EndIf         
              EndIf
            Until Done = #True
        EndSelect
        
      EndIf
      
    Until WEvent = #PB_Event_CloseWindow Or Quit = 1
    
  Else
    MessageRequester("Error", "Can't open main window", 0)
  EndIf
  
  CloseNetworkServer(0)
  ServerOutputLog("--- Server stopped" + EOL$)
  
Else
  MessageRequester("Error", "Selected port is occupied. Try to close all servers and start again.", 0)
EndIf

End
Avatar de l’utilisateur
celtic88
Messages : 309
Inscription : sam. 12/sept./2015 14:31
Localisation : Alger

Re: Observateur de dialogue client-serveur HTTP

Message par celtic88 »

mmm ça donne des idées, merci maître :D
.....i Love Pb :)
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Observateur de dialogue client-serveur HTTP

Message par djes »

celtic88 a écrit :mmm ça donne des idées, merci maître :D
Merci, mais je ne suis qu'un humble bidouilleur :oops: :)
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Observateur de dialogue client-serveur HTTP

Message par Kwai chang caine »

Aaaaaah !!! ça s'appelle bidouiller ce que tu sais faire !!! 8O
Alors moi aussi, j'aimerais bien aussi savoir bidouiller :mrgreen:

Ca pourrait nous aider à comprendre ces requettes HTTP qui sont pas si simple que ça au final
Marche bien ici, merci pour le partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Observateur de dialogue client-serveur HTTP

Message par Ollivier »

@Djes

Je ne l'avais pas vu ce code.

Code : Tout sélectionner

Procedure.i HexToDec (h$)
Define r.i, d.i, a$
If Left (h$, 1) = "%" : h$ = Right (h$, Len (h$) - 1) : EndIf
h$ = UCase (h$)
For r = 1 To Len (h$)
d = d << 4 : a$ = Mid (h$, r, 1)
If Asc (a$) > 60
d = d + Asc (a$) - 55
Else
  d = d + Asc (a$) - 48
EndIf
Next
ProcedureReturn d
EndProcedure
Je me demande si cette partie, peu essentielle à la fonction principale du code, n'est pas viable.

Code : Tout sélectionner

Procedure.i HexToDec (h$)
h$ = ReplaceString(h$, "%", "")
ProcedureReturn Val("$" + h$)
EndProcedure
C'est ce que j'ai réussi à lire pour l'instant. Ça semble un super code, en tout cas.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Observateur de dialogue client-serveur HTTP

Message par djes »

Ah oui, faut dire que le code original du serveur date un peu. Ça fait quelques années que je voulais en faire cadeau à la communauté, et j'ai fait la mise à jour sans trop rentrer dans les détails.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Observateur de dialogue client-serveur HTTP

Message par djes »

Petite mise à jour, merci à Ollivier
Répondre