#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
