Page 1 of 1
\fwh2212\source\function\WebApp.prg
Posted: Thu Jun 27, 2024 12:47 pm
by Ari
Olá
Tem algum exemplo de como usar o WebApp.prg
É o mesmo funcionamento da \fwh2212\source\classes\TWebServ.prg ( TWebServer() )
Code: Select all | Expand
function WebServer()
local oServer := HbWebServer()
if ! hb_HHasKey( hWebApp, "Dialogs" )
hWebApp[ "Dialogs" ] = {}
endif
oServer:bOnGet = { || Html() }
oServer:Run()
return nil
/-------------------------------------/
Is there any example of how to use WebApp.prg
It's the same operation as \fwh2212\source\classes\TWebServ.prg ( TWebServer() )
Re: \fwh2212\source\function\WebApp.prg
Posted: Thu Jun 27, 2024 1:13 pm
by Antonio Linares
Dear Ari,
It works fine but it does not support https yet
It is a different code from source\classes\TWebServ.prg. This code has to be built using multithread support -MT:
Code: Select all | Expand
#include "FiveWin.ch"
#include "inkey.ch"
#include "hbsocket.ch"
#define ADDRESS "0.0.0.0"
#define PORT 80
#define TIMEOUT 30
//----------------------------------------------------------------//
CLASS HbWebServer
DATA hListen
DATA cAddress INIT ADDRESS
DATA nPort INIT PORT
DATA nTimeOut INIT TIMEOUT
DATA bOnGet
DATA bOnPost
METHOD Run( cAddress, nPort, nTimeOut )
ENDCLASS
//----------------------------------------------------------------//
METHOD Run( cAddress, nPort, nTimeOut ) CLASS HbWebServer
#ifndef __XHARBOUR__
local hSocket
#endif
DEFAULT cAddress := ::cAddress
DEFAULT nPort := ::nPort
DEFAULT nTimeOut := ::nTimeOut
::cAddress := cAddress
::nPort := nPort
::nTimeOut := nTimeOut
#ifndef __XHARBOUR__
if ! hb_mtvm()
// ? "HbWeb requires to build your Harbour app using hbmk2 -mt flag"
return Self
endif
#else
MsgAlert( "Class HbWebServer is not available in xHarbour" )
#endif
if Empty( ::hListen := hb_socketOpen() )
// ? "HbWeb socket create error " + hb_ntos( hb_socketGetError() )
endif
//if ! hb_socketBind( ::hListen, { HB_SOCKET_AF_INET, ADDRESS, nPort } )
if ! hb_socketBind( ::hListen, { HB_SOCKET_AF_INET, ::cAddress, ::nPort } )
// ? "HbWeb bind error " + hb_ntos( hb_socketGetError() )
endif
if ! hb_socketListen( ::hListen )
// ? "HbWeb listen error " + hb_ntos( hb_socketGetError() )
endif
// ? "HbWeb server running on port " + hb_ntos( PORT )
#ifndef __XHARBOUR__
while .T.
//if Empty( hSocket := hb_socketAccept( ::hListen,, TIMEOUT ) )
if Empty( hSocket := hb_socketAccept( ::hListen,, ::nTimeOut ) )
if hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT
// ? "loop"
ELSE
// ? "HbWeb accept error " + hb_ntos( hb_socketGetError() )
endif
ELSE
// ? "HbWeb accept socket request"
hb_threadDetach( hb_threadStart( @ServeClient(), Self, hSocket ) )
endif
if Inkey() == K_ESC
// ? "HbWeb quitting - esc pressed"
EXIT
endif
end
#endif
// ? "HbWeb close listening socket"
hb_socketShutdown( ::hListen )
hb_socketClose( ::hListen )
return nil
//----------------------------------------------------------------//
#ifndef __XHARBOUR__
static function ServeClient( oServer, hSocket, nTimeOut )
local cRequest := ""
local cBuffer
local nLen := 1
local cAnswer := "<h1>Welcome to FWH WebServer<br>" + Time() + "</h1>"
local cFileName
local cData
DEFAULT nTimeOut := TIMEOUT
// ? "FWH WebServer new client connected"
while nLen > 0
cBuffer := Space( 1024 ^ 2 ) //4096 )
//if ( nLen := hb_socketRecv( hSocket, @cBuffer,,, TIMEOUT ) ) > 0
if ( nLen := hb_socketRecv( hSocket, @cBuffer,,, nTimeOut ) ) > 0
cRequest += Left( cBuffer, nLen )
else
if nLen == -1 .and. hb_socketGetError() == HB_SOCKET_ERR_TIMEOUT
nLen = 0
endif
endif
end
cBuffer := ""
if ! Empty( cRequest )
// ? cRequest
do case
case ! Empty( oServer:bOnGet ) .and. Left( cRequest, 3 ) == "GET"
cFileName = SubStr( cRequest, 6, At( "HTTP", cRequest ) - 6 )
do case
case ".css" $ cFileName
cData = hb_memoRead( cFileName )
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: text/css" + hb_OsNewLine() + ;
hb_OsNewLine() + hb_OsNewLine() + ;
cData )
case ".png" $ cFileName
cData = hb_memoRead( cFileName )
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: image/png" + hb_OsNewLine() + ;
"Content-Length: " + AllTrim( Str( Len( cData ) ) ) + ;
hb_OsNewLine() + hb_OsNewLine() + ;
cData )
case ".jpg" $ cFileName
cData = hb_memoRead( cFileName )
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: image/jpg" + hb_OsNewLine() + ;
"Content-Length: " + AllTrim( Str( Len( cData ) ) ) + ;
hb_OsNewLine() + hb_OsNewLine() + ;
cData )
case ".bmp" $ cFileName
cData = hb_memoRead( cFileName )
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: image/png" + hb_OsNewLine() + ;
"Content-Length: " + AllTrim( Str( Len( cData ) ) ) + ;
hb_OsNewLine() + hb_OsNewLine() + ;
cData )
case ".ico" $ cAnswer //image/png
cData = hb_memoRead( cFileName )
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: image/x-icon" + hb_OsNewLine() + ;
"Content-Length: " + AllTrim( Str( Len( cData ) ) ) + ;
hb_OsNewLine() + hb_OsNewLine() + ;
cData )
otherwise
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: Text/html" + hb_OsNewLine() + ;
; //"Access-Control-Allow-Origin: *" + ;
hb_OsNewLine() + hb_OsNewLine() + ;
Eval( oServer:bOnGet, cFileName ) )
endcase
case ! Empty( oServer:bOnPost ) .and. Left( cRequest, 4 ) == "POST"
cAnswer = Eval( oServer:bOnPost, GetPostPairs( cRequest ) )
hb_socketSend( hSocket, "HTTP/1.1 200 OK" + hb_OsNewLine() + ;
"Content-type: Text/html" + ;
hb_OsNewLine() + hb_OsNewLine() + cAnswer )
endcase
endif
hb_socketShutdown( hSocket )
hb_socketClose( hSocket )
return nil
#endif
Re: \fwh2212\source\function\WebApp.prg
Posted: Thu Jun 27, 2024 2:55 pm
by Carles
Ari,
WebApp it's a browser "embedded" in your Windows app.
TWebServ is a server web
What do you really want to do?
C.
Re: \fwh2212\source\function\WebApp.prg
Posted: Thu Jun 27, 2024 5:26 pm
by Ari
Fantastic!, I'm going to do some tests.
Thank you very much for the answers.