Les Winsocks

[oguruma]

merci à son auteur

Const FD_SETSIZE = 64
Type fd_set
fd_count As Long
fd_array(FD_SETSIZE) As Long
End Type

Type timeval
tv_sec As Long
tv_usec As Long
End Type

Type HostEnt
h_name As long
h_aliases As long
h_addrtype As Integer
h_length As Integer
h_addr_list As long
End Type
Const hostent_size = 16

Const IPPROTO_TCP = 6
Const IPPROTO_UDP = 17

Const INADDR_NONE = &HFFFFFFFF
Const INADDR_ANY = &H0

Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Const sockaddr_size = 16

Type sock_addr
sa_family As Integer
sa_port As Integer
sa_addr as long
sa_zero as string
End Type

Const WSA_DESCRIPTIONLEN = 256
Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1

Const WSA_SYS_STATUS_LEN = 128
Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1

Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSA_DescriptionSize
szSystemStatus As String * WSA_SysStatusSize
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Const INVALID_SOCKET = -1
Const SOCKET_ERROR = -1

Const SOCK_STREAM = 1
Const SOCK_DGRAM = 2

Const MAXGETHOSTSTRUCT = 1024

Const AF_INET = 2
Const PF_INET = 2

Type LingerType
l_onoff As Integer
l_linger As Integer
End Type

'---Windows Sockets definitions of regular Microsoft C error constants
Const WSAEINTR = 10004
Const WSAEBADF = 10009
Const WSAEACCES = 10013
Const WSAEFAULT = 10014
Const WSAEINVAL = 10022
Const WSAEMFILE = 10024

'---Windows Sockets definitions of regular Berkeley error constants
Const WSAEWOULDBLOCK = 10035
Const WSAEINPROGRESS = 10036
Const WSAEALREADY = 10037
Const WSAENOTSOCK = 10038
Const WSAEDESTADDRREQ = 10039
Const WSAEMSGSIZE = 10040
Const WSAEPROTOTYPE = 10041
Const WSAENOPROTOOPT = 10042
Const WSAEPROTONOSUPPORT = 10043
Const WSAESOCKTNOSUPPORT = 10044
Const WSAEOPNOTSUPP = 10045
Const WSAEPFNOSUPPORT = 10046
Const WSAEAFNOSUPPORT = 10047
Const WSAEADDRINUSE = 10048
Const WSAEADDRNOTAVAIL = 10049
Const WSAENETDOWN = 10050
Const WSAENETUNREACH = 10051
Const WSAENETRESET = 10052
Const WSAECONNABORTED = 10053
Const WSAECONNRESET = 10054
Const WSAENOBUFS = 10055
Const WSAEISCONN = 10056
Const WSAENOTCONN = 10057
Const WSAESHUTDOWN = 10058
Const WSAETOOMANYREFS = 10059
Const WSAETIMEDOUT = 10060
Const WSAECONNREFUSED = 10061
Const WSAELOOP = 10062
Const WSAENAMETOOLONG = 10063
Const WSAEHOSTDOWN = 10064
Const WSAEHOSTUNREACH = 10065
Const WSAENOTEMPTY = 10066
Const WSAEPROCLIM = 10067
Const WSAEUSERS = 10068
Const WSAEDQUOT = 10069
Const WSAESTALE = 10070
Const WSAEREMOTE = 10071
'---Extended Windows Sockets error constant definitions
Const WSASYSNOTREADY = 10091
Const WSAVERNOTSUPPORTED = 10092
Const WSANOTINITIALISED = 10093
Const WSAHOST_NOT_FOUND = 11001
Const WSATRY_AGAIN = 11002
Const WSANO_RECOVERY = 11003
Const WSANO_DATA = 11004
Const WSANO_ADDRESS = 11004
'---ioctl Constants
Const FIONREAD = &H8004667F
Const FIONBIO = &H8004667E
Const FIOASYNC = &H8004667D

'---Windows System Functions
Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Byval Src As long, Byval cb&)
Declare Sub MemCopyStr Lib "kernel32" Alias "RtlMoveMemory" (Byval Dest As string, Byval Src As long, Byval cb&)
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As long) As Long

'---async notification constants
Const SOL_SOCKET = &HFFFF&
Const SO_LINGER = &H80&
Const FD_READ = &H1&
Const FD_WRITE = &H2&
Const FD_OOB = &H4&
Const FD_ACCEPT = &H8&
Const FD_CONNECT = &H10&
Const FD_CLOSE = &H20&

