Threaded version (non-professional)
simplehttpwebview.pb
Code: Select all
EnableExplicit
#PORT = 8080
#WWW = "www/"
Global event
Structure ClientCtx
id.i
request.s
EndStructure
;-----------------------------------------
Procedure.s GetMimeType(file.s)
Select LCase(GetExtensionPart(file))
Case "html","htm" : ProcedureReturn "text/html"
Case "js" : ProcedureReturn "application/javascript"
Case "css" : ProcedureReturn "text/css"
Case "png" : ProcedureReturn "image/png"
Case "jpg","jpeg" : ProcedureReturn "image/jpeg"
Case "gif" : ProcedureReturn "image/gif"
EndSelect
ProcedureReturn "application/octet-stream"
EndProcedure
;-----------------------------------------
Procedure HandleClient(*ctx.ClientCtx);HandleClient(client)
Protected client = *ctx\id
Protected request.s = *ctx\request
Debug "cliente = "+Str(client)
;Debug "request = "+request
Protected *req, *buf
Protected path.s, file.s
Protected size.q, sent, bytesRead, n.q
Protected fn, mime.s
Protected header.s
Protected TotalEnviado.q = 0
Protected fileSize.q
path = StringField(StringField(request, 1, #CRLF$), 2, " ")
If (FindString(path,"?"))
path = StringField(path, 1, "?")
EndIf
If path = "/" : path = "/index.html" : EndIf
Debug "PATH === "+path
file = #WWW + Mid(path, 2)
If FileSize(file) >= 0
fn = ReadFile(#PB_Any, file)
size = Lof(fn)
mime = GetMimeType(file)
header = "HTTP/1.1 200 OK" + #CRLF$ +
"Content-Type: " + mime + #CRLF$ +
"Content-Length: " + Str(size) + #CRLF$ +
"Connection: close" + #CRLF$ +
#CRLF$
SendNetworkString(client, header, #PB_UTF8)
; ===== STREAMING =====
;*buf = AllocateMemory(16384)
*buf = AllocateMemory(16384)
fileSize = Lof(fn)
While TotalEnviado < fileSize And Not Eof(fn)
bytesRead = ReadData(fn, *buf, 16384 )
If bytesRead <= 0
Break
EndIf
sent = 0
While sent < bytesRead
n = SendNetworkData(client, *buf + sent, bytesRead - sent)
If n > 0
sent + n
TotalEnviado + n
ElseIf n = -1
; Socket ocupado, espera um pouco
Delay(1)
Else
Debug "Cliente fechou a conexão"
Break 2
EndIf
Wend
; Debug "Chunk enviado: " + Str(sent)
; Debug "Total enviado: " + Str(TotalEnviado) + " / " + Str(fileSize)
Wend
FreeMemory(*buf)
CloseFile(fn)
Debug "ENVIO FINALIZADO: " + Str(TotalEnviado)
Else
header = "HTTP/1.1 404 Not Found" + #CRLF$ +
"Content-Length: 13" + #CRLF$ +
"Connection: close" + #CRLF$ +
#CRLF$ +
"404 Not Found"
SendNetworkString(client, header, #PB_UTF8)
EndIf
;Debug "Conexão Encerrada"
;CloseNetworkConnection(client)
FreeStructure(*ctx)
EndProcedure
Procedure ServerThread(void)
;-----------------------------------------
Protected NetEvent, client
Repeat
NetEvent = NetworkServerEvent()
If NetEvent
client = EventClient()
If NetEvent = #PB_NetworkEvent_Data
;HandleClient(client)
;Debug "################# DADOS recebidos ######################"
Protected *ctx.ClientCtx = AllocateStructure(ClientCtx)
Protected *buffer = AllocateMemory(4096)
Protected result
*ctx\id = client
Repeat
FillMemory(*buffer, 4096, 0)
result = ReceiveNetworkData(client, *buffer, 4096)
If result > 0
*ctx\request + PeekS(*buffer, result, #PB_UTF8)
EndIf
Until result < 4096
FreeMemory(*buffer)
; AGORA o socket está “isolado”
CreateThread(@HandleClient(), *ctx)
ElseIf NetEvent = #PB_NetworkEvent_Disconnect
; Debug "DESCONECTADO DO SERVIDOR"
EndIf
Else
Delay(1) ; Ne pas saturer le CPU / Don't stole the whole CPU !
EndIf
ForEver
EndProcedure
If CreateNetworkServer(0, #PORT,#PB_Network_TCP|#PB_Network_IPv4|#PB_Network_IPv6)
Debug "Servidor em http://localhost:" + Str(#PORT)
CreateThread(@ServerThread(),0)
If OpenWindow(0, 0, 0, 800, 600, "AppComposer", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget)
If CreateMenu(0, WindowID(0)) ; Create a regular menu with title and one item
MenuTitle("File")
MenuItem(1, "Reload" + #TAB$ + "Ctrl+O")
EndIf
WebViewGadget(0, 0, 0, 800, 600)
SetGadgetText(0, "http://localhos:8080")
HideWindow(0, #False)
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Menu
Select EventMenu()
Case 1
SetGadgetText(0, "http://localhost:8080")
EndSelect
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver
EndIf
Else
End
EndIf
Code: Select all
Global port = 8080
#Loadtest=01
Global semtest = CreateSemaphore()
Procedure _loadLest(amount)
Protected get.s, rec.s,con,a,try=1
rec = "Host: 192.168.3.91:" + Str(port) + #CRLF$
rec + "Connection: keep-alive" + #CRLF$
rec + "User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/121.0.0.0 Safari/537.36 Edg/121.0.0.0" + #CRLF$
rec + "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.7" + #CRLF$
rec + "Sec-Fetch-Site: none" + #CRLF$
rec + "Sec-Fetch-Mode: navigate" + #CRLF$
rec + "Sec-Fetch-User: ?1" + #CRLF$
rec + "Sec-Fetch-Dest: document" + #CRLF$
rec + "Accept-Encoding: gzip, deflate, br" + #CRLF$
rec + "Accept-Language: en-US,en;q=0.9" + #CRLF$ + #CRLF$
WaitSemaphore(semtest)
Repeat
con = OpenNetworkConnection("192.168.3.91",port,#PB_Network_TCP | #PB_Network_IPv4,1000)
If con
get = "GET / HTTP/1.1" + #CRLF$
SendNetworkString(Con,get+rec)
Delay(100)
get = "GET /favicon.ico HTTP/1.1" + #CRLF$
SendNetworkString(Con,get+rec)
Debug "Sent on try " + Str(try)
Break
Else
Debug "can't connect retry " + Str(try)
Delay(10)
try+1
EndIf
Until try > 5
If try > 5
Debug "couldn't connect"
EndIf
EndProcedure
Procedure loadTest(amount)
Protected a
Dim threads(amount)
For a = 1 To amount
threads(a) = CreateThread(@_loadLest(),0)
Next
Delay(1000)
Debug "signal"
For a = 1 To amount
SignalSemaphore(semtest)
Delay(1)
Next
For a = 1 To amount
If IsThread(threads(a))
WaitThread(threads(a),1000)
EndIf
Next
Debug "done test"
EndProcedure
loadTest(10000)
