.
Eloquence B.08.00 contact contact

Documentation / The Eloquence Net.DLL

The Eloquence Net.DLL

 
.
  The Eloquence Net.DLL provides a simple interface to TCP and UDP client as well as TCP server networking functionality. This includes connecting and disconnecting, serving incoming connections as well as sending and receiving data.

Contents


Using the Net.DLL

The Net.DLL must be loaded before it can be used in a program:

LOAD DLL Net,2048

This loads the Net.DLL from its default location and establishes a communication buffer of 2048 bytes. For details about the Eloquence LOAD DLL statement please refer to the Eloquence documentation.

The DEL DLL statement may be used to unload the DLL:

DEL DLL Net

The following procedures are available to return information on the Net.DLL or enable logging.


Programming interface

The Eloquence Net.DLL implements the following procedures:

  • CALL DLL Net("Connect",Server$,Service$)
    This connects to a TCP server. Server$ is the host name or IP address of the server to connect. Service$ is the TCP service name or port number. The Net.DLL manages one active TCP or UDP connection. If the Net.DLL is already connected an error 2002 is returned.
    Errors: 2002, 2003, 2004, 2005

  • CALL DLL Net("ConnectUDP",Server$,Service$[,Source$])
    This connects to an UDP server. Server$ is the host name or IP address of the server to connect. Service$ is the UDP service name or port number. Source$ may optionally be used to specify the source service name or port number. If omitted, an available source port number is allocated by the operating system. The Net.DLL manages one active TCP or UDP connection. If the Net.DLL is already connected an error 2002 is returned.
    Errors: 2002, 2003, 2004, 2005

  • CALL DLL Net("Disconnect")
    This closes the active connection. If the Net.DLL is not connected an error 2006 is returned.
    Errors: 2006, 2007

  • CALL DLL Net("Listen",Service$)
    This establishes a TCP listen queue. Service$ is the TCP service name or port number to listen on. On success, incoming connections to the specified TCP port are enqueued and can be established with the Accept call (see below). The Net.DLL manages one active TCP listen queue. If a listen queue is already active an error 2002 is returned.
    Errors: 2002, 2003, 2011

  • CALL DLL Net("CloseListen")
    This closes the active listen queue. If no listen queue is active an error 2006 is returned.
    Errors: 2006, 2007

  • CALL DLL Net("Accept",Peer_addr$,Peer_port)
    This establishes the next incoming TCP connection that is pending in the listen queue. If no new connection is pending, Accept blocks until a new connection can be established. On success, the remote IP address is returned in Peer_addr$ and the remote TCP port number is returned in Peer_port. The Net.DLL manages one active TCP or UDP connection. If the Net.DLL is already connected an error 2002 is returned.
    Errors: 18, 2002, 2006, 2012

  • CALL DLL Net("Select",Status,Timeout)
    This checks if data is available and/or new incoming connections are pending in the listen queue. Status bit 0 (BINAND(Status,1)) will be set if data is available, in which case a subsequent Recv invocation with Timeout set to -1 (see Recv below) will return the received data without blocking. Status bit 1 (BINAND(Status,2)) will be set if new connections are pending, in which case a subsequent Accept invocation will establish the next new connection without blocking. Status bit 2 (BINAND(Status,4)) will be set if a timeout has occurred (see below). If Timeout is zero, Select blocks until the condition is met (i.e., data is available and/or new connections are pending). If Timeout is a positive nonzero value, Recv blocks until either the condition is met or the specified number of milliseconds have elapsed. If Timeout is -1 then Select immediately returns, having Status set to either 0, 1, 2 or 3 depending on whether data is available and/or new connections are pending.
    Errors: 2006, 2013

  • CALL DLL Net("Send",Buf$)
    This transmits the data contained in Buf$ to the peer.
    Errors: 2006, 2008

  • CALL DLL Net("Recv",Buf$,Cnt,Timeout)
    This tries to receive Cnt bytes of data from the peer. The received data is put into Buf$. If Recv returns with an empty Buf$ an end-of-file condition was encountered. If Timeout is zero, Recv blocks until Cnt bytes have been received. If Timeout is a positive nonzero value, Recv blocks until either Cnt bytes have been received or the specified number of milliseconds have elapsed. If Timeout is -1 or Recv is used with the UDP protocol then as much data (up to Cnt bytes) is put into Buf$ as is available without blocking. If a timeout is encountered an error 2010 is returned.
    Errors: 18, 2006, 2009, 2010


