BASIC ZMQ Server

' See ZMQHelpers.inc for s_send and s_recv consolidation

' ZMQ Server Example that receives a Query and returns a response

#COMPILE EXE "ZMQSrvr.exe"

#INCLUDE "ZMQ.inc"
                    

$DEBUG_FILE = "ZMQ_Server_Debug.txt"

GLOBAL hDbg, gDone AS LONG



'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB CopyMem( BYVAL pDS AS DWORD, BYVAL pSrc AS DWORD, BYVAL CopyLen AS DWORD )

'   MoveMemory BYVAL pDS, BYVAL pSrc, BYVAL CopyLen  // Win API

    #REGISTER NONE

      ! cld

      ! mov esi, pSrc
      ! mov edi, pDS
      ! mov ecx, CopyLen

      ! shr ecx, 2
      ! rep movsd

      ! mov ecx, CopyLen
      ! AND ecx, 3
      ! rep movsb

END SUB
           

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
FUNCTION MakeServer( sBindTo AS STRING ) AS LONG


  LOCAL i, RetVal, MsgSz AS LONG
  LOCAL pCtx, pSoc AS DWORD
  LOCAL pData AS ASCIIZ PTR
  LOCAL pMsgIn, pMsgOut AS zmq_msg_t
  LOCAL sQuery, sResponse AS STRING
  LOCAL pzErr AS ASCIIZ PTR



    pCtx = zmq_init(1) ' Initialise 0MQ context - app_threads, io_threads, flags
    IF pCtx = 0 THEN
      pzErr = zmq_strerror(zmq_errno)
      PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_init: " + @pzErr
      FUNCTION = -1
      EXIT FUNCTION
    END IF
    '=============

    DO ' device to jump out and still close socket and release ZMQ library

        pSoc = zmq_socket( pCtx, %ZMQ_REP )
        IF pSoc = 0 THEN
          pzErr = zmq_strerror(zmq_errno)
          PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_socket: " + STR$(zmq_strerror(ERR))
          FUNCTION = -2
          EXIT DO
        END IF
        '=============


        RetVal = zmq_bind( pSoc, STRPTR(sBindTo) ) ' Prefer ASCIIZ
        IF RetVal < 0 THEN
          pzErr = zmq_strerror(zmq_errno)
          PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_bind: " + STR$(zmq_strerror(ERR))
          FUNCTION = -3
          EXIT DO
        END IF
        '=============



        WHILE gDone = 0

          RetVal = zmq_msg_init(VARPTR(pMsgIn)) ' Initialise 0MQ context, requesting a single application thread and a single i/o thread
          IF RetVal < 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_msg_init: " + STR$(zmq_strerror(ERR))
            FUNCTION = -4
            EXIT DO
          END IF
                        
          RetVal = zmq_recv( pSoc, VARPTR(pMsgIn), 0 ) ' Receive a message, blocks until one is available
          IF RetVal < 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_recv: " + STR$(zmq_strerror(ERR))
            FUNCTION = -5
            EXIT DO
          END IF

          MsgSz = zmq_msg_size(VARPTR(pMsgIn)) ' Check Message for content
          IF MsgSz = 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "message size=0"
            FUNCTION = -6
            EXIT DO
          END IF

          pData = zmq_msg_data(VARPTR(pMsgIn)) ' Recover the query
          IF pData = 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "message data pointer error"
            FUNCTION = -7
            EXIT DO
          END IF

          sQuery = NUL$(MsgSz) ' Allocate memory
          CopyMem( STRPTR(sQuery), pData, MsgSz ) ' Copy message to local string

          RetVal = zmq_msg_close(VARPTR(pMsgIn)) ' Close the query
          IF RetVal < 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_msg_close: " + STR$(zmq_strerror(ERR))
            FUNCTION = -8
            EXIT DO
          END IF
          '=============
PRINT #hDbg, "Received message:" + sQuery
                

          sResponse = "OK" ' Create Response

          RetVal = zmq_msg_init_size( VARPTR(pMsgOut), LEN(sResponse) ) ' Allocate a response message
          IF RetVal < 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_msg_init_size: " + STR$(zmq_strerror(ERR))
            FUNCTION = -9
            EXIT DO
          END IF

          CopyMem( zmq_msg_data(VARPTR(pMsgOut)), STRPTR(sResponse), LEN(sResponse) ) ' Copy message to ZMQ

          RetVal = zmq_send( pSoc, VARPTR(pMsgOut), 0) ' Send back the response
          IF RetVal <> 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "error sending response: " + STR$(zmq_strerror(ERR))
            FUNCTION = -10
            EXIT DO
          END IF

          RetVal = zmq_msg_close(VARPTR(pMsgOut)) ' Close the message
          IF RetVal < 0 THEN
            pzErr = zmq_strerror(zmq_errno)
            PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_msg_close: " + STR$(zmq_strerror(ERR))
            FUNCTION = -11
            EXIT DO
          END IF
          '=============
                          

          IF INSTR(sQuery, "END SERVER") THEN ' End Server
PRINT #hDbg, "Server shutting down"
            EXIT LOOP
          END IF
          '=============

        WEND

        EXIT DO
    LOOP


    SLEEP 1 ' CALL zmq_sleep(1)

    IF pSoc THEN
      RetVal = zmq_close(pSoc)
      IF RetVal < 0 THEN
        pzErr = zmq_strerror(zmq_errno)
        PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_close: " + STR$(zmq_strerror(ERR))
        FUNCTION = -12
        EXIT FUNCTION
      END IF
    END IF
    '=============


    RetVal = zmq_term(pCtx)
    IF RetVal < 0 THEN
      pzErr = zmq_strerror(zmq_errno)
      PRINT #hDbg, "error"+STR$(zmq_errno)+" in zmq_term: " + STR$(zmq_strerror(ERR))
      FUNCTION = -13
      EXIT FUNCTION
    END IF
    '=============



END FUNCTION

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
FUNCTION WINMAIN

  LOCAL hDlg, RetVal AS LONG
  LOCAL tWSA AS WSAData


    WSAStartup(&H0202?, tWSA) ' Always initialize WSAStartUp in applications using Sockets

hDbg = FREEFILE : OPEN $DEBUG_FILE FOR OUTPUT LOCK SHARED AS hDbg '
PRINT #hDbg, "--------  "+DATE$+"  "+TIME$+"  ---------"

  RetVal = MakeServer( "tcp://*:5555" )
  IF RetVal < 0 THEN
    PRINT #hDbg, "Server Failed Error=" + STR$(RetVal)
  END IF

PRINT #hDbg, "All Done"
CLOSE #hDbg

     WSACleanup()

END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'

powerbasic

Comments