PBMiner

$PBExportHeader$n_winsock.sru
$PBExportComments$Winsock object
forward
global type n_winsock from nonvisualobject
end type
type wsadata from structure within n_winsock
end type
type in_addr from structure within n_winsock
end type
type sockaddr_in from structure within n_winsock
end type
type sockaddr_in6 from structure within n_winsock
end type
type in6_addr from structure within n_winsock
end type
type addrinfo from structure within n_winsock
end type
end forward

type wsadata from structure
   unsignedinteger      wversion
   unsignedinteger      whighversion
   character      szdescription[257]
   character      szsystemstatus[129]
   unsignedinteger      imaxsockets
   unsignedinteger      imaxudpdg
   unsignedlong      lpvenderinfo
end type

type in_addr from structure
   unsignedlong      s_addr
end type

type sockaddr_in from structure
   unsignedinteger      sin_family
   unsignedinteger      sin_port
   in_addr     sin_addr
   character      sin_zero[8]
end type

type sockaddr_in6 from structure
   unsignedinteger      sin6_family
   unsignedinteger      sin6_port
   unsignedlong      sin6_flowinfo
   in6_addr    sin6_addr
   unsignedlong      sin6_scope_id
end type

type in6_addr from structure
   unsignedinteger      u[8]
end type

type addrinfo from structure
   long     ai_flags
   long     ai_family
   long     ai_socktype
   long     ai_protocol
   unsignedlong      ai_addrlen
   unsignedlong      ai_canonname
   unsignedlong      ai_addr
   unsignedlong      ai_next
end type

global type n_winsock from nonvisualobject
end type
global n_winsock n_winsock

type prototypes
// Windows functions

Subroutine DebugMsg( &
   String lpOutputString &
   ) Library "kernel32.dll" Alias For "OutputDebugStringA"

Function ulong FormatMessage( &
   ulong dwFlags, &
   ulong lpSource, &
   ulong dwMessageId, &
   ulong dwLanguageId, &
   Ref string lpBuffer, &
   ulong nSize, &
   ulong Arguments &
   ) Library "kernel32.dll" Alias For "FormatMessageA"

Subroutine CopyMemory ( &
   Ref structure Destination, &
   ulong Source, &
   long Length &
   ) Library  "kernel32.dll" Alias For "RtlMoveMemory"

Function ulong WNetGetUser ( &
   string lpname, &
   Ref string lpusername, &
   Ref ulong buflen &
   ) Library "mpr.dll" Alias For "WNetGetUserA"

// Winsock functions

Function ulong accept ( &
   ulong s, &
   Ref sockaddr_in addr, &
   Ref long addrlen &
   ) Library "ws2_32.dll"

Function ulong accept ( &
   ulong s, &
   Ref sockaddr_in6 addr, &
   Ref long addrlen &
   ) Library "ws2_32.dll"

Function long bind ( &
   ulong socket, &
   sockaddr_in name, &
   long namelen &
   )  Library "ws2_32.dll"

Function long bind ( &
   ulong socket, &
   sockaddr_in6 name, &
   long namelen &
   )  Library "ws2_32.dll"

Function long bind ( &
   ulong socket, &
   ulong name, &
   long namelen &
   )  Library "ws2_32.dll"

Function long closesocket ( &
   ulong socket &
   ) Library "ws2_32.dll"

Function long connect_ws ( &
   ulong socket, &
   ulong name, &
   long namelen &
   ) Library "ws2_32.dll" Alias For "connect"

Subroutine freeaddrinfo ( &
   ulong ai &
   ) Library "ws2_32.dll"

Function long getaddrinfo ( &
   string pNodeName, &
   string pServiceName, &
   Ref addrinfo pHints, &
   Ref ulong ppResult &
   ) Library "ws2_32.dll"

Function long getaddrinfo ( &
   string pNodeName, &
   ulong pServiceName, &
   Ref addrinfo pHints, &
   Ref ulong ppResult &
   ) Library "ws2_32.dll"

Function long getaddrinfo ( &
   ulong pNodeName, &
   string pServiceName, &
   Ref addrinfo pHints, &
   Ref ulong ppResult &
   ) Library "ws2_32.dll"

Function long gethostname ( &
   Ref string name, &
   long namelen &
   ) Library "ws2_32.dll"

Function long getpeername ( &
   ulong socket, &
   Ref sockaddr_in name, &
   Ref ulong namelen &
   ) Library "ws2_32.dll"

Function long getpeername ( &
   ulong socket, &
   Ref sockaddr_in6 name, &
   Ref ulong namelen &
   ) Library "ws2_32.dll"

Function long getsockname ( &
   ulong s, &
   Ref sockaddr_in name, &
   Ref ulong namelen &
   ) Library "ws2_32.dll"

Function long getsockname ( &
   ulong s, &
   Ref sockaddr_in6 name, &
   Ref ulong namelen &
   ) Library "ws2_32.dll"

Function long getsockopt ( &
   ulong socket, &
   long level, &
   long optname, &
   ref long optval, &
   ref long optlen &
   ) Library "ws2_32.dll"  

Function uint htons ( &
   uint hostshort &
   ) Library "ws2_32.dll"  

Function string inet_ntoa ( &
   ulong sin_addr &
   ) Library "ws2_32.dll"

Function long ioctlsocket ( &
   ulong socket, &
   ulong cmd, &
   ref ulong argp &
   ) Library "ws2_32.dll"

Function long listen ( &
   ulong socket, &
   long backlog &
   ) Library "ws2_32.dll"  

Function uint ntohs ( &
   ulong netshort &
   ) Library "ws2_32.dll"

Function long recv ( &
   ulong socket, &
   Ref blob buf, &
   long len, &
   long flags &
   ) Library "ws2_32.dll"  

Function long recvfrom ( &
   ulong socket, &
   Ref blob buf, &
   long len, &
   long flags, &
   Ref sockaddr_in fromaddr, &
   Ref ulong fromlen &
   )  Library "ws2_32.dll"

Function long recvfrom ( &
   ulong socket, &
   Ref blob buf, &
   long len, &
   long flags, &
   Ref sockaddr_in6 fromaddr, &
   Ref ulong fromlen &
   )  Library "ws2_32.dll"

Function long send ( &
   ulong socket, &
   Ref blob buf, &
   long len, &
   long flags &
   ) Library "ws2_32.dll"  