'---SOCKET FUNCTIONS
Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
Declare Function bindls Lib "wsock32.dll" Alias "bind" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sock_addr, ByVal namelen As Long) As Long
Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As String, optlen As Long) As Long
Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, fromvb As sockaddr, fromlen As Long) As Long
Declare Function ws_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Integer, readfds As fd_set, writefds As fd_set, exceptfds As fd_set, timeout As timeval) As Long
Declare Function send Lib "wsock32.dll" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, to_addr As sockaddr, ByVal tolen As Long) As Long
Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (s As long, how As long) As Long
Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
'---DATABASE FUNCTIONS
Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long
Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long
'---WINDOWS EXTENSIONS
Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Declare Function WSACleanup Lib "wsock32.dll" () As Long
Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long)
Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long
Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal Port As Long, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal proto_name As String, buf As Any, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal number As Long, buf As Any, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal host_name As String, buf As Any, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, addr As Long, ByVal addr_len As Long, ByVal addr_type As Long, buf As Any, ByVal buflen As Long) As Long
Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long

'-------- Functions and dims
dim wsadata as wsadatatype
Dim heDestHost As HostEnt
Dim WSAErr as long

'Return IP address as a long, in network byte order
Function GetHostIPAddr(HostName As String) As Long
Dim phe As Long, addrList As Long, retIP As Long

retIP = inet_addr(HostName)
If retIP = INADDR_NONE Then
phe = gethostbyname(HostName)
If phe <> 0 Then
MemCopy heDestHost, Byval phe, Byval 16
MemCopy addrList, Byval heDestHost.h_addr_list, Byval 4
MemCopy retIP, Byval addrList, Byval heDestHost.h_length
Else
retIP = INADDR_NONE
End If
End If
GetHostIPAddr = retIP
End Function

Function LongToIP(IP as long) As String
Dim pointer As Long
Dim IPLen As long
Dim IPStr As String * 64

pointer = inet_ntoa(byval IP)
IPLen = LStrLen(byval pointer)
If IPLen <= 64 then MemCopyStr IPStr, byval pointer, byval IPLen
LongToIP = Mid(IPStr,1,Instr(IPStr,Chr(0))-1)
End Function

Function openConnection(NameOrIp As String, port As Integer) As Long
Dim ret As Long
Dim sock As Long
Dim SocketBuffer As sock_addr
Dim haddr As Long

ret = WSAStartup(&H101, wsadata)
Select Case ret ' specific error returns not used
Case 0
Case 10092
openConnection = SOCKET_ERROR
WSACleanup
Exit Function
Case Else
openConnection = SOCKET_ERROR
WSACleanup
Exit Function
End Select

haddr = GetHostIPAddr(NameOrIP)
If haddr = INADDR_NONE Then
openConnection = SOCKET_ERROR
WSACleanup
Exit Function
End If

sock = socket(AF_INET, SOCK_STREAM, 0)
If sock = SOCKET_ERROR Then
openConnection = SOCKET_ERROR
WSACleanup
Exit Function
End If

SocketBuffer.sa_family = AF_INET
SocketBuffer.sa_port = htons(port)
SocketBuffer.sa_addr = haddr
SocketBuffer.sa_zero = String$(8, 0)
If connect(sock, SocketBuffer, 16) = SOCKET_ERROR Then
WsaErr = WSAGetLastError()
openConnection = SOCKET_ERROR
Else
openConnection = sock
End If
End Function

Sub closeConnection(sock As Long)
Dim recvBuf As String
Dim ret As Long
recvBuf = String(512, " ")
ret = 1

If shutdown(Byval sock, Byval 1) = SOCKET_ERROR Then
WsaErr = wsagetlasterror()
End If

Do While ret > 0
ret = recv(sock, recvBuf, Len(recvBuf), Byval 0)
Loop

If closesocket(Byval sock) = SOCKET_ERROR Then
WSAErr = wsagetlasterror()
End If

WSACleanup
End Sub

Function receiveData(sock As Long, buf As String) As Integer
Dim buflen As Long
Dim RC As Long
buflen = Len(buf)
RC = recv(Byval sock, Byval buf, Byval buflen, Byval 0)

receiveData = RC
End Function

Function sendData(sock As Long, buf As String) As Integer
Dim buflen As Long
Dim RC As Long
buf = Strconv(buf, 8 )
buflen = Len(buf)
RC = send(Byval sock, Byval buf, Byval buflen, Byval 0)

sendData = RC
End Function

Function isSockReady(sock As Long) As Long
Dim rfds As fd_set, wfds As fd_set, efds As fd_set
Dim tv As timeval
Dim ret As Long
' Dim werr As Long
Dim cnt As Integer

rfds.fd_count = 1
rfds.fd_array(0) = sock

tv.tv_sec = 40

ret = ws_select(Byval 0, rfds, wfds, efds, tv)
If ret = SOCKET_ERROR Then
WsaErr = WSAGetLastError()
isSockReady = 0
Else
isSockReady = ret
End If
End Function