www.FiveTechSoft.com
https://forums.fivetechsupport.com/
Code: Select all | Expand
#include "fivewin.ch"
#include "hbsocket.ch"
Static oWnd
*-----------------*
FUNCTION Main()
DEFINE WINDOW oWnd FROM 0, 0 TO 800, 1000 PIXEL TITLE 'Http Server'
@ 10, 10 BUTTON oBtn PROMPT 'Exit' SIZE 60, 30 PIXEL OF oWnd ACTION (oWnd:End())
ACTIVATE WINDOW oWnd ON INIT (HttpStart())
return
*---------------------*
Function HttpStart()
LOCAL nPort := 8080
LOCAL nSocket, nClientSocket, cRequest, cResponse
// Initialize socket
nSocket := SocketInit(nPort)
IF nSocket < 0
? "Failed to initialize socket on port", nPort
RETURN NIL
ENDIF
? "Server started on port", nPort
DO WHILE .T.
nClientSocket := SocketAccept(nSocket)
IF nClientSocket >= 0
cRequest := SocketReadRequest(nClientSocket)
? "Received request:", cRequest
// Determine if it's GET or POST
IF LEFT(cRequest, 3) == "GET"
cResponse := HandleGetRequest(cRequest)
ELSEIF LEFT(cRequest, 4) == "POST"
cResponse := HandlePostRequest(cRequest)
ELSE
cResponse := "HTTP/1.1 405 Method Not Allowed" + CRLF + ;
"Content-Length: 0" + CRLF + CRLF
ENDIF
// Send response to the client
SocketSend(nClientSocket, cResponse)
hb_SocketClose(nClientSocket)
ENDIF
ENDDO
hb_SocketClose(nSocket)
RETURN NIL
STATIC FUNCTION SocketInit(nPort)
LOCAL nSocket := hb_socketOpen() // HB_SOCKET_AF_INET, HB_SOCKET_PT_STREAM, 0)
IF nSocket < 0
RETURN -1
ENDIF
hb_socketBind(nSocket, "0.0.0.0", nPort)
hb_socketListen(nSocket, 5)
RETURN nSocket
STATIC FUNCTION SocketAccept(nSocket)
LOCAL nClientSocket := hb_socketAccept(nSocket)
RETURN nClientSocket
STATIC FUNCTION SocketReadRequest(nClientSocket)
LOCAL cRequest := hb_socketRecv(nClientSocket, 1024, 0)
RETURN cRequest
STATIC FUNCTION HandleGetRequest(cRequest)
LOCAL cResponse := "HTTP/1.1 200 OK" + CRLF + ;
"Content-Type: text/plain" + CRLF + ;
"Content-Length: 13" + CRLF + CRLF + ;
"Hello, World!"
RETURN cResponse
STATIC FUNCTION HandlePostRequest(cRequest)
LOCAL cBody := "Data received!"
LOCAL cResponse := "HTTP/1.1 200 OK" + CRLF + ;
"Content-Type: text/plain" + CRLF + ;
"Content-Length: " + LTRIM(STR(LEN(cBody))) + CRLF + CRLF + ;
cBody
RETURN cResponse
Code: Select all | Expand
STATIC FUNCTION SocketInit(nPort)
LOCAL nSocket := hb_socketOpen() // HB_SOCKET_AF_INET, HB_SOCKET_PT_STREAM, 0)
? valtype(nSocket)
Otto wrote:Hello Dutch,
here nSocket returns a Pointer.
Have you looked at mod harbour?
Maybe it has these functions, and you could see how they are used.
Best regards,
Otto
Code: Select all | Expand
STATIC FUNCTION SocketInit(nPort) LOCAL nSocket := hb_socketOpen() // HB_SOCKET_AF_INET, HB_SOCKET_PT_STREAM, 0) ? valtype(nSocket)
Lailton wrote:Can you explain what you want to do with more detail?
Then we can implement it on FiveWin.
Antonio Linares wrote:Dear Dutch,
To implement a web server using xHarbour you need to use multithreading and as far as I know it does not properly work with xHarbour
You need to use Harbour to do it, sorry. We have the Harbour code to do it, just in case.
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
//----------------------------------------------------------------------------//
#ifndef __XHARBOUR__
static function GetPostPairs( cRequest, lUrlDecode )
local cParams := SubStr( cRequest, At( hb_OsNewLine() + hb_OsNewLine(), cRequest ) + ;
Len( hb_OsNewLine() + hb_OsNewLine() ) )
local aPairs := hb_ATokens( cParams, "&" )
local cPair, uPair, hPairs := {=>}
local nTable, aTable, cKey, cTag
DEFAULT lUrlDecode := .T.
cTag = If( lUrlDecode, '[]', '%5B%5D' )
for each cPair in aPairs
if lUrlDecode
cPair = hb_urlDecode( cPair )
endif
if ( uPair := At( "=", cPair ) ) > 0
cKey = Left( cPair, uPair - 1 )
if ( nTable := At( cTag, cKey ) ) > 0
cKey = Left( cKey, nTable - 1 )
aTable = HB_HGetDef( hPairs, cKey, {} )
AAdd( aTable, SubStr( cPair, uPair + 1 ) )
hPairs[ cKey ] = aTable
else
hb_HSet( hPairs, cKey, SubStr( cPair, uPair + 1 ) )
endif
endif
next
return hPairs
#endif
//----------------------------------------------------------------//
#ifndef __XHARBOUR__
static function ValToChar( u )
local cType := ValType( u )
local cResult
do case
case cType == "C" .or. cType == "M"
cResult = u
case cType == "D"
cResult = DToC( u )
case cType == "L"
cResult = If( u, ".T.", ".F." )
case cType == "N"
cResult = AllTrim( Str( u ) )
case cType == "A"
cResult = hb_ValToExp( u )
case cType == "O"
cResult = ObjToChar( u )
case cType == "P"
cResult = "(P)"
case cType == "S"
cResult = "(Symbol)"
case cType == "H"
cResult = StrTran( StrTran( hb_JsonEncode( u, .T. ), hb_OsNewLine(), "<br>" ), " ", " " )
if Left( cResult, 2 ) == "{}"
cResult = StrTran( cResult, "{}", "{=>}" )
endif
case cType == "U"
cResult = "nil"
otherwise
cResult = "type not supported yet in function ValToChar()"
endcase
return cResult
#endif
//----------------------------------------------------------------//
#ifndef __XHARBOUR__
function ObjToChar( o )
local hObj := {=>}, aDatas := __objGetMsgList( o, .T. )
local hPairs := {=>}, aParents := __ClsGetAncestors( o:ClassH )
AEval( aParents, { | h, n | aParents[ n ] := __ClassName( h ) } )
hObj[ "CLASS" ] = o:ClassName()
hObj[ "FROM" ] = aParents
AEval( aDatas, { | cData | ObjSetData( o, cData, hPairs ) } )
hObj[ "DATAs" ] = hPairs
hObj[ "METHODs" ] = __objGetMsgList( o, .F. )
return ValToChar( hObj )
#endif
//----------------------------------------------------------------//
function ObjSetData( o, cData, hPairs )
TRY
hPairs[ cData ] := __ObjSendMsg( o, cData )
CATCH
hPairs[ cData ] := "** protected **"
END
return nil
//----------------------------------------------------------------//
#pragma BEGINDUMP
#include <hbapi.h>
#include <hbapierr.h>
HB_FUNC( HB_URLDECODE ) // Giancarlo's TIP_URLDECODE
{
const char * pszData = hb_parc( 1 );
if( pszData )
{
HB_ISIZ nLen = hb_parclen( 1 );
if( nLen )
{
HB_ISIZ nPos = 0, nPosRet = 0;
/* maximum possible length */
char * pszRet = ( char * ) hb_xgrab( nLen );
while( nPos < nLen )
{
char cElem = pszData[ nPos ];
if( cElem == '%' && HB_ISXDIGIT( pszData[ nPos + 1 ] ) &&
HB_ISXDIGIT( pszData[ nPos + 2 ] ) )
{
cElem = pszData[ ++nPos ];
pszRet[ nPosRet ] = cElem - ( cElem >= 'a' ? 'a' - 10 :
( cElem >= 'A' ? 'A' - 10 : '0' ) );
pszRet[ nPosRet ] <<= 4;
cElem = pszData[ ++nPos ];
pszRet[ nPosRet ] |= cElem - ( cElem >= 'a' ? 'a' - 10 :
( cElem >= 'A' ? 'A' - 10 : '0' ) );
}
else
pszRet[ nPosRet ] = cElem == '+' ? ( char ) ' ' : cElem;
nPos++;
nPosRet++;
}
/* this function also adds a zero */
/* hopefully reduce the size of pszRet */
hb_retclen_buffer( ( char * ) hb_xrealloc( pszRet, nPosRet + 1 ), nPosRet );
}
else
hb_retc_null();
}
else
hb_errRT_BASE( EG_ARG, 3012, NULL,
HB_ERR_FUNCNAME, 1, hb_paramError( 1 ) );
}
#pragma ENDDUMP
//----------------------------------------------------------------//
Code: Select all | Expand
function WebServer()
local oServer := HbWebServer()
if ! hb_HHasKey( hWebApp, "Dialogs" )
hWebApp[ "Dialogs" ] = {}
endif
oServer:bOnGet = { || Html() }
oServer:Run()
return nil