Function long sendto ( &
   ulong socket, &
   blob buf, &
   long len, &
   long flags, &
   ulong toaddr, &
   ulong tolen &
   )  Library "ws2_32.dll"

Function long sendto ( &
   ulong socket, &
   blob buf, &
   long len, &
   long flags, &
   Ref sockaddr_in toaddr, &
   ulong tolen &
   )  Library "ws2_32.dll"

Function long sendto ( &
   ulong socket, &
   blob buf, &
   long len, &
   long flags, &
   Ref sockaddr_in6 toaddr, &
   ulong tolen &
   )  Library "ws2_32.dll"

Function long setsockopt ( &
   ulong socket, &
   long level, &
   long optname, &
   Ref long optval, &
   Ref long optlen &
   ) Library "ws2_32.dll"

Function ulong socket ( &
   long af, &
   long ttype, &
   long protocol &
   ) Library "ws2_32.dll"

Function long shutdown ( &
   ulong s, &
   long how &
   ) Library "ws2_32.dll"

Function long WSAAddressToString ( &
   sockaddr_in lpsaAddress, &
   ulong dwAddressLength, &
   ulong lpProtocolInfo, &
   Ref string lpszAddressString, &
   Ref ulong lpdwAddressStringLength &
   ) Library "ws2_32.dll"  Alias For "WSAAddressToStringA"

Function long WSAAddressToString ( &
   sockaddr_in6 lpsaAddress, &
   ulong dwAddressLength, &
   ulong lpProtocolInfo, &
   Ref string lpszAddressString, &
   Ref ulong lpdwAddressStringLength &
   ) Library "ws2_32.dll"  Alias For "WSAAddressToStringA"

Function long WSACleanup ( &
   ) Library "ws2_32.dll"

Function long WSAGetLastError ( &
   ) Library "ws2_32.dll"  

Subroutine WSASetLastError ( &
   long iErrorNum &
   ) Library "ws2_32.dll"  

Function long WSAStartup ( &
   uint wVersionRequested, &
   Ref WSADATA lpWSAData &
   ) Library "ws2_32.dll"

Function long WSAAsyncSelect ( &
   ulong socket, &
   long hWnd, &
   ulong wMsg, &
   long lEvent &
   ) Library "ws2_32.dll"  

end prototypes
type variables
Private:

WSADATA istr_wsadata

Long il_RecvTimeout
Long il_SendTimeout

Protected:

Constant UInt AF_INET      = 2
Constant UInt AF_INET6     = 23
Constant Long SOCK_STREAM  = 1
Constant Long SOCK_DGRAM   = 2
Constant Long SOCK_RAW     = 3
Constant Long IPPROTO_TCP  = 6
Constant Long IPPROTO_UDP  = 17
Constant Long AI_PASSIVE   = 1
Constant Long SOL_SOCKET   = 65535
Constant Long SO_RCVTIMEO  = 4102
Constant Long SO_SNDTIMEO  = 4101
Constant Long SO_RCVBUF    = 4098
Constant Long SO_SNDBUF    = 4097
Constant Long SO_MAX_MSG_SIZE = 8195
Constant Long SD_RECEIVE   = 0
Constant Long SD_SEND      = 1
Constant Long SD_BOTH      = 2
Constant Long SOMAXCONN    = 2147483647   // 0x7fffffff
Constant Long INET_ADDRSTRLEN  = 22
Constant Long INET6_ADDRSTRLEN = 65

Constant ULong INVALID_SOCKET = 4294967295
Constant Long SOCKET_ERROR = -1

Boolean ib_initialized
Boolean ib_Unicode = True
Long il_StructSize   // size of the addrinfo structure
UInt il_Family = AF_INET
String is_syscallfailure

Public:

Constant Long FD_READ      = 1
Constant Long FD_WRITE     = 2
Constant Long FD_OOB       = 4
Constant Long FD_ACCEPT    = 8
Constant Long FD_CONNECT   = 10
Constant Long FD_CLOSE     = 32

Constant Long WSAETIMEDOUT = 10060
Constant Long WSAECONNREFUSED = 10061
Constant Long WSASYSCALLFAILURE = 10107   // Used for ZLib Errors

end variables

forward prototypes
public function boolean of_startup ()
public function boolean of_cleanup ()
public function string of_getlasterror ()
public function long of_getlasterrornum ()
public subroutine of_setlasterror (long al_errornum)
public subroutine of_setrecvtimeout (unsignedlong aul_milliseconds)
public subroutine of_setsendtimeout (unsignedlong aul_milliseconds)
public function string of_geterrortext (long al_errornum)
public subroutine of_setipversion (integer ai_version)
public subroutine of_setunicode (boolean ab_unicode)
public function long of_recvfrom (unsignedinteger aui_port, ref blob ablb_data, ref string as_ipaddress)
public function long of_recvfrom (unsignedinteger aui_port, ref string as_data, ref string as_ipaddress)
public function boolean of_getipaddress (string as_hostname, ref string as_ipaddress[])
public function string of_gethostname ()
public function boolean of_getpublicipaddress (ref string as_ipaddress)
public function long of_getmaxmsgsize ()
public function long of_getrecvtimeout ()
public function long of_getsendtimeout ()
public function string of_getlasterrormsg ()
public function unsignedlong of_accept (unsignedlong aul_socket)
public function unsignedlong of_connect (string as_hostname, unsignedinteger aui_port)
public function string of_getpeername (unsignedlong aul_socket)
public function long of_getrecvbufsize ()
public function long of_getsendbufsize ()
public function unsignedlong of_listen (unsignedinteger aui_port)
public function unsignedlong of_listen (unsignedinteger aui_port, long al_handle, integer ai_custevent)
public function long of_recv (unsignedlong aul_socket, ref blob ablob_data)
public function long of_recv (unsignedlong aul_socket, ref string as_data)
public function boolean of_send (unsignedlong aul_socket, string as_data)
public function string of_getuserid ()
public function boolean of_setblockingmode (unsignedlong aul_socket, boolean ab_blocking)
public function boolean of_shutdown (unsignedlong aul_socket, long al_how)
public function long of_getsockopt (unsignedlong aul_socket, string as_optname)
public function boolean of_ioctlsocket (unsignedlong aul_socket, string as_cmdname, ref unsignedlong aul_argp)
public function boolean of_send (unsignedlong aul_socket, blob ablob_data)
public function boolean of_closesocket (ref unsignedlong aul_socket)
public function boolean of_sendto (string as_hostname, unsignedinteger aui_port, blob ablb_data)
public function boolean of_sendto (string as_hostname, unsignedinteger aui_port, string as_data)
end prototypes