Eloquence error codes

In case of a failure, the Net.DLL issues the following error codes:

18 Receive buffer is too small.
Accept Peer_addr$ is to small.
2001 Log file cannot be opened.
2002 Already connected.
2003 Bad service name or port number.
2004 Bad host name or IP address.
2005 Unable to connect.
2006 Not connected.
2007 Disconnect failed.
2008 Send failed.
2009 Receive failed.
2010 Receive timed out.
2011 Listen failed.
2012 Accept failed.
2013 Select failed.

To obtain details about the cause of the specific failure, a log file should be configured.


Example programs

The following examples document how the Net.DLL could be used in a program, including a demonstration of error handling.

The first example illustrates a TCP communication. It connects to a web server on TCP port 80 and fetches the root document.

This example is installed as TCPDEMO.PROG in the Eloquence share/example installation subdirectory and available for download.

! RE-STORE "TCPDEMO,EXAMPLE"
!
! This is a sample application using the Net.DLL.
! It fetches the index.html page from the server using the
! HTTP protocol and displays the HTML source code on screen.
! 
  DIM Server$[80],Uri$[80],Buf$[1024]
  INTEGER Timeout
  ON ERROR GOTO Failed
! 
  Server$="eloquence.marxmeier.com"                 ! Server to connect
  Uri$="/"                                       ! Document on server
  Timeout=10000                                  ! Receive timeout
! 
! LOAD DLL and display version/build date
! 
  LOAD DLL Net,2048
  CALL DLL Net("dll_Revision",Rev$)
  CALL DLL Net("dll_Compiled",Build$)
  DISP "Loaded Net.DLL v"&Rev$&" ("&Build$&")"
! 
! Connect to server
! 
  DISP "Connecting to "&Server$
  CALL DLL Net("Connect",Server$,"80")
! 
  DISP "Sending request for "&Uri$
  Buf$="GET "&Uri$&" HTTP/1.0"&CHR$(10)&CHR$(10)
  CALL DLL Net("Send",Buf$)
! 
  DISP "--- Server Response ---"
  LOOP
     CALL DLL Net("Recv",Buf$,1024,Timeout)
     EXIT IF NOT LEN(Buf$)
     LOOP
        P=POS(Buf$,CHR$(10))
        EXIT IF NOT P
        LDISP Buf$[1,P]
        Buf$=Buf$[P+1]
     END LOOP
     IF LEN(Buf$) THEN LDISP Buf$;
  END LOOP
  DISP "--- End of Data ---"
! 
  DISP "Disconnecting"
  CALL DLL Net("Disconnect")
  DISP "Done."
  DEL DLL Net
  STOP
! 
Failed: ! 
  DISP LIN(1);"-- Program failed --"
  DISP ERRM$
  IF (ERRN<2001) OR (ERRN>2010) THEN 
     DISP ERRMSG$(ERRN)
  ELSE
     DATA 2001,"Log file cannot be opened"
     DATA 2002,"Already connected"
     DATA 2003,"Bad service name or port number"
     DATA 2004,"Bad host name or ip address"
     DATA 2005,"Unable to connect"
     DATA 2006,"Not connected"
     DATA 2007,"Disconnect failed"
     DATA 2008,"Send failed"
     DATA 2009,"Receive failed"
     DATA 2010,"Receive timed out"
     DATA -1,"Error message not found"
! 
     RESTORE Failed
     REPEAT 
        READ Err,Buf$
     UNTIL (Err=ERRN) OR (Err=-1)
     DISP "Net.DLL: "&Buf$
  END IF
  STOP


The second example illustrates an UDP communication. It uses the UDP echo protocol (UDP port 7) which responds by simply sending back the exact data it received.

This example is installed as UDPDEMO.PROG in the Eloquence share/example installation subdirectory and available for download.

