Atomic web Serveur (Unicode)

[djes]

Comme l'a dit john, c'est pour laisser de la place au header (entête). Quand tu envoies un fichier, quel qu'il soit, en http, tu dois envoyer un entête qui définit la version du protocole, le type mime, éventuellement la taille, un cookie, et d'autres choses. À la fin de l'header, il y a toujours un retour chariot+lf, qu'il ne faut surtout pas oublier.

[falsam]

Ok pour cette réponse meme si je pense qu'on doit pouvoir affiner la taille de cet Header.

je suis toujours en mode décryptage et puisqu'on parle de Header. Je ne comprends pas cette procédure. Du moins je ne comprend pas quel est le contenu de *FileBuffer ?

Code : Tout sélectionner

Procedure BuildRequestHeader(*FileBuffer, FileLength, ContentType.s)
  Protected Length
  Protected Week.s = "Sun, Mon,Tue,Wed,Thu,Fri,Sat"
  Protected MonthsOfYear.s = "Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec" 
  
  Protected DayOfWeek.s = StringField("Sun, Mon,Tue,Wed,Thu,Fri,Sat", DayOfWeek(Date()) + 1, ",")
  Protected Day = Day(Date())
  Protected Month.s = StringField("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", Month(Date()), ",")
  Protected Year.s = Str(Year(Date()))
  Protected Time.s = FormatDate("%hh:%ii:%ss GMT", Date())
  
  Length = PokeS(*FileBuffer, "HTTP/1.1 200 OK" + #CRLF$, -1, #PB_UTF8)                                                             : *FileBuffer + Length
  Length = PokeS(*FileBuffer, "Date: " + DayOfWeek + ", " + Day + " " + Month + " " + Year + " " + Time  + #CRLF$, -1, #PB_UTF8)    : *FileBuffer + Length
  Length = PokeS(*FileBuffer, "Server: "+ Title + #CRLF$, -1, #PB_UTF8)                                                             : *FileBuffer + Length
  Length = PokeS(*FileBuffer, "Content-Length: " + Str(FileLength) + #CRLF$, -1, #PB_UTF8)                                          : *FileBuffer + Length
  Length = PokeS(*FileBuffer, "Content-Type: " + ContentType + #CRLF$, -1, #PB_UTF8)                                                : *FileBuffer + Length
  Length = PokeS(*FileBuffer, #CRLF$, -1, #PB_UTF8)                                                                                 : *FileBuffer + Length
  
  ProcedureReturn *FileBuffer
EndProcedure

A part un #CRLF$ il n'y a rien d'autre dans ce pointeur. Quand à ce *FileBuffer + Length ça me pertube.

[djes]

Là en visuel c'est dur d'être affirmatif, mais à première vue je ne vois rien de bizarre. Le pointeur avance au fur et à mesure de la complétion de l'entête. Le buffer ne peut pas ne contenir qu'un cr+lf...

[Marc56]

Chaque ligne de header est terminée par un CR + LF (peu importe L'os serveur)
La fin du header est matérialisée par une ligne vide donc deux crlf

https://en.wikipedia.org/wiki/List_of_H ... der_fields

[Kwai chang caine]

@Djes
Même pas mon bon Djes, AJAX je sais ce que c'est.
Ça fait 3 fois que je l'apprends et que je l'oublie, mais je sais
Ça te bouche un coin hein !
Je ne ferai donc pas de vannes graveleuses, sur ce mot...enfin à "proprement" parler

En tout cas, je suis tous les épisodes de ce "feuilleton" , c'est super intéressant. ..encore mieux que amour gloire et beauté.
Merci Falsam et à tous

[djes]

@Djes
Même pas mon bon Djes, AJAX je sais ce que c'est.
Ça fait 3 fois que je l'apprends et que je l'oublie, mais je sais
Ça te bouche un coin hein !
Je ne ferai donc pas de vannes graveleuses, sur ce mot...enfin à "proprement" parler

En tout cas, je suis tous les épisodes de ce "feuilleton" , c'est super intéressant. ..encore mieux que amour gloire et beauté.
Merci Falsam et à tous

Zut, même si je savais que tu savais, je m'attendais au moins à une petite vanne. Déçu je suis _^_

Chaque ligne de header est terminée par un CR + LF (peu importe L'os serveur)
La fin du header est matérialisée par une ligne vide donc deux crlf

https://en.wikipedia.org/wiki/List_of_H ... der_fields

Oui, tiens, ça pourrait être intéressant de faire une appli client/serveur interactive, tout dans la même fenêtre, d'un côté le nav, de l'autre le serveur en mode console brute pour la réception, avec coloration syntaxique sur certains trucs, et des fenêtres d'édition pour créer les fichiers demandés et les envoyer en direct...

[Kwai chang caine]

Zut, même si je savais que tu savais, je m'attendais au moins à une petite vanne. Déçu je suis _^_

Bah, j'me suis quand même creusé la tête, pour na pas te trop te décevoir ...
AJAX ====> "proprement" parlé

Bonne idée, le double effet kiss cool client/serveur

[djes]

Bon, j'ai ressorti mon vieux code et commencé le boulot.
Il faut mettre un fichier index.htm là où le programme compile.
Il reste des trucs pas vraiment utiles, par exemple le programme peut lancer le navigateur par défaut à la place du webgadget... Je l'ai laissé au cas où (pas confiance dans le webgadget).

Pour info, le serveur est multi-threadé, il peut donc gérer assez rapidement les requêtes.

Il reste sans doute des bugs, à utiliser à vos risques et périls !

Falsam> ton code est plus propre, il faudrait que je m'en inspire pour la suite. Si tu as des suggestions, n'hésite pas...

Code : Tout sélectionner

; ****************************************************************************
;
; Realtime HTTP protocol lookup
; (c)djes 2017
;
; (will) Displays a window with a server side, and a client side
; allowing fine HTTP debugging
;
;TODO : realtime file requests handling and uploading
;
; ****************************************************************************

EnableExplicit

Structure SentFile
  ClientID.l
  ContentType$
  FileNumber.l
  FileLength.l
  *FileBuffer
EndStructure

Enumeration
  #WEBGADGET
  #BUTTON_BACKWARD
  #BUTTON_FORWARD
  #BUTTON_HOME
  #BUTTON_PRINT
  #BUTTON_SEARCH
  #BUTTON_QUIT
  #SCINTILLAGADGET
EndEnumeration

#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 

; 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

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.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 les 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 caracs 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 BuildNotFound( *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

; ****************************************************************************
; Initialise une liste de processus actifs
Procedure.i GetProcessList()
  Define Proc32.PROCESSENTRY32, snap.i
  
  ; Add processes to Process32 () list... 
  ClearList(Process32 ())
  If OpenLibrary (#PROCESS32LIB, "kernel32.dll") 
    
    snap = CallFunction (#PROCESS32LIB, "CreateToolhelp32Snapshot", #TH32CS_SNAPPROCESS, 0) 
    
    If snap 
      
      Proc32\dwSize = SizeOf (PROCESSENTRY32) 
      
      If CallFunction (#PROCESS32LIB, "Process32First", snap, @Proc32) 
        
        AddElement (Process32 ()) 
        CopyMemory (@Proc32, @Process32 (), SizeOf (PROCESSENTRY32)) 
        
        While CallFunction (#PROCESS32LIB, "Process32Next", snap, @Proc32) 
          AddElement (Process32 ()) 
          CopyMemory (@Proc32, @Process32 (), SizeOf (PROCESSENTRY32)) 
        Wend 
        
      EndIf 
      CloseHandle_ (snap) 
      
    EndIf 
    
    CloseLibrary (#PROCESS32LIB) 
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf 
EndProcedure

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

Procedure FileSendingThread( *ThreadVariables.SentFile)
  Define nb.i, i.i
  
  Define ClientID.i = *ThreadVariables\ClientID
  Define ContentType$ = *ThreadVariables\ContentType$
  Define FileNumber.i = *ThreadVariables\FileNumber
  Define FileLength.i = *ThreadVariables\FileLength
  Define *FileBuffer = *ThreadVariables\FileBuffer
  Define *BufferOffset = BuildRequestHeader( *FileBuffer, FileLength, ContentType$)
  ;envoie d'abord l'header (c mieux pour les gros fichiers, ça évite de faire patienter le client)
  SendNetworkData(ClientID, *FileBuffer, *BufferOffset - *FileBuffer)
  ;envoie le fichier en parts de 524288 octets
  nb = FileLength / 524288
  If nb > 0
    For i = 1 To nb
      ReadData(FileNumber, *BufferOffset, 524288)
      While SendNetworkData(ClientID, *BufferOffset, 524288) < 524288
        Delay(100)
      Wend
    Next i
  EndIf
  ;reste
  i = FileLength%524288
  If i > 0
    ReadData(FileNumber, *BufferOffset, i)
    While SendNetworkData(ClientID, *BufferOffset, i) < i
      Delay(100)
    Wend
  EndIf
  CloseFile(FileNumber)
  FreeMemory(*ThreadVariables)
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)
    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")
    
    ;"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 ServerLogGadget(x, y, w, h)
  InitScintilla()
  ScintillaGadget(#SCINTILLAGADGET, x, y, w, h, 0)
EndProcedure

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

Procedure ServerLog(Text.s)
  ScintillaSendMessage(#SCINTILLAGADGET, #SCI_APPENDTEXT, Len(Text), UTF8(Text))
EndProcedure

; ****************************************************************************
;- ErrorPage
Procedure ErrorPage(ClientID)
  Define head$, body$
  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'>Aucun mot trouvé</font>" + EOL$
  body$ = body$ + "</body>" + EOL$
  body$ = body$ + "</html>" + EOL$
  head$ = ReplaceString(head$, " *% *% *%", Str(Len(body$)))
  SendNetworkString(ClientID, head$ + body$)
  
EndProcedure

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

If InitNetwork() = 0
  MessageRequester("Erreur", "Il vous faut au moins un accès réseau TCP/IP configuré correctement", 0)
  End
EndIf

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

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

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 *ThreadVariables.SentFile

*IncomingRequestBuffer = AllocateMemory(10000)
If *IncomingRequestBuffer = 0
  MessageRequester("Erreur", "Impossible d'allouer 10 Ko de mémoire !!!", 0)
  End
EndIf

Socket = CreateNetworkServer(0, MyServerPort, #PB_Network_TCP, "127.0.0.1")
If Socket
  
  hWnd.i = OpenWindow(0, 0, 0, MyWindowWidth, MyWindowHeight, "RTHTTP", #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)
    
    ServerLogGadget(0, 40, MyWindowWidth/2, MyWindowHeight)
    
    ;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, sinon ouvre le navigateur par défaut en maximisé
    If Navigator(MyWindowWidth/2, 40, MyWindowWidth/2, MyWindowHeight, BaseURL + index)
      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
      ;trouve le nom du navigateur par défaut
      DefaultNavigatorName = Space(2048)
      FindExecutable_(AppDir + index, AppDir, @DefaultNavigatorName) ;quel est le prog qui est capable d'ouvrir ce fichier? c le navigateur par défaut!
      DefaultNavigatorName = LCase(GetFilePart(DefaultNavigatorName))
      ShellExecute_(#Null, "open", AppDir + index, "", "", #SW_SHOWNORMAL) ;ouvre notre page
      MessageRequester("Erreur", "Impossible d'intégrer une fenêtre de navigation. Explorer (4 mini) est requis.", 0)
    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 + "recherche.htm") 
            ;SetGadgetState(#WEBGADGET, #PB_Web_Refresh) 
          Case #BUTTON_QUIT
            Quit = 1 
            
        EndSelect
      EndIf
      
      ;Debug WEvent
      ;Debug EventType()
      
      ;- 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
              ;Clear buffer
              For i = 0 To 4096 / 4 - 1
                PokeL( *IncomingRequestBuffer + i * 4, 0)
              Next i
              RequestLength = ReceiveNetworkData(ClientID, *IncomingRequestBuffer, 4096)
              If RequestLength > 0
                Gosub HandleRequest
              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
      
      If DefaultNavigatorName <> "WebGadget"
        Quit = 1
        ;Si le navigateur courant n'est plus en mémoire, le programme s'arrête
        If GetProcessList()
          ResetList (Process32 ()) 
          While NextElement (Process32 ()) 
            If DefaultNavigatorName =  GetFilePart(LCase(PeekS (@Process32()\szExeFile, -1, #PB_UTF8))) : Quit = 0 : EndIf
          Wend 
        EndIf
      EndIf
      
    Until WEvent = #PB_Event_CloseWindow Or Quit = 1
    
  Else
    MessageRequester("Erreur", "La fenêtre n'a pû être ouverte?! Problème de mémoire?", 0)
  EndIf
  
  CloseNetworkServer(0)
  
Else
  ;impossible de créer le serveur
  i = #False
  If GetProcessList()
    ResetList (Process32 ())
    While NextElement (Process32 ())
      If GetFilePart(LCase(PeekS (@Process32()\szExeFile, -1, #PB_UTF8))) = "rthttp.exe" : i = #True : EndIf
    Wend 
  EndIf
  ;si le programme n'est pas chargé, un autre serveur occupe le port 8080; on affiche donc un msg d'erreur et on ouvre une page par défaut
  If i = #False
    MessageRequester("Erreur", "Port 8080 occupé. Essayez de fermer toutes les fenêtres du navigateur et de relancer.", 0)
    ShellExecute_(#Null, "open", AppDir + "fullscreen_noserv.htm", "", "", #SW_SHOWNORMAL)
  Else
    ;sinon on ouvre la fenêtre normale
    ShellExecute_(#Null, "open", AppDir + index, "", "", #SW_SHOWNORMAL) ;ouvre notre page
  EndIf
  
EndIf

End

; ****************************************************************************
;- Handle Request
HandleRequest: 

;reinitialise la chaine de recherche

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)
;If RequestLength > Len(incoming$) : CallDebugger : EndIf

ServerLog(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 "user-agent: "
    program$ = Mid(incoming$, eoc + 1, Len(incoming$) - eoc - 1)
EndSelect

;CallDebugger

If file$ = "/" : file$ = "/" + index : EndIf

;S'il n'y pas de fichier spécifié, il s'agit sans doute d'une autre 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 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
    
    ;écrit l'en tête de la page de résultats
    head$ = "HTTP/1.1 200 OK" + EOL$
    ;					WriteLine stream, "Date : Tue, 26 Aug 2003 10 : 36 : 48 GMT"
    head$ = head$ + "Server: DjesMiniserv" + EOL$
    ;					WriteLine stream, "Last - Modified : Sat, 23 Aug 2003 14 : 56 : 42 GMT"
    ;contient la taille de la page à envoyer; sera modifié à la fin avec la taille réelle
    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>"
    
    
    ;écrit la fin de la page de recherche
    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 car!
    SendNetworkString(ClientID, head$ + body$)
    
  Else
    
    ;si il y a un fichier spécifié, va le chercher et l'envoie au client
    Gosub Atomic
    ; Gosub ErrorPage
    
  EndIf
Else
  ErrorPage(ClientID)
EndIf
Return

; ****************************************************************************
;- Atomic
Atomic: 
Define RequestedFile$ = UnHexURL(Right(file$, Len(file$) - 1)) ; Enlève un car à la chaîne et convertit les car spéciaux %
Define BaseDirectory$ = appdir
Define DefaultPage$ = "index.htm"

Define ContentType$
Define.i FileNumber, FileLength
Define *FileBuffer, *BufferOffset
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 qui agit directement sur le programme
; If Right(RequestedFile$, 4) = "Quit" 
;   End
; EndIf

;type mime du fichier demandé
Select LCase(Right(RequestedFile$, 4))
  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$ = "text/html"
    
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$)
    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(524288 + 512) ; taille de l'header + des blocs
      If *FileBuffer <> 0
        *ThreadVariables = AllocateMemory(SizeOf(SentFile))
        *ThreadVariables\ClientID = ClientID
        *ThreadVariables\ContentType$ = ContentType$
        *ThreadVariables\FileNumber = FileNumber
        *ThreadVariables\FileLength = FileLength
        *ThreadVariables\FileBuffer = *FileBuffer
        CreateThread(@FileSendingThread(), *ThreadVariables)
      EndIf
    EndIf
  Else
    ;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
        *BufferOffset = BuildNotFound( *FileBuffer, FileLength)
        
        ReadData(0, *BufferOffset, FileLength)
        CloseFile(0)
        
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset - *FileBuffer + FileLength)
        FreeMemory(*FileBuffer)
      EndIf
    Else
      Error$ = "<HTML><BODY>File not found</BODY></HTML>" + EOL$
      *FileBuffer = AllocateMemory(Len(Error$) + 512)
      If *FileBuffer <> 0
        *BufferOffset = BuildNotFound( *FileBuffer, Len(Error$))
        PokeS( *BufferOffset, Error$, -1, #PB_UTF8)
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset - *FileBuffer + Len(Error$))
        FreeMemory(*FileBuffer)
      EndIf
    EndIf
  EndIf
  
EndIf
Return

[falsam]

Merci Djes mais suite à de nombreux artefacts visuels dans mes pages dés que je modifiais une variable html avec PureBasic et un raz le bol de Peek et Poke, j'ai retravaillé le code serveur hier soir afin de ne plus avoir à faire à ces deux individus.

[Kwai chang caine]

C'est un super début merci DJES
Marche nickel chez moi...

En fait ça me fait penser à un truc que j'avais rêvé de réaliser, c'est naviguer à droite comme tu l'as fait, et comme tu l'as fait aussi récupérer exactement ce que le navigateur à envoyé à gauche
Mais sur n'importe quel site, c'etait pour créer un bot, pour des taches répetitives....

Betement je m'étais dit si j'enregistre la séquence qu'a envoyé le navigateur et que je la réenvois à nouveau, le serveur devrait réagir comme si c'était un utilisateur qui clique derriere son navigateur
Mais on m'a dit que c'était quasi impossible, ou tres compliqué en WINDOWS, car il fallait un genre de SNIFFER.

En tout cas ton code pour comprendre ce qui se passe quand on envoi une requete sur son propre site, c'est vraiment de la balle, encore merci

[djes]

C'est un super début merci DJES
Marche nickel chez moi...

En fait ça me fait penser à un truc que j'avais rêvé de réaliser, c'est naviguer à droite comme tu l'as fait, et comme tu l'as fait aussi récupérer exactement ce que le navigateur à envoyé à gauche
Mais sur n'importe quel site, c'etait pour créer un bot, pour des taches répetitives....

Betement je m'étais dit si j'enregistre la séquence qu'a envoyé le navigateur et que je la réenvois à nouveau, le serveur devrait réagir comme si c'était un utilisateur qui clique derriere son navigateur
Mais on m'a dit que c'était quasi impossible, ou tres compliqué en WINDOWS, car il fallait un genre de SNIFFER.

En tout cas ton code pour comprendre ce qui se passe quand on envoi une requete sur son propre site, c'est vraiment une super idée

Merci d'avoir testé. Pour ton idée, oui, il faut un sniffer, mais effectivement, ça fonctionnerait. Sinon, tu peux aussi voir ce qui se passe avec un outil tel que celui-là, et récupérer les requêtes telles qu'elles sont envoyées au serveur. J'ai pensé justement à faire une sorte d'enregistreur...

Merci Djes mais suite à de nombreux artefacts visuels dans mes pages dés que je modifiais une variable html avec PureBasic et un raz le bol de Peek et Poke, j'ai retravaillé le code serveur hier soir afin de ne plus avoir à faire à ces deux individus.

Je me doutais que tu n'allais pas en rester là J'ai hâte de voir ce que tu vas nous pondre.

[Kwai chang caine]

Oui, surtout que FALSAM c'est une belle poule
C'est la seule qui pond des kinders "SURPRISE"

[falsam]

Oui, surtout que FALSAM c'est une belle poule
C'est la seule qui pond des kinders "SURPRISE"

Tu vas voir la gueule du kinder ^^ Pti con :p

PS : Oui c'est mal je t'ai insulté sans me douter de l'impact psychologique.

[Kwai chang caine]

Pourquoi petit ?

[Micoute]

Moi, j'aurais dit vieux, ça fait plus péjoratif que p'tit, car tout ce qui est petit est gentil.