public function boolean of_startup ();// -----------------------------------------------------------------------------
// FUNCTION:   of_Startup
//
// PURPOSE:    This function initializes the Winsock library.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Environment le_env

GetEnvironment(le_env)

// set size of the addrinfow structure
il_StructSize = 32
//If le_env.ProcessBitness = 64 Then
// il_StructSize = 48
//End If

If Not ib_initialized Then
   PopulateError(0, "WSAStartup")
   If WSAStartup(257, istr_wsadata) = 0 Then
      ib_initialized = True
   Else
      Return False
   End If
End If

Return True

end function

public function boolean of_cleanup ();// -----------------------------------------------------------------------------
// FUNCTION:   of_Cleanup
//
// PURPOSE:    This function terminates use of the Winsock library.
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

If Not ib_initialized Then
   PopulateError(0, "WSACleanup")
   If WSACleanup() = 0 Then
      ib_initialized = False
   Else
      Return False
   End If
End If

Return True

end function

public function string of_getlasterror ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetLastError
//
// PURPOSE:    This function gets the last error message.
//
// RETURN:     The error message associated with the most recent function call.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long ll_errornum

ll_errornum = WSAGetLastError()
If ll_errornum = WSASYSCALLFAILURE Then
   Return is_syscallfailure
End If

Return of_GetErrorText(ll_errornum)

end function

public function long of_getlasterrornum ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetLastErrorNum
//
// PURPOSE:    This function gets the last error numer.
//
// RETURN:     The error number associated with the most recent function call.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Return WSAGetLastError()

end function

public subroutine of_setlasterror (long al_errornum);// -----------------------------------------------------------------------------
// FUNCTION:   of_SetLastError
//
// PURPOSE:    This function sets the last error number.
//
// ARGUMENTS:  al_errornum - The error number to set
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

WSASetLastError(al_errornum)

end subroutine

public subroutine of_setrecvtimeout (unsignedlong aul_milliseconds);// -----------------------------------------------------------------------------
// FUNCTION:   of_SetRecvTimeout
//
// PURPOSE:    This function sets the receive timeout period.
//
// ARGUMENTS:  aul_milliseconds  - The timeout period in milliseconds
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

il_RecvTimeout = aul_milliseconds

end subroutine

public subroutine of_setsendtimeout (unsignedlong aul_milliseconds);// -----------------------------------------------------------------------------
// FUNCTION:   of_SetSendTimeout
//
// PURPOSE:    This function sets the send timeout period.
//
// ARGUMENTS:  aul_milliseconds  - The timeout period in milliseconds
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

il_SendTimeout = aul_milliseconds

end subroutine

public function string of_geterrortext (long al_errornum);// -----------------------------------------------------------------------------
// FUNCTION:   of_GetErrorText
//
// PURPOSE:    This function gets the message associated with the error number.
//
// ARGUMENTS:  al_errornum - The error number
//
// RETURN:     The associated error message
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant ULong FORMAT_MESSAGE_FROM_SYSTEM = 4096
Constant ULong LANG_NEUTRAL = 0
String ls_errmsg

If al_errornum = WSASYSCALLFAILURE Then
   Return is_syscallfailure
End If

ls_errmsg = Space(256)
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, &
         al_errornum, LANG_NEUTRAL, ls_errmsg, Len(ls_errmsg), 0)

Return Trim(ls_errmsg)

end function

public subroutine of_setipversion (integer ai_version);// -----------------------------------------------------------------------------
// FUNCTION:   of_SetIPVersion
//
// PURPOSE:    This function sets the IP version to either 4 or 6.
//
// ARGUMENTS:  ai_version  - The IP version to use
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

If ai_version = 6 Then
   il_Family = AF_INET6
Else
   il_Family = AF_INET
End If

end subroutine

public subroutine of_setunicode (boolean ab_unicode);// -----------------------------------------------------------------------------
// FUNCTION:   of_SetUnicode
//
// PURPOSE:    This function sets whether strings are sent and received
//             in Ansi or Unicode encoding.
//
// ARGUMENTS:  ab_unicode  - True=Unicode, False=Ansi
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

ib_Unicode = ab_unicode

end subroutine

public function long of_recvfrom (unsignedinteger aui_port, ref blob ablb_data, ref string as_ipaddress);// -----------------------------------------------------------------------------
// FUNCTION:   of_RecvFrom
//
// PURPOSE:    This function receives a blob using UDP.
//
// ARGUMENTS:  aui_port       - The Port to receive from
//             ablb_data      - Data received
//             as_ipaddress   - The IP address of the sender
//
// RETURN:     The number of bytes received
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

sockaddr_in RecvAddr4
sockaddr_in6 RecvAddr6
Blob recvbuf
Long iResult, optlen
Long bufsize, bytesrecvd
String IPAddress
ULong RecvSocket = INVALID_SOCKET
ULong StructSize, AddressLen

// create the socket
PopulateError(0, "socket")
RecvSocket = socket(il_Family, SOCK_DGRAM, IPPROTO_UDP)
If RecvSocket = INVALID_SOCKET Then
   iResult = WSAGetLastError()
   WSASetLastError(iResult)
   Return SOCKET_ERROR
End If

// initialize the structure
choose case il_Family
   case AF_INET
      StructSize = 16
      RecvAddr4.sin_family = AF_INET
      RecvAddr4.sin_port = htons(aui_port)
   case AF_INET6
      StructSize = 28
      RecvAddr6.sin6_family = AF_INET6
      RecvAddr6.sin6_port = htons(aui_port)
end choose

// bind the socket
choose case il_Family
   case AF_INET
      PopulateError(0, "bind")
      iResult = bind(RecvSocket, RecvAddr4, StructSize)
   case AF_INET6
      PopulateError(0, "bind")
      iResult = bind(RecvSocket, RecvAddr6, StructSize)
end choose
If iResult = SOCKET_ERROR Then
   iResult = WSAGetLastError()
   closesocket(RecvSocket)
   WSASetLastError(iResult)
   Return SOCKET_ERROR