! RE-STORE "UDPDEMO,EXAMPLE"
!
! This is a sample application using the Net.DLL.
! It uses the UDP echo protocol (port 7) to send a datagram
! and then expects a reply datagram with the same contents.
! Note: This program won't work unless you change the server
! address below to the address of one of your machines and
! change the (x)inetd configuration so that this machine
! answers to incoming UDP echo requests.
! 
  DIM Server$[80],Buf$[80]
  INTEGER Timeout
  ON ERROR GOTO Failed
! 
  Server$="server.domain.com"                    ! Server to connect
  Timeout=1000                                   ! Receive timeout
! 
! LOAD DLL and display version/build date
! 
  LOAD DLL Net,2048
  CALL DLL Net("dll_Revision",Rev$)
  CALL DLL Net("dll_Compiled",Build$)
  DISP "Loaded Net.DLL v"&Rev$&" ("&Build$&")"
! 
! Connect to server
! 
  DISP "Connecting to "&Server$
  CALL DLL Net("ConnectUDP",Server$,"7")
! 
  DISP "Sending echo request"
  Buf$="A TEST MESSAGE"
  CALL DLL Net("Send",Buf$)
! 
  DISP "Waiting for echo response"
  Buf$="WILL BE OVERWRITTEN"
  CALL DLL Net("Recv",Buf$,80,Timeout)
  DISP "Response: ["&Buf$&"]"
! 
  DISP "Disconnecting"
  CALL DLL Net("Disconnect")
  DISP "Done."
  DEL DLL Net
  STOP
! 
Failed: ! 
  DISP LIN(1);"-- Program failed --"
  DISP ERRM$
  IF (ERRN<2001) OR (ERRN>2010) THEN 
     DISP ERRMSG$(ERRN)
  ELSE
     DATA 2001,"Log file cannot be opened"
     DATA 2002,"Already connected"
     DATA 2003,"Bad service name or port number"
     DATA 2004,"Bad host name or ip address"
     DATA 2005,"Unable to connect"
     DATA 2006,"Not connected"
     DATA 2007,"Disconnect failed"
     DATA 2008,"Send failed"
     DATA 2009,"Receive failed"
     DATA 2010,"Receive timed out"
     DATA -1,"Error message not found"
! 
     RESTORE Failed
     REPEAT 
        READ Err,Buf$
     UNTIL (Err=ERRN) OR (Err=-1)
     DISP "Net.DLL: "&Buf$
  END IF
  STOP


The third example implements a simple server program. It demonstrates the use of the Select, Listen and Accept functions.

The purpose of this server example is to print any data that has been received from the client. To test this, the telnet 192.168.44.55 8888 command may be used, where 192.168.44.55 should be replaced with the IP address of the system where this example program runs and 8888 is the number of the TCP listen port configured in the program.

This example is installed as ECHOSRV.PROG in the Eloquence share/example installation subdirectory and available for download.

     ! RE-STORE "ECHOSRV"
     ! 
     ! This is a simple example program to demonstrate the use
     ! of the Eloquence Net.DLL.  This program opens a server
     ! 8888 and waits for a connection.  It then prints any
     ! data it receives from this connection.
     ! 
     ! The use of select allows to exit the program with a
     ! function key, otherwise it would block in the Net.DLL
     ! Note that this program only handles a single connection.
     ! 
     ! Use telnet to test the program (telnet server 8888)
     ! The connection is disconnected if the letter q or Q
     ! is found in the data.
     ! 
       DIM Msg$[80],Peer_addr$[80],Buf$[256]
       INTEGER Peer_port,Status
     ! 
       Service$="8888"
     ! 
     ! LOAD DLL
     ! 
       ON ERROR GOTO Failed
       LOAD DLL Net,2048
       CALL DLL Net("dll_Revision",Rev$)
       CALL DLL Net("dll_Compiled",Build$)
       DISP "Loaded Net.DLL v"&Rev$&" ("&Build$&")"
     ! 
     ! Open server port
     ! 
       ON KEY #8:"END PROGRAM" GOTO Exit
       DISP "Listening on service "&Service$
       CALL DLL Net("Listen",Service$)
     ! 
     ! Wait for next request
     ! This uses select to return every second to the program
     ! to allow using function keys
     ! 
       LOOP
         ON ERROR GOTO Failed
         REPEAT 
           CALL DLL Net("Select",Status,1000)
         UNTIL BINAND(Status,2)
         GOSUB Connection
       END LOOP
     ! 
