VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSocket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'programmed by ShareVB
Option Explicit

'réseaux TCP/IP (INET)
Private Const AF_INET As Long = 2
'UDP
Private Const SOCK_DGRAM As Long = 2
'TCP
Private Const SOCK_STREAM As Long = 1

'plus d'éléments à énumérer
Private Const ERROR_NO_MORE_ITEMS As Long = 259&

'une IPv4
Private Type ip
    b1 As Byte
    b2 As Byte
    b3 As Byte
    b4 As Byte
End Type

'une adresse de Socket : une IP, un port
Private Type sockaddr_in
    sin_family       As Integer 'AF_INET
    sin_port         As Integer 'port
    sin_addr         As Long    'IP
    sin_zero(1 To 8) As Byte    'non utilisé
End Type

Private Declare Function TLS_init Lib "Auth.dll" (ByVal keyfile As String, ByVal Password As String, ByVal CAFile As String) As Long
Private Declare Sub TLS_destroy Lib "Auth.dll" (ByVal ctx As Long)
Private Declare Function TLS_read Lib "Auth.dll" (ByVal ssl As Long, ByRef buff As Any, ByVal cbbuff As Long) As Long
Private Declare Function TLS_write Lib "Auth.dll" (ByVal ssl As Long, ByRef buff As Any, ByVal cbbuff As Long) As Long
Private Declare Function TLS_close Lib "Auth.dll" (ByVal ssl As Long) As Long
Private Declare Function TLS_begin Lib "Auth.dll" (ByVal ctx As Long, ByVal sock As Long, ByRef sbio As Long, ByVal host As String) As Long
Private Declare Function TLS_isreadable Lib "Auth.dll" (ByVal ssl As Long) As Long

'copie une zone de mémoiore dans une autre
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
'convertit une adresse IPv4 tectuelle en IPv4 numérique (network byte order)
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long

'convertit un Integer de l'alignement du PC vers le Network Byte Order
Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
'convertit un Integer de l'alignement Network vers l'alignement du PC
Private Declare Function ntohs Lib "ws2_32.dll" (ByVal netshort As Integer) As Integer
'convertit un Long de l'alignement Network vers l'alignement du PC
Private Declare Function ntohl Lib "ws2_32.dll" (ByVal netlong As Long) As Long

'crée un socket
Private Declare Function ws_socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long, ByVal lType As Long, ByVal protocol As Long) As Long

'lie un socket localement
Private Declare Function ws_bind Lib "ws2_32.dll" Alias "bind" (ByVal s As Long, ByRef addr As sockaddr_in, ByVal namelen As Long) As Long
'connecte un socket à un serveur
Private Declare Function ws_connect Lib "ws2_32.dll" Alias "connect" (ByVal s As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long

'ferme un socket
Private Declare Function ws_closesocket Lib "ws2_32.dll" Alias "closesocket" (ByVal s As Long) As Long

'demande les infos (IP, Port) du socket côté serveur
Private Declare Function getpeername Lib "ws2_32.dll" (ByVal s As Long, ByRef name As sockaddr_in, ByRef namelen As Long) As Long
'demande les infos (IP, Port) du socket côté client (local)
Private Declare Function getsockname Lib "ws2_32.dll" (ByVal s As Long, ByRef name As sockaddr_in, ByRef namelen As Long) As Long

'un ensemble de descripteurs de fichiers
Private Type fd_set
  fd_count                  As Long 'combien de descripteurs dans fd_array
  fd_array(1 To 64) As Long         'tableau de fd_count handles de sockets
End Type
'renvoie le nombre de socket concerné par la catégorie readfds ou writefds ou errorfds
Private Declare Function ws_select Lib "ws2_32.dll" Alias "select" (ByVal nfds As Long, ByRef readfds As Any, ByRef writefds As Any, ByRef exceptfds As Any, ByRef timeout As Long) As Long
                
'lit des données depuis le socket
Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal lLen As Long, ByVal flags As Long) As Long
'écrit des données dans le socket
Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal lLen As Long, ByVal flags As Long) As Long

'handle du socket
Private hSocket As Long
Private bSecure As Boolean
Private sslCtx As Long
Private sslBIO As Long
Private sslHandle As Long

'==================================================
'méthodes privées
'==================================================