End If

// set the receive timeout
optlen = 4
setsockopt(RecvSocket, SOL_SOCKET, SO_RCVTIMEO, il_RecvTimeout, optlen)

// get size of the receive buffer
optlen = 4
getsockopt(RecvSocket, SOL_SOCKET, SO_MAX_MSG_SIZE, bufsize, optlen)

// allocate receive buffer
recvbuf = Blob(Space(bufsize))

// receive the data
choose case il_Family
   case AF_INET
      PopulateError(0, "recvfrom")
      bytesrecvd = recvfrom(RecvSocket, recvbuf, &
                        bufsize, 0, RecvAddr4, StructSize)
   case AF_INET6
      PopulateError(0, "recvfrom")
      bytesrecvd = recvfrom(RecvSocket, recvbuf, &
                        bufsize, 0, RecvAddr6, StructSize)
end choose
If bytesrecvd = SOCKET_ERROR Then
   iResult = WSAGetLastError()
   closesocket(RecvSocket)
   WSASetLastError(iResult)
   Return SOCKET_ERROR
End If

// determine the sender IP Address
choose case il_Family
   case AF_INET
      StructSize = 16
      AddressLen = INET_ADDRSTRLEN
      IPAddress = Space(AddressLen)
      WSAAddressToString(RecvAddr4, &
            StructSize, 0, IPAddress, AddressLen)
      as_ipaddress = Left(IPAddress, LastPos(IPAddress, ":") - 1)
   case AF_INET6
      StructSize = 28
      AddressLen = INET6_ADDRSTRLEN
      IPAddress = Space(AddressLen)
      WSAAddressToString(RecvAddr6, &
            StructSize, 0, IPAddress, AddressLen)
      as_ipaddress = Left(IPAddress, LastPos(IPAddress, ":") - 1)
      as_ipaddress = Mid(as_ipaddress, 2, Len(as_ipaddress) - 2)
end choose

// set data to by ref argument
ablb_data = BlobMid(recvbuf, 1, bytesrecvd)

// close the socket
closesocket(RecvSocket)

Return bytesrecvd

end function

public function long of_recvfrom (unsignedinteger aui_port, ref string as_data, ref string as_ipaddress);// -----------------------------------------------------------------------------
// FUNCTION:   of_RecvFrom
//
// PURPOSE:    This function receives a string using UDP.
//
// ARGUMENTS:  aui_port       - The Port to receive from
//             as_data        - Data received
//             as_ipaddress   - The IP address of the sender
//
// RETURN:     The number of bytes received
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Blob lblb_data
Long bytesrecvd

// receive data as a blob
bytesrecvd = of_recvfrom(aui_port, lblb_data, as_ipaddress)

// convert data to Unicode string
If bytesrecvd > 0 Then
   If ib_Unicode Then
      as_data = FromUnicode(lblb_data)
   Else
      as_data = String(lblb_data)
   End If
End If

Return bytesrecvd

end function

public function boolean of_getipaddress (string as_hostname, ref string as_ipaddress[]);// -----------------------------------------------------------------------------
// FUNCTION:   of_GetIPAddress
//
// PURPOSE:    This function gets the IP addresses associated with the host.
//
// ARGUMENTS:  as_hostname    - The host name to query
//             as_ipaddress   - An array of IP addresses (by ref)
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

sockaddr_in IPaddr4
sockaddr_in6 IPaddr6
addrinfo hints, ptr
Long iResult, iNext
String IPAddress
ULong StructSize, AddressLen
ULong result

// initialize the hints structure
hints.ai_family   = il_Family
hints.ai_socktype = SOCK_STREAM
hints.ai_protocol = IPPROTO_TCP

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(as_hostname, 0, hints, result)
If iResult > 0 Then
   WSASetLastError(iResult)
   Return False
End If

ptr.ai_next = result
do 
   CopyMemory(ptr, ptr.ai_next, il_StructSize)
   // convert IP Address to readable string
   choose case ptr.ai_family
      case AF_INET
         StructSize = 16
         CopyMemory(IPaddr4, ptr.ai_addr, StructSize)
         AddressLen = INET_ADDRSTRLEN
         IPAddress = Space(AddressLen)
         WSAAddressToString(IPaddr4, &
               StructSize, 0, IPAddress, AddressLen)
      case AF_INET6
         StructSize = 28
         CopyMemory(IPaddr6, ptr.ai_addr, StructSize)
         AddressLen = INET6_ADDRSTRLEN
         IPAddress = Space(AddressLen)
         WSAAddressToString(IPaddr6, &
               StructSize, 0, IPAddress, AddressLen)
   end choose
   iNext = UpperBound(as_ipaddress) + 1
   as_ipaddress[iNext] = IPAddress
loop while ptr.ai_next > 0

// free allocated memory
freeaddrinfo(result)

Return True

end function

public function string of_gethostname ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetHostName
//
// PURPOSE:    This function retrieves the standard host name
//             for the local computer.
//
// RETURN:     Host name
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_hostname
Long ll_namelen

ll_namelen = 256
ls_hostname = Space(ll_namelen)

PopulateError(0, "gethostname")
If gethostname(ls_hostname, ll_namelen) = SOCKET_ERROR Then
   SetNull(ls_hostname)
End If

Return ls_hostname

end function

public function boolean of_getpublicipaddress (ref string as_ipaddress);// -----------------------------------------------------------------------------
// FUNCTION:   of_GetPublicIPAddress
//
// PURPOSE:    This function gets the public IP address associated
//             with the host.
//
// ARGUMENTS:  IPAddress   - IP address (by ref)
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

sockaddr_in ConnAddr4
sockaddr_in6 ConnAddr6
addrinfo hints, ptr
Long iResult
String HostName, ServiceName, IPAddress
ULong ConnSocket = INVALID_SOCKET
ULong StructSize, AddressLen
ULong result

// hard coded to Google's DNS server
choose case il_Family
   case AF_INET
      HostName = "8.8.8.8"
   case AF_INET6
      HostName = "2001:4860:4860::8888"
end choose
ServiceName = "53"

// initialize the hints structure
hints.ai_family   = il_Family
hints.ai_socktype = SOCK_STREAM
hints.ai_protocol = IPPROTO_TCP

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(HostName, ServiceName, hints, result)
If iResult > 0 Then
   WSASetLastError(iResult)
   Return False