Exit:      ! 
       PRINT "*** DONE ***"
       STOP
     ! 
     ! Handle connection
     ! 
Connection:     ! 
       ON ERROR GOTO Accept_failed
       CALL DLL Net("Accept",Peer_addr$,Peer_port)
       PRINT "Connected to "&Peer_addr$&" port "&VAL$(Peer_port)
     ! 
       ON ERROR GOTO Recv_failed
       LOOP
     ! 
     ! Wait for new data
     ! This uses select to return every second to allow using
     ! function keys
     ! 
         REPEAT 
           CALL DLL Net("Select",Status,1000)
         UNTIL BINAND(Status,1)
     ! 
     ! Read data, assume EOF on empty read
     ! 
         CALL DLL Net("Recv",Buf$,256,-1)
         EXIT IF NOT LEN(Buf$)
     ! 
         PRINT LEN(Buf$);":";
         FOR I=1 TO LEN(Buf$)
           IF (NUM(Buf$[I])>=32) AND (NUM(Buf$[I])<128) THEN 
             PRINT Buf$[I;1];
           ELSE
             PRINT "<";NUM(Buf$[I]);">";
           END IF
         NEXT I
         PRINT 
     ! 
         CALL DLL Net("Send","RECEIVED "&VAL$(LEN(Buf$))&" BYTES"&CHR$(13)&CHR$(10))
         EXIT IF POS(Buf$,"Q") OR POS(Buf$,"q")
       END LOOP
     ! 
       CALL DLL Net("Send","BYE BYE"&CHR$(13)&CHR$(10))
     ! 
Disconnect:     ! 
       CALL DLL Net("Disconnect")
       DISP "Disconnected from "&Peer_addr$&" port "&VAL$(Peer_port)
       RETURN 
     ! 
Accept_failed:     ! 
       PRINT "ACCEPT FAILED"
       GOSUB Explain
       RETURN 
     ! 
Recv_failed:     ! 
       PRINT "CONNECTION FAILED"
       GOSUB Explain
       GOTO Disconnect
     ! 
     ! Error handling
     ! 
Failed:      ! 
       OFF ERROR
       PRINT LIN(1);"-- Program failed --"
       GOSUB Explain
       STOP
     ! 
Explain:      ! 
       IF (ERRN<2001) OR (ERRN>2013) THEN 
         PRINT ERRM$
       ELSE
         DATA   2001,"Log file cannot be opened"
         DATA   2001,"Log file cannot be opened"
         DATA   2002,"Already connected"
         DATA   2003,"Bad service name or port number"
         DATA   2004,"Bad host name or ip address"
         DATA   2005,"Unable to connect"
         DATA   2006,"Not connected"
         DATA   2007,"Disconnect failed"
         DATA   2008,"Send failed"
         DATA   2009,"Receive failed"
         DATA   2010,"Receive timed out"
         DATA   2011,"Listen failed"
         DATA   2012,"Accept failed"
         DATA   2013,"Select failed"
         DATA   -1,"Error message not found"
      ! 
         RESTORE Failed
         REPEAT 
           READ Err,Msg$
         UNTIL (Err=ERRN) OR (Err=-1)
         PRINT "Net.DLL: "&Msg$
       END IF
       RETURN 


The fourth example implements a very basic HTTP server. It demonstrates the use of the Select, Listen and Accept functions.

An URL like http://192.168.44.55:8888 may be used to establish a connection, where 192.168.44.55 should be replaced with the IP address of the system where this example program runs and 8888 is the number of the TCP listen port configured in the program.

This example is installed as HTTPSRV.PROG in the Eloquence share/example installation subdirectory and available for download.