'init d'une adresse de socket (IP + Port) à partir des infos d'un Host
'renvoie l'adresse inititialisée
Private Function InitSOCKADDR(ByVal host As CHost, ByVal nPort As Integer) As sockaddr_in
    With InitSOCKADDR
        'l'adresse
        .sin_addr = inet_addr(host.Addresses(1))
        'TCP-IP
        .sin_family = AF_INET
        'et le port
        .sin_port = htons(nPort)
    End With
End Function

'==================================================
'méthodes publiques
'==================================================

Public Function BeginSecure(ByVal keyfile As String, ByVal Password As String, ByVal CAFile As String, host As String) As Boolean
sslCtx = TLS_init(keyfile, Password, CAFile)
If sslCtx < 4 Then Exit Function
sslHandle = TLS_begin(sslCtx, hSocket, sslBIO, host)
If sslHandle = 0 Then Exit Function
bSecure = True
BeginSecure = True
End Function

Public Function EndSecure() As Boolean
If sslHandle = 0 Then Exit Function
TLS_close sslHandle
sslHandle = 0
If sslCtx < 4 Then Exit Function
TLS_destroy sslCtx
sslCtx = 0
bSecure = False
EndSecure = True
End Function

'renvoie le dernier code d'erreur
Public Function GetLastError() As Long
    GetLastError = Err.LastDllError
End Function

'lie un socket localement (principalement pour les serveurs)
Public Function bind(ByVal LocalHost As CHost, ByVal nLocalPort As Integer) As Long
    Dim s As sockaddr_in
    s = InitSOCKADDR(LocalHost, nLocalPort)
    If ws_bind(hSocket, s, Len(s)) Then
        bind = Err.LastDllError
    End If
End Function

'connecte un socket à un serveur par son IP
Public Function connectbyip(ByVal RemoteHostIP As String, ByVal nRemotePort As Integer) As Long
Dim host As New CHost

connectbyip = host.gethostbyip(RemoteHostIP)
If connectbyip = 0 Then
    connectbyip = connectbyhost(host, nRemotePort)
End If

Set host = Nothing
End Function

'connecte un socket à un serveur par son nom
Public Function connectbyname(ByVal RemoteHostName As String, ByVal nRemotePort As Integer) As Long
Dim host As New CHost

connectbyname = host.gethostbyname(RemoteHostName)
If connectbyname = 0 Then
    connectbyname = connectbyhost(host, nRemotePort)
End If

Set host = Nothing
End Function

'connecte un socket à un serveur par ses infos d'Host
Public Function connectbyhost(ByVal RemoteHost As CHost, ByVal nRemotePort As Integer, Optional ByVal LocalHost As CHost = Nothing, Optional ByVal nLocalPort As Integer = 0) As Long
    Dim s As sockaddr_in
    
    s = InitSOCKADDR(RemoteHost, nRemotePort)
    If ws_connect(hSocket, s, Len(s)) Then
        connectbyhost = Err.LastDllError
    Else
        If (nLocalPort <> 0) And (Not LocalHost Is Nothing) Then
            connectbyhost = bind(LocalHost, nLocalPort)
        End If
    End If
End Function

'ferme le socket
Public Function CloseSocket() As Long
EndSecure
CloseSocket = ws_closesocket(hSocket)
hSocket = 0
End Function

'renvoie les infos du serveur auquel le socket est connecté
Public Function getremoteinfo(ByRef nPort As Integer) As CHost
    Dim s As sockaddr_in, ip As ip
    
    If getpeername(hSocket, s, Len(s)) = 0 Then
        nPort = ntohs(s.sin_port)
        Set getremoteinfo = New CHost
        
        s.sin_addr = ntohl(s.sin_addr)
        CopyMemory ip, s.sin_addr, 4&
        
        getremoteinfo.gethostbyip ip.b4 & "." & ip.b3 & "." & ip.b2 & "." & ip.b1
    End If
End Function

'renvoie les infos locales sur le socket
Public Function getlocalinfo(ByRef nPort As Integer) As CHost
    Dim s As sockaddr_in, ip As ip
    
    If getsockname(hSocket, s, Len(s)) = 0 Then
        nPort = ntohs(s.sin_port)
        Set getlocalinfo = New CHost
        
        s.sin_addr = ntohl(s.sin_addr)
        CopyMemory ip, s.sin_addr, 4&
        
        getlocalinfo.gethostbyip ip.b1 & "." & ip.b2 & "." & ip.b3 & "." & ip.b4
    End If
End Function

'crée un socket
Public Function Create(ByVal lType As Long) As Long
    hSocket = ws_socket(AF_INET, lType, 0&)
    Create = Err.LastDllError
