VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CHost"
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

'TCP-IP (INET)
Private Const AF_INET As Long = 2

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

'copie une zone mémoire dans une autre
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
'renvoie la taille d'une chaine ASCII 8bits
Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal lpString As Long) As Long

'convertit une adresse IPv4 textuelle en adresse IPv4 numérique en Network Byte Order
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
'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

'des infos sur un Host
Private Type HOSTENT
    hName     As Long       'pointeur vers son nom principal
    hAliases  As Long       'pointeur vers un tableau de pointeur vers les autres noms de l'Host
                            'le dernier pointeur est NULL
    hAddrType As Integer    'type d'adresse
    hLength   As Integer    'taille des adresses en octets
    hAddrList As Long       'pointeur vers un tableau de pointeur vers les adresses IP de l'Host
                            'le dernier pointeur est NULL
End Type

'renvoie un pointeur vers une structure HOSTENT décrivant l'Host qui a pour adresse addr
Private Declare Function gethostby_addr Lib "ws2_32.dll" Alias "gethostbyaddr" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
'renvoie un pointeur vers une structure HOSTENT décrivant l'Host qui a pour nom name
Private Declare Function gethostby_name Lib "ws2_32.dll" Alias "gethostbyname" (ByVal name As String) As Long

'renvoie le nom d'Host du PC
Private Declare Function gethostname Lib "ws2_32.dll" (ByVal name As String, ByVal namelen As Long) As Long

'variables locales de stockage des valeurs de propriétés
Private mvarHostName As String 'copie locale
Private mvarAliases As Collection 'copie locale
Private mvarAddrType As Long 'copie locale
Private mvarAddresses As Collection 'copie locale

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

'remplit les propriétés de l'objet à partir d'un pointeur ptr vers une structure HOSTENT
'==================================================
'ptr : pointeur vers une structure HOSTENT
Private Sub ProcessHostEnt(ByVal ptr As Long)
Dim he As HOSTENT, cbName As Long
Dim ptrAlias As Long, szAlias As String, cbAlias As Long
Dim ptrAddr As Long, dwAddr As Long, ip As ip

CopyMemory he, ByVal ptr, Len(he)

cbName = lstrlenA(he.hName)
mvarHostName = Space(cbName)
CopyMemory ByVal mvarHostName, ByVal he.hName, cbName

mvarAddrType = he.hAddrType

Set mvarAliases = New Collection
CopyMemory ptrAlias, ByVal he.hAliases, 4&
Do While ptrAlias
    cbAlias = lstrlenA(ptrAlias)
    szAlias = Space(cbAlias)
    CopyMemory ByVal szAlias, ByVal ptrAlias, cbAlias
    mvarAliases.Add szAlias
    
    he.hAliases = he.hAliases + 4
    CopyMemory ptrAlias, ByVal he.hAliases, 4&
Loop

If he.hLength <= 4 Then
    Set mvarAddresses = New Collection
    CopyMemory ptrAddr, ByVal he.hAddrList, 4&
    Do While ptrAddr
        CopyMemory dwAddr, ByVal ptrAddr, he.hLength
        dwAddr = ntohl(dwAddr)
    
        CopyMemory ip, dwAddr, 4&
        
        mvarAddresses.Add ip.b4 & "." & ip.b3 & "." & ip.b2 & "." & ip.b1
        
        he.hAddrList = he.hAddrList + 4
        CopyMemory ptrAddr, ByVal he.hAddrList, 4&
    Loop
End If
End Sub

'==================================================
'propriétés
'==================================================

'renvoie une collection contenant la liste des adresses de l'Host
Public Property Get Addresses() As Collection
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.Addresses
    Set Addresses = mvarAddresses
End Property

'renvoie le type d'adresse de l'Host
Public Property Get AddrType() As Long
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.AddrType
    AddrType = mvarAddrType
End Property

'renvoie une collection contenant la liste des noms de l'Host
Public Property Get Aliases() As Collection
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.Aliases
    Set Aliases = mvarAliases
End Property

'renvoie le nom principal de l'Host
Public Property Get HostName() As String
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.HostName
    HostName = mvarHostName
End Property

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

'remplit les propriétés de l'objet avec les infos de l'Host par son IP szIP
'==================================================
'szIP : chaine contenant l'adresse IP textuelle de l'Host dont on veut des infos
'renvoie 0 si succès, un code d'erreur sinon
Public Function gethostbyip(ByVal szIP As String) As Long
Dim ptr As Long
ptr = gethostby_addr(inet_addr(szIP), 4&, AF_INET)
If ptr = 0 Then
    gethostbyip = Err.LastDllError
Else
    ProcessHostEnt ptr
End If
End Function

'remplit les propriétés de l'objet avec les infos de l'Host par son nom szHostName
'==================================================
'szHostName : chaine contenant le nom de l'Host dont on veut des infos
'renvoie 0 si succès, un code d'erreur sinon
Public Function gethostbyname(ByVal szHostName As String) As Long
Dim ptr As Long
ptr = gethostby_name(szHostName)
If ptr = 0 Then
    gethostbyname = Err.LastDllError
Else
    ProcessHostEnt ptr
End If
End Function

'remplit les propriétés de l'objet avec les infos de l'Host local (votre PC)
'==================================================
'renvoie 0 si succès, un code d'erreur sinon
Public Function getlocalhost() As Long
Dim buff As String
Dim ptr As Long

buff = Space(256)
If gethostname(buff, 256) = 0 Then
    ptr = gethostby_name(buff)
    If ptr = 0 Then
        getlocalhost = Err.LastDllError
    Else
        ProcessHostEnt ptr
    End If
Else
    getlocalhost = Err.LastDllError
End If
End Function