End If
CopyMemory(ptr, result, il_StructSize)

// create the socket
PopulateError(0, "socket")
ConnSocket = socket(ptr.ai_family, ptr.ai_socktype, ptr.ai_protocol)
If ConnSocket = INVALID_SOCKET Then
   Return False
End If

// connect to the server
PopulateError(0, "connect_ws")
iResult = connect_ws(ConnSocket, ptr.ai_addr, ptr.ai_addrlen)
If iResult = SOCKET_ERROR Then
   iResult = WSAGetLastError()
   closesocket(ConnSocket)
   WSASetLastError(iResult)
   Return False
End If

// get local socket info
PopulateError(0, "getsockname")
choose case il_Family
   case AF_INET
      StructSize = 16
      iResult = getsockname(ConnSocket, ConnAddr4, StructSize)
   case AF_INET6
      StructSize = 28
      iResult = getsockname(ConnSocket, ConnAddr6, StructSize)
end choose
If iResult = SOCKET_ERROR Then
   iResult = WSAGetLastError()
   closesocket(ConnSocket)
   WSASetLastError(iResult)
   Return False
End If

// convert IP Address to readable string
choose case ptr.ai_family
   case AF_INET
      StructSize = 16
      AddressLen = INET_ADDRSTRLEN
      IPAddress = Space(AddressLen)
      WSAAddressToString(ConnAddr4, &
            StructSize, 0, IPAddress, AddressLen)
      as_ipaddress = Left(IPAddress, LastPos(IPAddress, ":") - 1)
   case AF_INET6
      StructSize = 28
      AddressLen = INET6_ADDRSTRLEN
      IPAddress = Space(AddressLen)
      WSAAddressToString(ConnAddr6, &
            StructSize, 0, IPAddress, AddressLen)
      as_ipaddress = Left(IPAddress, LastPos(IPAddress, ":") - 1)
      as_ipaddress = Mid(as_ipaddress, 2, Len(as_ipaddress) - 2)
end choose

// free allocated memory
freeaddrinfo(result)

// close the socket
closesocket(ConnSocket)

Return True

end function

public function long of_getmaxmsgsize ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetMaxMsgSize
//
// PURPOSE:    This function retrieves the maximum UDP message size.
//
// RETURN:     Message size
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long iResult, optlen, bufsize
ULong SizeSocket

// create the socket
PopulateError(0, "socket")
SizeSocket = socket(il_Family, SOCK_DGRAM, IPPROTO_UDP)
If SizeSocket = INVALID_SOCKET Then
   iResult = WSAGetLastError()
   WSASetLastError(iResult)
   Return SOCKET_ERROR
End If

// get size of the receive buffer
optlen = 4
getsockopt(SizeSocket, SOL_SOCKET, SO_MAX_MSG_SIZE, bufsize, optlen)

// close the socket
closesocket(SizeSocket)

Return bufsize

end function

public function long of_getrecvtimeout ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetRecvTimeout
//
// PURPOSE:    This function returns the receive timeout. 
//
// RETURN:     Timeout value
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Return il_RecvTimeout

end function

public function long of_getsendtimeout ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetSendTimeout
//
// PURPOSE:    This function returns the send timeout. 
//
// RETURN:     Timeout value
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Return il_SendTimeout

end function

public function string of_getlasterrormsg ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetLastErrorMsg
//
// PURPOSE:    This function gets the last error message including detailed
//             information about the function and the error number.
//
// RETURN:     Detailed error message.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long ll_LastError
String ls_LastError, ls_LastFunc, ls_msgtext

ll_LastError = of_GetLastErrorNum()
ls_LastError = of_GetErrorText(ll_LastError)
ls_LastFunc  = Error.Text + " in " + Error.ObjectEvent
ls_msgtext   = "Winsock Error " + String(ll_LastError) + &
               " calling " + ls_LastFunc + ": " + ls_LastError

Return ls_msgtext

end function

public function unsignedlong of_accept (unsignedlong aul_socket);// -----------------------------------------------------------------------------
// SCRIPT:     of_Accept
//
// PURPOSE:    This function permits an incoming connection attempt on a socket.
//
// ARGUMENTS:  aul_socket  - Open socket that is in a listening state.
//
// RETURN:      0 = Error
//             >0 = Success ( a valid connected socket )
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

sockaddr_in AcceptAddr4
sockaddr_in6 AcceptAddr6
Long StructSize
ULong AcceptSocket

// accept the socket
choose case il_Family
   case AF_INET
      StructSize = 16
      PopulateError(0, "accept")
      AcceptSocket = accept(aul_socket, AcceptAddr4, StructSize)
   case AF_INET6
      StructSize = 28
      PopulateError(0, "accept")
      AcceptSocket = accept(aul_socket, AcceptAddr6, StructSize)
end choose
If AcceptSocket = INVALID_SOCKET Then
   Return 0
End If

Return AcceptSocket

end function

public function unsignedlong of_connect (string as_hostname, unsignedinteger aui_port);// -----------------------------------------------------------------------------
// SCRIPT:     of_Connect
//
// PURPOSE:    This function establishes a connection to a specified server.
//
// ARGUMENTS:  as_hostname - Hostname or IP Address of the server.
//             aui_port    - Port that the server is listening on.
//
// RETURN:      0 = Error
//             >0 = Success ( a valid socket )
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

addrinfo hints, ptr
Long iResult
String ServiceName
ULong ConnSocket = INVALID_SOCKET
ULong result

ServiceName = String(aui_port)

// initialize the hints structure
hints.ai_family   = il_Family
hints.ai_socktype = SOCK_STREAM
hints.ai_protocol = IPPROTO_TCP

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(as_hostname, ServiceName, hints, result)
If iResult > 0 Then
   WSASetLastError(iResult)
   Return 0
End If

// attempt to connect to an address until one succeeds
ptr.ai_next = result
do 
   CopyMemory(ptr, ptr.ai_next, il_StructSize)
   // create a socket for connecting to server
   PopulateError(0, "socket")
   ConnSocket = socket(ptr.ai_family, ptr.ai_socktype, ptr.ai_protocol)
   If ConnSocket = INVALID_SOCKET Then
      Return 0
   End If
   // connect to the server
   iResult = connect_ws(ConnSocket, ptr.ai_addr, ptr.ai_addrlen)
   If iResult = SOCKET_ERROR Then
      closesocket(ConnSocket)
      ConnSocket = INVALID_SOCKET
      // try the next one
      Continue
   End If
   // break out of the loop
   Exit
