Caros Colegas,

 

Alguem conhece uma função simples para pegar os nomes dos micros de uma rede?

Achei umas duas na web, inclusive uma aqui, mas é muito complicada...

 

Obrigado pelas ajudas!

Utilize a função geralista() ela vai gerar um vetor (computadores()) com os nomes dos computadores.

 

Declare um vetor 

Public computadores (100) as string

 

 

 

'Copie para um modulo

Private Const RESOURCE_CONNECTED As Long = &H1&
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCE_REMEMBERED As Long = &H3&
Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
Private Const RESOURCEDISPLAYTYPE_FILE& = &H4
Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCETYPE_DISK As Long = &H1&
Private Const RESOURCETYPE_PRINT As Long = &H2&
Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&
Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000
Private Const NO_ERROR = 0
Private Const ERROR_MORE_DATA = 234
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
Private Const MAX_RESOURCES = 256
Private Const NOT_A_CONTAINER = -1

Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    pLocalName As Long
    pRemoteName As Long
    pComment As Long
    pProvider As Long
End Type
Private Type NETRESOURCE_REAL
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    sLocalName As String
    sRemoteName As String
    sComment As String
    sProvider As String
End Type
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUsername As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function getusername Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private strUsername As String
Private strMachinerName As String
Private uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
Private uNet() As NETRESOURCE_REAL
Public computadores(100) As String
Public ip(100) As String
Sub gera_lista()
Screen.MousePointer = vbHourglass

Dim bMinTime As Boolean
Dim lReturn As Long
Dim hEnum As Long
Dim lCount As Long
Dim lMin As Long
Dim lLength As Long
Dim l As Long
Dim lBufferSize As Long
Dim lMaxIndex As Long
Dim tipo  As String * 8
Dim subtipo As String * 8
Dim nomeremoto As String * 30
Dim comentario As String
bMinTime = True
Dim temp As Long
Dim temp = 0
Do
    If bMinTime Then
        lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
        bMinTime = False
    Else
        If uNet(lMaxIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then
            lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lMaxIndex), hEnum)
        Else
            lReturn = NOT_A_CONTAINER
            hEnum = 0
        End If
        lMaxIndex = lMaxIndex + 1
    End If
    If lReturn = NO_ERROR Then
        lCount = RESOURCE_ENUM_ALL
        Do
            lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
            lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
            If lCount > 0 Then
                ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REAL
                For l = 0 To lCount - 1
                    uNet(lMin + l).dwScope = uNetApi(l).dwScope
                    uNet(lMin + l).dwType = uNetApi(l).dwType
                    uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
                    uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
                    If uNetApi(l).pLocalName Then
                        lLength = lstrlen(uNetApi(l).pLocalName)
                        uNet(lMin + l).sLocalName = Space$(lLength)
                        CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength
                    End If
                    If uNetApi(l).pRemoteName Then
                        lLength = lstrlen(uNetApi(l).pRemoteName)
                        uNet(lMin + l).sRemoteName = Space$(lLength)
                        CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength
                    End If
                    If uNetApi(l).pComment Then
                        lLength = lstrlen(uNetApi(l).pComment)
                        uNet(lMin + l).sComment = Space$(lLength)
                        CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLength
                    End If
                    If uNetApi(l).pProvider Then
                        lLength = lstrlen(uNetApi(l).pProvider)
                        uNet(lMin + l).sProvider = Space$(lLength)
                        CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLength
                    End If
                Next l
            End If
            lMin = lMin + lCount
        Loop While lReturn = ERROR_MORE_DATA
    End If
    If hEnum Then
        l = WNetCloseEnum(hEnum)
    End If
Loop While lMaxIndex < lMin

If UBound(uNet) > 0 Then
    username
    Dim filNum As Integer
    filNum = FreeFile
End If

If UBound(uNet) > 0 Then
   For l = 0 To UBound(uNet)
         If uNet(l).dwDisplayType = 2 Then
          nomeremoto = Trim(uNet(l).sRemoteName)
          computadores(temp) = nomeremoto
          temp = temp + 1
        End If
   Next l
Else
End If
Screen.MousePointer = vbDefault

End Sub
Public Sub username()
  On Error Resume Next
    strUsername = String(255, Chr$(0))
    getusername strUsername, 255
    strUsername = Left$(strUsername, InStr(strUsername, Chr$(0)) - 1)
    strMachinerName = String(255, Chr$(0))
    GetComputerName strMachinerName, 255
    strMachinerName = Left$(strMachinerName, InStr(1, strMachinerName, Chr$(0)) - 1)
End Sub

 

MAIS SIMPLES....

 

COLOCA ISSO NUM MODULO

Public Declare Function WSAStartup Lib "wsock32" _
  (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

'****************************************************
Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   Dim sLoByte As String
   Dim sHiByte As String
  
   If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
      MsgBox "Windows 32-bit Socket Não responde."
      SocketsInitialize = False
      Exit Function
   End If
      
   If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "A aplicação requer no minimo de " & _
                CStr(MIN_SOCKETS_REQD) & " siporte de sockets."
       
        SocketsInitialize = False
        Exit Function
    End If
      
   If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
     (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
      HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
     
      sHiByte = CStr(HiByte(WSAD.wVersion))
      sLoByte = CStr(LoByte(WSAD.wVersion))
     
      MsgBox "Sockets versão " & sLoByte & "." & sHiByte & _
             " não suportado por Windows 32-bit  Sockets."
     
      SocketsInitialize = False
      Exit Function
   
   End If
   
   
  'se tiver ok then....
   SocketsInitialize = True
       
End Function 

 

****************************************************

Public Function GetIPHostName() As String

    Dim sHostName As String * 256
   
    If Not SocketsInitialize() Then
        GetIPHostName = ""
        Exit Function
    End If
   
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPHostName = ""
        MsgBox "Erro de Sockets no Windows " & Str$(WSAGetMaxError()) & _
                " não foi possível identificar Host Name."
        SocketsCleanup
        Exit Function
    End If
   
    GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
    SocketsCleanup

End Function

 

******************************************************

 

PARA USAR

 

Label1.Caption = "Computador local - " & GetIPHostName()