! RE-STORE "HTTPSRV"
! This is a sample application using the Net.DLL.
! It implements a very simple HTTP server.
! 
  DIM Service$[80],Peer_addr$[80],Buf$[1024],Request$[1024]
  INTEGER Peer_port,Status,Timeout,Line_no,Len
  ON ERROR GOTO Failed
! 
  Service$="8888"                                ! Service to listen on
  Timeout=10000                                  ! Receive timeout
! 
! LOAD DLL and display version/build date
! 
  LOAD DLL Net,2048
  CALL DLL Net("dll_Revision",Rev$)
  CALL DLL Net("dll_Compiled",Build$)
  DISP "Loaded Net.DLL v"&Rev$&" ("&Build$&")"
! 
! Setup server listen queue
! 
  DISP "Listening on service "&Service$
  CALL DLL Net("Listen",Service$)
! 
! Serve incoming requests (endless loop)
! 
  Crlf$=CHR$(13)&CHR$(10)
! 
  LOOP
   ! 
   ! Wait for next request
   ! 
   ! Optional:
   ! The following loop is used for "multitasking", i.e., doing something
   ! useful while there is no incoming request pending. The implementation
   ! below in fact does nothing useful but instead issues a SLEEP. However,
   ! it should demonstrate well enough how multitasking could be implemented.
   ! 
   ! The Select call will return with Status bit 1 set (BINAND(Status,2))
   ! as soon as a new incoming request has arrived.
   ! 
     LOOP
        CALL DLL Net("Select",Status,-1)
        EXIT IF BINAND(Status,2)
        SLEEP 500
     END LOOP
   ! 
   ! Accept new request
   ! 
     CALL DLL Net("Accept",Peer_addr$,Peer_port)
   ! 
     DISP LIN(1);RPT$("-",70)
     DISP "Connected to "&Peer_addr$&" port "&VAL$(Peer_port)
     DISP RPT$("-",70)
   ! 
   ! Read HTTP header
   ! 
   ! Because the size of the HTTP header is unknown, Select is used to
   ! block until data has arrived, then Recv is used to read as much
   ! data as is availiable without blocking (by using a -1 timeout).
   ! 
   ! Select will return with Status bit 0 set (BINAND(Status,1)) as soon
   ! as data is available. We specify a timeout here to make sure that
   ! we don't block forever in case the peer sends an incomplete HTTP
   ! header. On timeout, Select will return with Status bit 2 set
   ! (BINAND(Status,4)).
   ! 
   ! The HTTP header lines are separated by CHR$(10) or CHR$(13)/CHR$(10).
   ! The first line contains the request type and the URI, which is why
   ! it is stored separately in Request$.
   ! 
   ! An empty line indicates the end of the HTTP header.
   ! 
   ! For demonstration purposes, the HTTP header is output with LDISP.
   ! 
     Request$=""
     Line_no=0
     Len=0
   ! 
     LOOP
        CALL DLL Net("Select",Status,Timeout)
        EXIT IF BINAND(Status,4)
        IF BINAND(Status,1) THEN 
           CALL DLL Net("Recv",Buf$,1024,-1)
           EXIT IF NOT LEN(Buf$)
         ! 
         ! Remove CR characters to make sure that (a) Request$ does not
         ! contain a CR at the end of the URI and (b) an empty line can
         ! be easily detected.
         ! 
           LOOP
              P=POS(Buf$,CHR$(13))
              EXIT IF NOT P
              Buf$=Buf$[1,P-1]&Buf$[P+1]
           END LOOP
         ! 
           LOOP
              P=POS(Buf$,CHR$(10))
              EXIT IF NOT P
            ! 
            ! Append to Request$ if this is the first line
            ! 
              IF NOT Line_no THEN Request$=Request$&Buf$[1,P-1]
            ! 
              LDISP Buf$[1,P-1]
              Len=Len+LEN(Buf$[1,P-1])
            ! 
            ! Exit the loop on the first empty line
            ! 
              IF NOT Len THEN GOTO Header_done
            ! 
              Buf$=Buf$[P+1]
              Line_no=Line_no+1
              Len=0
           END LOOP
         ! 
         ! Append to Request$ if this is the first line
         ! 
           IF NOT Line_no THEN Request$=Request$&Buf$
         ! 
           IF LEN(Buf$) THEN LDISP Buf$;
           Len=Len+LEN(Buf$)
        END IF
     END LOOP
   ! 