End Function

'indique si on peut lire des données depuis le socket
Public Function IsDataAvailable() As Boolean
Dim fdsetReads As fd_set
Dim fdsetWrites As fd_set
Dim fdsetErrors As fd_set

fdsetReads.fd_count = 1
fdsetReads.fd_array(1) = hSocket

IsDataAvailable = (ws_select(0&, fdsetReads, fdsetWrites, fdsetErrors, 0&) > 0)

If bSecure Then
    IsDataAvailable = (TLS_isreadable(sslHandle) > 0) Or IsDataAvailable
Else
End If
End Function

'lit des données depuis le socket dans un tableau d'octets
Public Function ReadBinaryData(ByVal lpBuff As Long, ByVal cbbuff As Long, ByRef lpcbRead As Long) As Long
If IsDataAvailable = False Then ReadBinaryData = ERROR_NO_MORE_ITEMS: Exit Function

If bSecure Then
    lpcbRead = TLS_read(sslHandle, ByVal lpBuff, cbbuff)
Else
    lpcbRead = recv(hSocket, ByVal lpBuff, cbbuff, 0&)
End If

If lpcbRead = 0 Then ReadBinaryData = Err.LastDllError Else ReadBinaryData = 0
If lpcbRead = 0 Then CloseSocket
End Function

'lit des donnés depuis une socket dans une chaine
Public Function ReadStringData(ByRef lpBuff As String, ByVal ccBuff As Long, ByRef lpccRead As Long) As Long
If IsDataAvailable = False Then ReadStringData = ERROR_NO_MORE_ITEMS: Exit Function

If bSecure Then
    lpccRead = TLS_read(sslHandle, ByVal lpBuff, ccBuff)
Else
    lpccRead = recv(hSocket, ByVal lpBuff, ccBuff, 0&)
End If

If lpccRead = 0 Then ReadStringData = Err.LastDllError Else ReadStringData = 0
If lpccRead = 0 Then CloseSocket
End Function

'indique si on peut écrire des données dans le socket
Public Function CanSendData() As Boolean
Dim fdsetReads As fd_set
Dim fdsetWrites As fd_set
Dim fdsetErrors As fd_set

fdsetWrites.fd_count = 1
fdsetWrites.fd_array(1) = hSocket

CanSendData = (ws_select(0&, fdsetReads, fdsetWrites, fdsetErrors, 0&) > 0)
End Function

'écrit des données depuis un tableau d'octets dans le socket
Public Function WriteBinaryData(ByVal lpBuff As Long, ByVal cbbuff As Long, ByRef lpcbWritten As Long) As Long
If CanSendData = False Then WriteBinaryData = ERROR_NO_MORE_ITEMS: Exit Function

If bSecure Then
    lpcbWritten = TLS_write(sslHandle, ByVal lpBuff, cbbuff)
Else
    lpcbWritten = send(hSocket, ByVal lpBuff, cbbuff, 0&)
End If

If lpcbWritten = 0 Then WriteBinaryData = Err.LastDllError Else WriteBinaryData = 0
End Function

'écrit des données depuis une chaine dans le socket
Public Function WriteStringData(ByRef lpBuff As String, ByVal ccBuff As Long, ByRef lpccWritten As Long) As Long
If CanSendData = False Then WriteStringData = ERROR_NO_MORE_ITEMS: Exit Function

If bSecure Then
    lpccWritten = TLS_write(sslHandle, ByVal lpBuff, ccBuff)
Else
    lpccWritten = send(hSocket, ByVal lpBuff, ccBuff, 0&)
End If

If lpccWritten = 0 Then WriteStringData = Err.LastDllError Else WriteStringData = 0
End Function

'indique si le socket est en état d'erreur
Public Function IsSocketErroneous() As Boolean
Dim fdsetReads As fd_set
Dim fdsetWrites As fd_set
Dim fdsetErrors As fd_set

fdsetErrors.fd_count = 1
fdsetErrors.fd_array(1) = hSocket

IsSocketErroneous = (ws_select(0&, fdsetReads, fdsetWrites, fdsetErrors, 0&) > 0)
End Function

'indique si le socket est fermé
Public Function IsClosed() As Boolean
IsClosed = (hSocket = 0)
End Function

'========================================
'destructeur
'========================================

Private Sub Class_Terminate()
    EndSecure
    ws_closesocket hSocket
End Sub
