FONCTIONS RÉSEAU DE BASE

Option Explicit

Private Const NERR_Success As Long = 0&
Public Const FILTER_INTERDOMAIN_TRUST_ACCOUNT As Long = &H8
Public Const FILTER_NORMAL_ACCOUNT As Long = &H2
Public Const FILTER_SERVER_TRUST_ACCOUNT As Long = &H20
Public Const FILTER_TEMP_DUPLICATE_ACCOUNT As Long = &H1
Public Const FILTER_WORKSTATION_TRUST_ACCOUNT As Long = &H10
Private Const SV_TYPE_WORKSTATION As Long = &H1

Private Declare Function NetServerEnum Lib "netapi32" (servername As Byte, ByVal level As Long, Buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ByVal servertype As Long, domain As Byte, ResumeHandle As Long) As Long
Private Declare Function NetUserEnum Lib "netapi32" (servername As Byte, ByVal level As Long, ByVal lFilter As Long, Buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ResumeHandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "NETAPI32.dll" (ByVal Ptr As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function NetMessageBufferSend Lib "NETAPI32.dll" (yServer As Any, yToName As Byte, yFromName As Any, yMsg As Byte, ByVal lSize As Long) As Long
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long

Private Type MungeInt
    XLo As Integer
    XHi As Integer
    Dummy As Integer
End Type

Private Type MungeLong
    x As Long
    Dummy As Integer
End Type

Private Function GetStringFromBuffer(ByVal bufptr As Long, ByVal offset As Long, ByVal Valnum As Long, ByVal recordsize As Long) As String
Dim Result As Long, UnArray(1023) As Byte, TempPtr As MungeLong, TempStr As MungeInt

    Result = PtrToInt(TempStr.XLo, bufptr + (offset - 1) * recordsize + (Valnum - 1) * 2, 2)
    Result = PtrToInt(TempStr.XHi, bufptr + (offset - 1) * recordsize + (Valnum - 1) * 2 + 2, 2)
    LSet TempPtr = TempStr
    Result = PtrToStr(UnArray(0), TempPtr.x)
    GetStringFromBuffer = Left(UnArray, StrLen(TempPtr.x))
End Function

'---------------------------------------------------------------------------------------
' Procédure  : SendMessage
' Auteur     : Christophe RENAUD
' Objet      : Envoie un message style Popup sur le réseau
' Retour     : Renvoie True si le message a bien été envoyer et False sinon
' Arguments  : - sToUser (Entrée) : Nom du destinataire
'              - sFromUser (Entrée) : Nom de l'expéditeur
'              - sBody (Entrée) : Corps du message
'---------------------------------------------------------------------------------------
'
Public Function SendMessage(sToUser As String, sFromUser As String, sBody As String) As Boolean
Dim abTo() As Byte, abFrom() As Byte, abBody() As Byte

    abTo = sToUser & vbNullChar
    abFrom = sFromUser & vbNullChar
    abBody = sBody & vbNullChar
    If NetMessageBufferSend(ByVal 0&, abTo(0), ByVal 0&, abBody(0), UBound(abBody)) = NERR_Success Then
        SendMessage = True
    Else
        SendMessage = False
    End If
End Function

'---------------------------------------------------------------------------------------
' Procédure  : GetDomainUserNames
' Auteur     : Christophe RENAUD
' Objet      : Retourne la liste des utilisateurs d'un domaine NT
' Retour     : Indice du dernier élément du tableau retourné (base 0)
' Arguments  : - Tableau() (Sortie) : Liste des utilisateurs du domaine
'              - sMachine (Entrée) : Nom du serveur executant la requête (local si = "")
'              - Filtre (Entrée) : Filtre le type de compte renvoyé (Voir constante ci-dessus)
'---------------------------------------------------------------------------------------
'
Public Function GetDomainUserNames(ByRef Tableau() As String, sMachine As String, Filtre As Long) As Long
Dim Result As Long, bufptr As Long, entriesread As Long, totalentries As Long, ResumeHandle As Long, BufLen As Long, sName() As Byte
Dim Bcl As Long
    
    sName = sMachine & vbNullChar
    BufLen = 2047
    ResumeHandle = 0
    ReDim Tableau(0)
    Do
        Result = NetUserEnum(sName(0), 0, Filtre, bufptr, BufLen, entriesread, totalentries, ResumeHandle)
        If Result <> 0 And Result <> 234 Then
            Exit Function
        End If
        For Bcl = 1 To entriesread
            ReDim Preserve Tableau(0 To UBound(Tableau) + 1)
            Tableau(UBound(Tableau)) = Trim$(GetStringFromBuffer(bufptr, Bcl, 1, 4))
        Next
    Loop Until entriesread = totalentries
    Result = NetApiBufferFree(bufptr)
    GetDomainUserNames = UBound(Tableau)
End Function

'---------------------------------------------------------------------------------------
' Procédure  : GetDomainComputerNames
' Auteur     : Christophe RENAUD
' Objet      : Retourne la liste des PC d'un domaine NT
' Retour     : Indice du dernier élément du tableau retourné (base 0)
' Arguments  : - Tableau() (Sortie) : Liste des PC du domaine
'              - sMachine (Entrée) : Nom du serveur executant la requête (local si = "")
'              - sNomdomaine (Entrée) : Nom du domaine NT dont on recherche les machines
'---------------------------------------------------------------------------------------
'
Public Function GetDomainComputerNames(ByRef Tableau() As String, sMachine As String, sNomDomaine As String) As Long
Dim Result As Long, bufptr As Long, entriesread As Long, totalentries As Long, ResumeHandle As Long, BufLen As Long, sName() As Byte, SDomain() As Byte
Dim Bcl As Long
    
    sName = sMachine & vbNullChar
    SDomain = sNomDomaine & vbNullChar
    BufLen = 2047
    ResumeHandle = 0
    ReDim Tableau(0)
    Do
        Result = NetServerEnum(sName(0), 100, bufptr, BufLen, entriesread, totalentries, SV_TYPE_WORKSTATION, SDomain(0), ResumeHandle)
        If Result <> 0 And Result <> 234 Then
            Exit Function
        End If
        For Bcl = 2 To entriesread * 2 Step 2
            ReDim Preserve Tableau(0 To UBound(Tableau) + 1)
            Tableau(UBound(Tableau)) = Trim$(GetStringFromBuffer(bufptr, Bcl, 1, 4))
        Next
    Loop Until entriesread = totalentries
    Result = NetApiBufferFree(bufptr)
    GetDomainComputerNames = UBound(Tableau)
End Function