CREATE WIDGET-POOL.
&SCOPED-DEFINE WSADATA_LENGTH 403
&SCOPED-DEFINE AF_INET 2
&SCOPED-DEFINE SOCK_STREAM 1
&SCOPED-DEFINE SOCKET_ERROR -1
&SCOPED-DEFINE HOSTENT_ADDR_LIST 13
&SCOPED-DEFINE INVALID_SOCKET -1
DEF VAR h_retval AS INT NO-UNDO.
DEF VAR h_wsa_data_ptr AS MEMPTR NO-UNDO.
DEF VAR h_socket_ptr AS INT NO-UNDO.
/* convert 'dotted' ipaddress into in_addr */
PROCEDURE inet_addr EXTERNAL 'WS2_32.DLL':
DEFINE INPUT PARAMETER HostName AS CHARACTER.
DEFINE RETURN PARAMETER HostAddr AS LONG.
END PROCEDURE.
/* convert in_addr into a 'dotted' format */
PROCEDURE inet_ntoa EXTERNAL 'WS2_32.DLL':
DEFINE INPUT PARAMETER HostAddr AS LONG.
DEFINE RETURN PARAMETER HostName AS MEMPTR.
END PROCEDURE.
/* initialize the sockets dll */
PROCEDURE WSAStartup EXTERNAL 'wsock32.dll' :
DEFINE INPUT PARAMETER p-VersionReq AS SHORT.
DEFINE INPUT PARAMETER h_wsa_data_ptr AS LONG.
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
/* terminates the use of the sockets dll */
PROCEDURE WSACleanup EXTERNAL 'wsock32.dll':
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
/* gets the error status for the last operation which failed */
PROCEDURE WSAGetLastError EXTERNAL 'wsock32.dll':
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
/* creates a socket which is bound to a specific service provider. */
PROCEDURE socket EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_af AS LONG.
DEFINE INPUT PARAMETER p_type AS LONG.
DEFINE INPUT PARAMETER p_prot AS LONG.
DEFINE RETURN PARAMETER p_socket_ptr AS LONG.
END PROCEDURE.
/* closes a socket */
PROCEDURE closesocket EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_socket_ptr AS LONG.
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
/* set socket mode */
PROCEDURE ioctlsocket EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_socket_ptr AS LONG.
DEFINE INPUT PARAMETER p_cmd AS LONG.
DEFINE INPUT PARAMETER p_arg AS LONG.
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
/* Connect!! */
PROCEDURE connect EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_socket_ptr AS LONG.
DEFINE INPUT PARAMETER p_sockaddr_in AS MEMPTR.
DEFINE INPUT PARAMETER p_name_len AS LONG.
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
/* disables sends and/or receives on a socket */
PROCEDURE shutdown EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_socket_ptr AS LONG.
DEFINE INPUT PARAMETER p_how AS LONG.
END PROCEDURE.
/* converts a u_short from host to TCP/IP network byte order */
PROCEDURE htons EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_port_h AS UNSIGNED-SHORT.
DEFINE RETURN PARAMETER p_port_n AS UNSIGNED-SHORT.
END PROCEDURE.
/* determines socket status, waiting as specified */
PROCEDURE select EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_ndfs AS LONG.
DEFINE INPUT PARAMETER p_readfds AS MEMPTR.
DEFINE INPUT PARAMETER p_writefds AS MEMPTR.
DEFINE INPUT PARAMETER p_exceptfds AS MEMPTR.
DEFINE INPUT PARAMETER p_timeout AS MEMPTR.
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
PROCEDURE gethostbyname EXTERNAL 'wsock32.dll':
DEFINE INPUT PARAMETER p_host_addr AS CHAR.
DEFINE RETURN PARAMETER p_return AS LONG.
END PROCEDURE.
PROCEDURE int_nbs_connect:
DEF INPUT PARAM p_server_name AS CHAR NO-UNDO.
DEF INPUT PARAM p_port AS CHAR NO-UNDO.
DEF OUTPUT PARAM p_success AS INT INIT 0 NO-UNDO.
DEF VAR h_structsize AS INT INIT 0 NO-UNDO.
DEF VAR h_sockaddr_in AS MEMPTR NO-UNDO.
DEF VAR h_sin_family AS MEMPTR NO-UNDO.
DEF VAR h_addr_struct AS MEMPTR NO-UNDO.
DEF VAR h_sin_port AS MEMPTR NO-UNDO.
DEF VAR h_sin_zero AS MEMPTR NO-UNDO.
DEF VAR h_addr AS INT NO-UNDO.
DEF VAR h_port_n AS INT NO-UNDO.
DEF VAR h_nbio AS INT INIT 1 NO-UNDO.
DEF VAR h_nbio_ptr AS MEMPTR NO-UNDO.
DEF VAR h_fionbio_ptr AS MEMPTR NO-UNDO.
DEF VAR h_ip_addr AS CHAR NO-UNDO.
SET-SIZE(h_wsa_data_ptr) = {&WSADATA_LENGTH}.
RUN WSAStartup (INPUT 257, /* requested version 1.1 */
INPUT GET-POINTER-VALUE(h_wsa_data_ptr),
OUTPUT h_retval).
/* Release allocated memory */
SET-SIZE(h_wsa_data_ptr) = 0.
IF h_retval <> 0
THEN DO:
ASSIGN p_success = 1.
RETURN.
END.
/* create socket */
RUN socket (INPUT {&AF_INET},
INPUT {&SOCK_STREAM},
INPUT 0,
OUTPUT h_socket_ptr).
/* check for error on socket init call */
IF h_socket_ptr = {&INVALID_SOCKET}
THEN DO:
ASSIGN p_success = {&INVALID_SOCKET}.
RETURN.
END.
/* set socket options */
SET-SIZE(h_nbio_ptr) = 4.
SET-SIZE(h_fionbio_ptr) = 4.
PUT-LONG(h_nbio_ptr,1) = h_nbio.
PUT-BYTE(h_fionbio_ptr,4) = 128.
PUT-BYTE(h_fionbio_ptr,3) = 4.
PUT-BYTE(h_fionbio_ptr,2) = 102.
PUT-BYTE(h_fionbio_ptr,1) = 126.
RUN ioctlsocket(INPUT h_socket_ptr,
INPUT GET-LONG (h_fionbio_ptr,1),
INPUT GET-POINTER-VALUE (h_nbio_ptr),
OUTPUT h_retval).
SET-SIZE(h_nbio_ptr) = 0.
SET-SIZE(h_fionbio_ptr) = 0.
/* check for error on socket init call */
IF h_retval <> 0
THEN DO:
ASSIGN p_success = h_retval.
RETURN.
END.
/* connect */
SET-SIZE(h_addr_struct) = 4.
SET-SIZE(h_sockaddr_in) = 16.
h_port_n = INTEGER (p_port).
/* change the byte order of the port */
RUN htons (INPUT h_port_n,
OUTPUT h_port_n).
/* determine address */
IF p_server_name <> ""
AND p_port <> ""
THEN DO:
/* change the server name into a dotted IP address */
RUN INT_get_host_by_name(INPUT p_server_name,
OUTPUT h_ip_addr) NO-ERROR.
/* if 0.0.0.0 was returned then gethostbyname was unable
to determine the address */
IF h_ip_addr = "0.0.0.0"
THEN DO:
ASSIGN p_success = ?.
RETURN.
END.
/* change the n.n.n.n address style to an in_addr that the api
can understand. */
RUN inet_addr(INPUT h_ip_addr,
OUTPUT h_addr) NO-ERROR.
END.
ELSE DO:
ASSIGN p_success = ?.
RETURN.
END.
PUT-SHORT(h_sockaddr_in,1) = 2.
PUT-SHORT(h_sockaddr_in,3) = h_port_n.
PUT-LONG(h_sockaddr_in,5) = h_addr.
PUT-LONG(h_sockaddr_in,9) = 0. /* padding */
h_structsize = 16. /* size of the data struct pointed to by h_sockaddr_in */
RUN connect (INPUT h_socket_ptr,
INPUT h_sockaddr_in,
INPUT h_structsize,
OUTPUT h_retval).
/* because we are using non-blocking sockets connect always returns -1
SOCKET_ERROR because the connect has not completed yet. WSAGetLastError
will return WSAEWOULDBLOCK. */
IF h_retval = {&SOCKET_ERROR}
THEN RUN WSAGetLastError (OUTPUT h_retval).
/* check for error on socket init call */
IF h_retval <> 0
THEN DO:
ASSIGN p_success = h_retval.
END.
SET-SIZE(h_addr_struct) = 0.
SET-SIZE(h_sockaddr_in) = 0.
END PROCEDURE.
/* This procedure will check to see if the socket is ready to read, write,
or if it has had an exception. If it is ready to read or write you are
connected!
Inputs - p_wait_secs - the number of seconds you want to give this thing
to determine what is going on. If it does not see
anything ready to read or write in the time you've given
it will return 0.
p_wait_usecs - the number of microseconds you want to give this thing
to determine what is going on. If it does not see
anything ready to read or write in the time you've given
it will return 0. You can use either secs or usecs or in combination.
zero is an acceptable option. 1000000 usecs = 1 sec
p_success - select() returns the total number of descriptors which are ready and
contained in the fd_set structures, or 0 if the time limit expired,
or SOCKET_ERROR if an error occurred. If the return value is SOCKET_ERROR,
WSAGetLastError() is used to retrieve a specific error code.
*/
PROCEDURE int_nbs_select:
DEF INPUT PARAM p_wait_secs AS INT INIT 0 NO-UNDO.
DEF INPUT PARAM p_wait_usecs AS INT INIT 0 NO-UNDO.
DEF OUTPUT PARAM p_success AS INT INIT 0 NO-UNDO.
DEF VAR h_timeval_ptr AS MEMPTR NO-UNDO.
DEF VAR h_sockstr_ptr AS MEMPTR NO-UNDO.
DEF VAR h_null_ptr AS MEMPTR NO-UNDO.
/*
struct timeval {
long tv_sec; /* seconds */
long tv_usec; /* and microseconds */
};
*/
/*
typedef struct fd_set {
u_short fd_count; /* how many are SET? */
SOCKET fd_array[FD_SETSIZE]; /* an array of SOCKETs */
} fd_set;
*/
SET-SIZE(h_timeval_ptr) = 8.
PUT-LONG(h_timeval_ptr,1) = p_wait_secs.
PUT-LONG(h_timeval_ptr,5) = p_wait_usecs.
SET-SIZE(h_sockstr_ptr) = 260.
PUT-LONG(h_sockstr_ptr,1) = 1.
PUT-LONG(h_sockstr_ptr,5) = h_socket_ptr.
SET-SIZE(h_null_ptr) = 4.
PUT-LONG(h_null_ptr,1) = 0.
RUN select (INPUT 0,
INPUT h_sockstr_ptr, /* tell me if we are ready to read */
INPUT h_sockstr_ptr, /* tell me if we are ready to write */
INPUT h_null_ptr, /* don't tell me if there was an exception */
INPUT h_timeval_ptr,
OUTPUT h_retval).
ASSIGN p_success = h_retval.
IF h_retval = {&SOCKET_ERROR}
THEN DO:
RUN WSAGetLastError (OUTPUT h_retval).
/* check for error on socket init call */
IF h_retval <> 0
THEN DO:
ASSIGN p_success = h_retval.
END.
END.
SET-SIZE(h_timeval_ptr) = 0.
SET-SIZE(h_sockstr_ptr) = 0.
SET-SIZE(h_null_ptr) = 0.
END PROCEDURE.
PROCEDURE int_nbs_close:
DEF OUTPUT PARAM p_success AS INT INIT 0 NO-UNDO.
RUN shutdown (INPUT h_socket_ptr,
INPUT 2).
/* check for error on socket init call */
IF h_retval <> 0
THEN DO:
RUN WSAGetLastError (OUTPUT h_retval).
ASSIGN p_success = h_retval.
END.
RUN closesocket (INPUT h_socket_ptr,
OUTPUT h_retval).
/* check for error on socket init call */
IF h_retval <> 0
THEN DO:
RUN WSAGetLastError (OUTPUT h_retval).
ASSIGN p_success = h_retval.
END.
RUN WSACleanup (OUTPUT h_retval).
END.
PROCEDURE int_get_host_by_name:
DEF INPUT PARAM p_host_name AS CHAR NO-UNDO.
DEF OUTPUT PARAM p_numeric_addr AS CHAR NO-UNDO.
DEF VAR h_hostent AS INT NO-UNDO.
DEF VAR h_hostent_ptr AS MEMPTR NO-UNDO.
DEF VAR h_addrlist_ptr AS MEMPTR NO-UNDO.
DEF VAR h_listentry_ptr AS MEMPTR NO-UNDO.
DEF VAR h_addrstring_ptr AS MEMPTR NO-UNDO.
DEF VAR h_tcplong AS INT NO-UNDO.
RUN gethostbyname(INPUT p_host_name,
OUTPUT h_hostent).
IF h_hostent = 0
THEN DO:
/* we were unable to get host name */
p_numeric_addr = "0.0.0.0".
END.
ELSE DO:
/* Set pointer to HostEnt data structure */
SET-POINTER-VALUE(h_hostent_ptr) = h_hostent.
/* "Chase" pointers to get to first address list entry */
SET-POINTER-VALUE(h_addrlist_ptr) = GET-LONG(h_hostent_ptr,
{&HOSTENT_ADDR_LIST}).
SET-POINTER-VALUE(h_listentry_ptr) = GET-LONG(h_addrlist_ptr, 1).
ASSIGN h_tcplong = GET-LONG(h_listentry_ptr, 1).
RUN inet_ntoa (INPUT h_tcplong,
OUTPUT h_addrstring_ptr).
/* Pass back gathered info */
p_numeric_addr = GET-STRING(h_addrstring_ptr, 1).
END.
END.