loop while ptr.ai_next > 0

// free allocated memory
freeaddrinfo(result)

Return ConnSocket

end function

public function string of_getpeername (unsignedlong aul_socket);// -----------------------------------------------------------------------------
// SCRIPT:     of_GetIPAddress
//
// PURPOSE:    This function gets the IP Address of the peer on the other
//             end of the socket.
//
// ARGUMENTS:  aul_socket - Open socket
//
// RETURN:     IP Address string
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

sockaddr_in PeerAddr4
sockaddr_in6 PeerAddr6
Long iResult
ULong StructSize, AddressLen
String IPAddress

choose case il_Family
   case AF_INET
      StructSize = 16
      PopulateError(0, "getpeername")
      iResult = getpeername(aul_socket, PeerAddr4, StructSize)
      If iResult = 0 Then
         // convert IP Address to string
         AddressLen = INET_ADDRSTRLEN
         IPAddress = Space(AddressLen)
         WSAAddressToString(PeerAddr4, &
               StructSize, 0, IPAddress, AddressLen)
         IPAddress = Left(IPAddress, LastPos(IPAddress, ":") - 1)
      End If
   case AF_INET6
      StructSize = 28
      PopulateError(0, "getpeername")
      iResult = getpeername(aul_socket, PeerAddr6, StructSize)
      If iResult = 0 Then
         // convert IP Address to string
         AddressLen = INET6_ADDRSTRLEN
         IPAddress = Space(AddressLen)
         WSAAddressToString(PeerAddr6, &
               StructSize, 0, IPAddress, AddressLen)
         IPAddress = Left(IPAddress, LastPos(IPAddress, ":") - 1)
         IPAddress = Mid(IPAddress, 2, Len(IPAddress) - 2)
      End If
end choose

If iResult = SOCKET_ERROR Then
   SetNull(IPAddress)
End If

Return IPAddress

end function

public function long of_getrecvbufsize ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetRecvBufSize
//
// PURPOSE:    This function gets the maximum Recv buffer size.
//
// RETURN:     The size fo the buffer.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

ULong SizeSocket
Long optlen, bufsize

// open TCP socket
PopulateError(0, "socket")
SizeSocket = socket(il_Family, SOCK_STREAM, IPPROTO_TCP)
If SizeSocket = INVALID_SOCKET Then
   Return SOCKET_ERROR
End If

// get size of the receive buffer
optlen = 4
getsockopt(SizeSocket, SOL_SOCKET, SO_RCVBUF, bufsize, optlen)

// close the socket
closesocket(SizeSocket)

Return bufsize

end function

public function long of_getsendbufsize ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetSendBufSize
//
// PURPOSE:    This function gets the maximum Send buffer size.
//
// RETURN:     The size fo the buffer.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

ULong SizeSocket
Long optlen, bufsize

// open TCP socket
PopulateError(0, "socket")
SizeSocket = socket(il_Family, SOCK_STREAM, IPPROTO_TCP)
If SizeSocket = INVALID_SOCKET Then
   Return SOCKET_ERROR
End If

// get size of the send buffer
optlen = 4
getsockopt(SizeSocket, SOL_SOCKET, SO_SNDBUF, bufsize, optlen)

// close the socket
closesocket(SizeSocket)

Return bufsize

end function

public function unsignedlong of_listen (unsignedinteger aui_port);// -----------------------------------------------------------------------------
// SCRIPT:     of_Listen
//
// PURPOSE:    This function opens a socket and Listens.
//
// ARGUMENTS:  aui_port  - Port number
//
// RETURN:      0 = Error
//             >0 = Success ( a valid socket )
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

addrinfo hints, ptr
Long iResult
String ServiceName
ULong ListenSocket = INVALID_SOCKET
ULong result

// get arguments
ServiceName = String(aui_port)

// initialize the hints structure
hints.ai_family   = il_Family
hints.ai_socktype = SOCK_STREAM
hints.ai_protocol = IPPROTO_TCP
hints.ai_flags    = AI_PASSIVE

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(0, ServiceName, hints, result)
If iResult > 0 Then
   WSASetLastError(iResult)
   Return 0
End If
CopyMemory(ptr, result, il_StructSize)

// Create a socket for connecting to server
PopulateError(0, "socket")
ListenSocket = socket(il_Family, SOCK_STREAM, IPPROTO_TCP)
If ListenSocket = INVALID_SOCKET Then
   Return 0
End If

// Setup the TCP listening socket
PopulateError(0, "bind")
iResult = bind(ListenSocket, ptr.ai_addr, ptr.ai_addrlen)
If iResult = SOCKET_ERROR Then
   Return 0
End If

// free allocated memory
freeaddrinfo(result)

// Put socket in Listen mode
iResult = listen(ListenSocket, SOMAXCONN)
If iResult = SOCKET_ERROR Then
   Return 0
End If

Return ListenSocket

end function

public function unsignedlong of_listen (unsignedinteger aui_port, long al_handle, integer ai_custevent);// -----------------------------------------------------------------------------
// SCRIPT:     of_Listen
//
// PURPOSE:    This function opens a socket and Listens. An event will be
//             triggered when a connection request is detected.
//
// ARGUMENTS:  aui_port  - Port number
//             al_handle - Handle of object to receive messages
//             ai_event  - pbm_customxx event to receive messages
//
// RETURN:      0 = Error
//             >0 = Success ( a valid socket )
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant Integer WM_USER = 1024
addrinfo hints, ptr
Long iResult, eventid
String ServiceName
ULong ListenSocket = INVALID_SOCKET
ULong result

// get arguments
ServiceName = String(aui_port)

// initialize the hints structure
hints.ai_family   = il_Family
hints.ai_socktype = SOCK_STREAM
hints.ai_protocol = IPPROTO_TCP
hints.ai_flags    = AI_PASSIVE

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(0, ServiceName, hints, result)
If iResult > 0 Then
   WSASetLastError(iResult)
   Return 0
End If
CopyMemory(ptr, result, il_StructSize)

// Create a socket for connecting to server
PopulateError(0, "socket")
ListenSocket = socket(il_Family, SOCK_STREAM, IPPROTO_TCP)
If ListenSocket = INVALID_SOCKET Then
   Return 0