Header_done: ! 
   ! 
   ! Request$ now contains the request type (GET, POST, HEAD, ...)
   ! followed by the URI, optionally followed by a protocol version
   ! descriptor such as HTTP/1.1. The fields are space-separated.
   ! 
   ! Check if this is a GET request, otherwise return status 400.
   ! 
     P=POS(Request$," ")
     IF NOT P OR (Request$[1,P-1]<>"GET") THEN 
        DISP "Bad request: "&Request$
      ! 
        Buf$="HTTP/1.0 400 Bad Request"&Crlf$&Crlf$
        Buf$=Buf$&"<html>"&Crlf$
        Buf$=Buf$&"<head><title>400 Bad Request</title></head>"&Crlf$
        Buf$=Buf$&"<body>"&Crlf$
        Buf$=Buf$&"<h1>400 Bad Request</h1>"&Crlf$
        Buf$=Buf$&"</body>"&Crlf$
        Buf$=Buf$&"</html>"&Crlf$
        CALL DLL Net("Send",Buf$)
      ! 
        GOTO Request_done
     END IF
   ! 
   ! Extract URI
   ! 
     Request$=Request$[P+1]
     P=POS(Request$," ")
     IF P THEN Request$=Request$[1,P-1]
     DISP "URI: "&Request$
   ! 
   ! Send response HTTP header to client
   ! 
     Buf$="HTTP/1.0 200 OK"&Crlf$
     Buf$=Buf$&"Content-Type: text/html"&Crlf$&Crlf$
     CALL DLL Net("Send",Buf$)
   ! 
   ! At this point, a real HTTP server would use the URI to load
   ! a document and return it to the client.
   ! To keep this demo program simple we just return some info
   ! about the request: the peer IP address and port number and the URI.
   ! 
     Buf$="<html>"&Crlf$
     Buf$=Buf$&"<head><title>Response from HTTPSRV</title></head>"&Crlf$
     Buf$=Buf$&"<body>"&Crlf$
     Buf$=Buf$&"<h3>Response from HTTPSRV</h3>"&Crlf$
     Buf$=Buf$&"IP Address: "&Peer_addr$&"<br>"&Crlf$
     Buf$=Buf$&"Port: "&VAL$(Peer_port)&"<br>"&Crlf$
     Buf$=Buf$&"URI: "&Request$&Crlf$
     Buf$=Buf$&"</body>"&Crlf$
     Buf$=Buf$&"</html>"&Crlf$
     CALL DLL Net("Send",Buf$)
   ! 
Request_done: ! 
     CALL DLL Net("Disconnect")
     DISP "Disconnected from "&Peer_addr$&" port "&VAL$(Peer_port)
  END LOOP
  STOP
! 
Failed: ! 
  DISP LIN(1);"-- Program failed --"
  DISP ERRM$
  IF (ERRN<2001) OR (ERRN>2013) THEN 
     DISP ERRMSG$(ERRN)
  ELSE
     DATA 2001,"Log file cannot be opened"
     DATA 2002,"Already connected"
     DATA 2003,"Bad service name or port number"
     DATA 2004,"Bad host name or ip address"
     DATA 2005,"Unable to connect"
     DATA 2006,"Not connected"
     DATA 2007,"Disconnect failed"
     DATA 2008,"Send failed"
     DATA 2009,"Receive failed"
     DATA 2010,"Receive timed out"
     DATA 2011,"Listen failed"
     DATA 2012,"Accept failed"
     DATA 2013,"Select failed"
     DATA -1,"Error message not found"
! 
     RESTORE Failed
     REPEAT 
        READ Err,Buf$
     UNTIL (Err=ERRN) OR (Err=-1)
     DISP "Net.DLL: "&Buf$
  END IF
  STOP


 
 
.
 
 
  Privacy | Webmaster | Terms of use | Impressum Revision:  2021-10-19  
  Copyright © 2021 Marxmeier Software AG