xHarbour can produce HTTP server ?

[dutch]

Dear All,

I would like to make small program for waiting HTTP client GET api to request data?

I used to write HTTP client to POST to HTTP server only.

Thanks in advance for any help and idea.
Dutch

[dutch]

I let ChatGPT produce sample code for HTTP server as below but it shows error.
I cannot work forward.

Code: Select all  Expand view  RUN

#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
 

[Otto]

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 view  RUN

STATIC FUNCTION SocketInit(nPort)
       LOCAL nSocket := hb_socketOpen() // HB_SOCKET_AF_INET, HB_SOCKET_PT_STREAM, 0)
     
      ? valtype(nSocket)
 

[dutch]

Dear Otto,

It's time to look at Mod Harbour. Thanks for investigate.

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 view  RUN

STATIC FUNCTION SocketInit(nPort)
       LOCAL nSocket := hb_socketOpen() // HB_SOCKET_AF_INET, HB_SOCKET_PT_STREAM, 0)
     
      ? valtype(nSocket)
 

[Lailton]

Can you explain what you want to do with more detail?
Then we can implement it on FiveWin.

[dutch]

Dear Laiton,

My customer will use hotel tv and need me to integrate and I must be http server for waiting tv server request.

Can you explain what you want to do with more detail?
Then we can implement it on FiveWin.

[Antonio Linares]

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.

[dutch]

Dear Antonio,

May I have sample of Harbour, I will try. Thanks

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.

[Antonio Linares]

Dear Dutch,

Code: Select all  Expand view  RUN

#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>" ), " ", "&nbsp;" )
           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

//----------------------------------------------------------------//
 

[Maurizio]

Hello Duch ,
I started from

C:\harbour\contrib\hbhttpd

Maurizio

[wilsongamboa]

Antonio
Example of use please ?
regards
Wilson

[Antonio Linares]

Wilson,

FWH proporciona la función WebServer() en source\function\webapp.prg

Code: Select all  Expand view  RUN

function WebServer()

   local oServer := HbWebServer()

   if ! hb_HHasKey( hWebApp, "Dialogs" )
      hWebApp[ "Dialogs" ] = {}
   endif  

   oServer:bOnGet = { || Html() }

   oServer:Run()

return nil