End If

// Setup the TCP listening socket
PopulateError(0, "bind")
iResult = bind(ListenSocket, ptr.ai_addr, ptr.ai_addrlen)
If iResult = SOCKET_ERROR Then
   Return 0
End If

// free allocated memory
freeaddrinfo(result)

// request event notifications
eventid = WM_USER + (ai_custevent - 1)
PopulateError(0, "WSAASyncSelect")
If WSAASyncSelect(ListenSocket, al_handle, &
         eventid, FD_ACCEPT + FD_READ) = SOCKET_ERROR Then
   Return 0
Else
   // Put socket in Listen mode
   PopulateError(0, "listen")
   iResult = listen(ListenSocket, SOMAXCONN)
   If iResult = SOCKET_ERROR Then
      Return 0
   End If
End If

Return ListenSocket

end function

public function long of_recv (unsignedlong aul_socket, ref blob ablob_data);// -----------------------------------------------------------------------------
// SCRIPT:     of_Recv
//
// PURPOSE:    This function receives data from a connected socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             ablob_data  - By ref blob
//
// RETURN:     Number of bytes received
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Blob recvbuf
Long optlen, bufsize, bytesrecvd

// set the receive timeout
optlen = 4
PopulateError(0, "setsockopt")
setsockopt(aul_socket, SOL_SOCKET, &
               SO_RCVTIMEO, il_RecvTimeout, optlen)

// get size of the receive buffer
optlen = 4
PopulateError(0, "getsockopt")
getsockopt(aul_socket, SOL_SOCKET, SO_RCVBUF, bufsize, optlen)

// allocate receive buffer
recvbuf = Blob(Space(bufsize))

// receive data
PopulateError(0, "recv")
bytesrecvd = recv(aul_socket, recvbuf, bufsize, 0)
If bytesrecvd = SOCKET_ERROR Then
   Return SOCKET_ERROR
End If

// set the by-ref argument
ablob_data = BlobMid(recvbuf, 1, bytesrecvd)

Return bytesrecvd

end function

public function long of_recv (unsignedlong aul_socket, ref string as_data);// -----------------------------------------------------------------------------
// SCRIPT:     of_Recv
//
// PURPOSE:    This function receives data from a connected socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             as_data     - By ref string
//
// RETURN:     Number of bytes received
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Blob lblob_data
Long iResult

iResult = of_Recv(aul_socket, lblob_data)
If iResult = SOCKET_ERROR Then
   SetNull(as_data)
Else
   If ib_Unicode Then
      as_data = FromUnicode(lblob_data)
   Else
      as_data = String(lblob_data)
   End If
End If

Return iResult

end function

public function boolean of_send (unsignedlong aul_socket, string as_data);// -----------------------------------------------------------------------------
// SCRIPT:     of_Send
//
// PURPOSE:    This function sends data on a connected socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             as_data     - Data to send
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Blob lblb_data

If ib_Unicode Then
   lblb_data = ToUnicode(as_data)
Else
   lblb_data = Blob(as_data)
End If

Return of_Send(aul_socket, lblb_data)

end function

public function string of_getuserid ();// -----------------------------------------------------------------------------
// FUNCTION:   of_GetUserid
//
// PURPOSE:    This function retrieves the userid used to establish
//             the current network connection.
//
// RETURN:     The userid or null string if error occurred.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_userid
ULong lul_result, lul_buflen

lul_buflen = 256
ls_userid = Space(lul_buflen)

lul_result = WNetGetUser("", ls_userid, lul_buflen)
If lul_result <> 0 Then
   SetNull(ls_userid)
End If

Return ls_userid

end function

public function boolean of_setblockingmode (unsignedlong aul_socket, boolean ab_blocking);// -----------------------------------------------------------------------------
// SCRIPT:     of_SetBlockingMode
//
// PURPOSE:    This function changes the blocking mode of a socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             ab_blocking - True=Blocking, False=NonBlocking
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

ULong lul_ioctl

If ab_blocking Then
   lul_ioctl = 0  // make the socket blocking
Else
   lul_ioctl = 1  // make the socket non-blocking
End If

Return of_IoctlSocket(aul_socket, "FIONBIO", lul_ioctl)

end function

public function boolean of_shutdown (unsignedlong aul_socket, long al_how);// -----------------------------------------------------------------------------
// FUNCTION:   of_Shutdown
//
// PURPOSE:    This function disables sends or receives on a socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             al_how      - Type of action to disable:
//                            SD_RECEIVE, SD_READ, SD_BOTH
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long iResult

PopulateError(0, "shutdown")
iResult = shutdown(aul_socket, al_how)
If iResult = 0 Then
   Return True
Else
   Return False
End If

end function

public function long of_getsockopt (unsignedlong aul_socket, string as_optname);// -----------------------------------------------------------------------------

// SCRIPT:     of_GetSockOpt
//
// PURPOSE:    This function returns options that use long datatype.
//
// ARGUMENTS:  aul_socket  - Open socket
//             as_optname  - Option name
//
// RETURN:     Option value
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long ll_optname, ll_optvalue, ll_buflen

ll_buflen = 4

PopulateError(0, "as_optname")
choose case Upper(as_optname)
   case "SO_ERROR"
      ll_optname = 4103
   case "SO_RCVBUF"
      ll_optname = 4098
   case "SO_SNDBUF"
      ll_optname = 4097
   case "SO_TYPE"
      ll_optname = 4104
   case else
      Return SOCKET_ERROR
end choose

// get option value
PopulateError(0, "getsockopt")
If getsockopt(aul_socket, SOL_SOCKET, &
            ll_optname, ll_optvalue, ll_buflen) = 0 Then
   Return ll_optvalue
Else
   Return SOCKET_ERROR
End If

end function

public function boolean of_ioctlsocket (unsignedlong aul_socket, string as_cmdname, ref unsignedlong aul_argp);// -----------------------------------------------------------------------------
// SCRIPT:     of_IoctlSocket
//
// PURPOSE:    This function controls the I/O mode of a socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             as_cmdname  - Which command to execute
//             aul_argp    - Input/Output parm
//
//             For FIONBIO:
//                   aul_argp  = 0 - Set Blocking mode
//                   aul_argp <> 0 - Set Nonblocking mode
//
//             For FIONREAD:
//                   aul_argp - returns the amount of data avail to recv
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

