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
Zut, même si je savais que tu savais, je m'attendais au moins à une petite vanne. Déçu je suis _^_Kwai chang caine a écrit :@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
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...Marc56 a écrit :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
Djes a écrit : Zut, même si je savais que tu savais, je m'attendais au moins à une petite vanne. Déçu je suis _^_
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é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
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...Kwai chang caine a écrit :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
Je me doutais que tu n'allais pas en rester làfalsam a écrit :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.
J'ai hâte de voir ce que tu vas nous pondre.Tu vas voir la gueule du kinder ^^ Pti con :pKwai chang caine a écrit :Oui, surtout que FALSAM c'est une belle poule
C'est la seule qui pond des kinders "SURPRISE"