// #define FIONREAD _IOR('f', 127, u_long) /* get # bytes to read */
// #define FIONBIO  _IOW('f', 126, u_long) /* set/clear non-blocking i/o */
// #define FIOASYNC _IOW('f', 125, u_long) /* set/clear async i/o */

Constant ulong FIONBIO    = 2147772030   // &H8004667E
Constant ulong FIONREAD   = 1074030207   // &H4004667F
Constant ulong SIOCATMARK = 1074033415   // &H40047307

Long ll_result
ULong lul_cmd

PopulateError(0, "as_cmdname")
choose case Upper(as_cmdname)
   case "FIONBIO"
      lul_cmd = FIONBIO
   case "FIONREAD"
      lul_cmd = FIONREAD
   case "SIOCATMARK"
      lul_cmd = SIOCATMARK
   case else
      Return False
end choose

PopulateError(0, "ioctlsocket")
ll_result = ioctlsocket(aul_socket, lul_cmd, aul_argp)
If ll_result = SOCKET_ERROR Then
   Return False
End If

Return True

end function

public function boolean of_send (unsignedlong aul_socket, blob ablob_data);// -----------------------------------------------------------------------------
// SCRIPT:     of_Send
//
// PURPOSE:    This function sends data on a connected socket.
//
// ARGUMENTS:  aul_socket  - Open socket
//             ablob_data  - Data to send
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Blob sendbuf
Long iResult, optlen
Long nBytes, nLeft, idx

nBytes = Len(ablob_data)

// set the send timeout
optlen = 4
setsockopt(aul_socket, SOL_SOCKET, SO_SNDTIMEO, il_SendTimeout, optlen)

nLeft = nBytes
do while nLeft > 0
   // send the message
   sendbuf = BlobMid(ablob_data, idx + 1, nLeft)
   iResult = send(aul_socket, sendbuf, nLeft, 0)
   If iResult = SOCKET_ERROR Then
      Return False
   End If
   nLeft -= iResult;
   idx += iResult;
loop

Return True

end function

public function boolean of_closesocket (ref unsignedlong aul_socket);// -----------------------------------------------------------------------------
// SCRIPT:     of_CloseSocket
//
// PURPOSE:    This function closes an existing socket.
//
// ARGUMENTS:  aul_socket - Open socket
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

If aul_socket <> 0 Then
   PopulateError(0, "closesocket")
   If closesocket(aul_socket) = 0 Then
      aul_socket = 0
   Else
      Return False
   End If
End If

Return True

end function

public function boolean of_sendto (string as_hostname, unsignedinteger aui_port, blob ablb_data);// -----------------------------------------------------------------------------
// FUNCTION:   of_SendTo
//
// PURPOSE:    This function sends a blob using UDP.
//
// ARGUMENTS:  as_hostname - Hostname or IP Address to send to
//             aui_port    - The Port to send to
//             ablb_data   - Data to be sent
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

addrinfo hints, ptr
sockaddr_in SendAddr4
sockaddr_in6 SendAddr6
Blob sendbuf
Long iResult, optlen, nBytes, nLeft, idx
String ServiceName
ULong SendSocket = INVALID_SOCKET
ULong StructSize
ULong result

ServiceName = String(aui_port)
nBytes = Len(ablb_data)

// initialize the hints structure
hints.ai_family   = il_Family
hints.ai_socktype = SOCK_DGRAM
hints.ai_protocol = IPPROTO_UDP

// convert host address to addrinfo structure
PopulateError(0, "getaddrinfo")
iResult = getaddrinfo(as_hostname, ServiceName, hints, result)
If iResult > 0 Then
   WSASetLastError(iResult)
   Return False
End If
CopyMemory(ptr, result, il_StructSize)

// create the socket
PopulateError(0, "socket")
SendSocket = socket(il_Family, SOCK_DGRAM, IPPROTO_UDP)
If SendSocket = INVALID_SOCKET Then
   Return False
End If

// initialize the structure
choose case il_Family
   case AF_INET
      StructSize = 16
      SendAddr4.sin_family = AF_INET
      SendAddr4.sin_port = htons(0)
   case AF_INET6
      StructSize = 28
      SendAddr6.sin6_family = AF_INET6
      SendAddr6.sin6_port = htons(0)
end choose

// bind the socket
choose case il_Family
   case AF_INET
      PopulateError(0, "bind")
      iResult = bind(SendSocket, SendAddr4, StructSize)
   case AF_INET6
      PopulateError(0, "bind")
      iResult = bind(SendSocket, SendAddr6, StructSize)
end choose
If iResult = SOCKET_ERROR Then
   iResult = WSAGetLastError()
   closesocket(SendSocket)
   WSASetLastError(iResult)
   Return False
End If

// set the send timeout
optlen = 4
setsockopt(SendSocket, SOL_SOCKET, SO_SNDTIMEO, il_SendTimeout, optlen)

idx = 1
nLeft = nBytes
do while nLeft > 0
   sendbuf = BlobMid(ablb_data, idx)
   // send the message
   PopulateError(0, "sendto")
   iResult = sendto(SendSocket, sendbuf, nLeft, 0, &
                           ptr.ai_addr, StructSize)
   If iResult = SOCKET_ERROR Then
      iResult = WSAGetLastError()
      closesocket(SendSocket)
      WSASetLastError(iResult)
      Return False
   End If
   nLeft -= iResult
   idx += iResult
loop

// free allocated memory
freeaddrinfo(result)

// close the socket
closesocket(SendSocket)

Return True

end function

public function boolean of_sendto (string as_hostname, unsignedinteger aui_port, string as_data);// -----------------------------------------------------------------------------
// FUNCTION:   of_SendTo
//
// PURPOSE:    This function sends a string using UDP.
//
// ARGUMENTS:  as_hostname - Hostname or IP Address to send to
//             aui_port    - The Port to send to
//             as_data     - Data to be sent
//
// RETURN:     True = Success, False = Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 01/01/2018  RolandS     Initial coding
// -----------------------------------------------------------------------------

Blob lblb_data

If ib_Unicode Then
   lblb_data = ToUnicode(as_data)
Else
   lblb_data = Blob(as_data)
End If

Return of_SendTo(as_hostname, aui_port, lblb_data)

end function

on n_winsock.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_winsock.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on