Find og vis computere i lokalnetværk

Private Const SV_TYPE_ALL As Long = &HFFFFFFFF
Private Const ERROR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234
Private Const MAX_PREFERRED_LENGTH = &HFFFFFFFF

Private Type SERVER_INFO_101
  dwPlatformId As Long  'PLATFORM_ID_DOS, PLATFORM_ID_OS2, PLATFORM_ID_NT, PLATFORM_ID_OSF, or PLATFORM_ID_VMS
  lpszServerName As Long 'Pointer to a Unicode string.
  dwVersionMajor As Long 'Version number of the operating system.
  dwVersionMinor As Long 'Version number of the operating system.
  dwType As Long        'Type of software the computer is running.
  lpszComment As Long    'Pointer to a Unicode string. Can be NULL.
End Type

Private Declare Function NetServerEnum Lib "netapi32.dll" ( _
  ByVal ServerName As String, _
  ByVal InfoLevel As Long, _
  ByRef Buffer As Long, _
  ByVal prefmaxlen As Long, _
  ByRef EntriesRead As Long, _
  ByRef TotalEntries As Long, _
  ByVal ServerType As Long, _
  ByVal Domain As String, _
  ByRef ResumeHandle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32.dll" (BufPtr As Any) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function lstrcpyW Lib "KERNEL32" (ByVal lpszDest As String, ByVal lpszSrc As Long) As Long

Private Sub Command1_Click()
  Dim sServer As String, sDomain As String
  Dim nInfoLevel As Long, i As Long, BufPtr As Long, TempBufPtr As Long
  Dim nPrefMaxLen As Long, nEntriesRead As Long, nTotalEntries As Long
  Dim nServerType As Long, nResumeHandle As Long, nRetn As Long
  Dim ServerInfo As SERVER_INFO_101

  sServer = vbNullString            'Reserved; must be NULL.
  nInfoLevel = 101                  'SERVER_INFO_101 is returned.
  BufPtr = 0                        'Receives the data.
  nPrefMaxLen = MAX_PREFERRED_LENGTH 'Return all data
  nEntriesRead = 0                  'Elements actually enumerated.
  nTotalEntries = 0                  'Total number of visible servers and workstations
  nServerType = SV_TYPE_ALL          'What server types to enumerate.
  sDomain = vbNullString            'NULL, the primary domain is implied.
  nResumeHandle = 0                  'Reserved; must be zero.

  ListView1.ListItems.Clear
  Do
    nRetn = NetServerEnum(sServer, nInfoLevel, BufPtr, nPrefMaxLen, nEntriesRead, nTotalEntries, nServerType, sDomain, nResumeHandle)
    'Function NetServerEnum Lib "netapi32.dll" ( _
    '  ByVal ServerName As String, [in]  Reserved; must be NULL.
    '  ByVal InfoLevel As Long,    [in]  Specifies the information level of the data.
    '  ByRef Buffer As Long,      [out] Pointer to the buffer that receives the data.
    '  ByVal PrefMaxLen As Long,  [in]  Specifies the maximum length of returned data, in bytes. If you specify MAX_PREFERRED_LENGTH, the function allocates the amount of memory required for the data.
    '  ByRef EntriesRead As Long,  [out] Pointer to a value that receives the count of elements actually enumerated.
    '  ByRef TotalEntries As Long, [out] Pointer to a value that receives the total number of visible servers and workstations on the network.
    '  ByVal ServerType As Long,  [in]  Specifies a value that filters the server entries to return from the enumeration.
    '  ByVal Domain As String,    [in]  Pointer to the name of the domain. If this parameter is NULL, the primary domain is implied.
    '  ByRef ResumeHandle As Long) [in]  Reserved; must be zero.
    If ((nRetn = ERROR_SUCCESS) Or (nRetn = ERROR_MORE_DATA)) And (nEntriesRead > 0) Then
      TempBufPtr = BufPtr
      For i = 1 To nEntriesRead
        Call RtlMoveMemory(ServerInfo, TempBufPtr, Len(ServerInfo))
        Call AddToListView("ServerName", PointerToString(ServerInfo.lpszServerName), ListView1)
        Call AddToListView("Comment", PointerToString(ServerInfo.lpszComment), ListView1)
        Call AddToListView("Type", Hex(ServerInfo.dwType), ListView1)
        Call AddToListView("Platform", ServerInfo.dwPlatformId & " (" & ServerInfo.dwVersionMajor & "." & ServerInfo.dwVersionMinor & ")", ListView1)
        TempBufPtr = TempBufPtr + Len(ServerInfo)
      Next
    Else
      MsgBox "NetServerEnum failed: " & nRetn
    End If
    Call NetApiBufferFree(BufPtr)
  Loop While nEntriesRead < nTotalEntries
End Sub

Private Function PointerToString(sString As Long) As String
  Dim sStr1 As String, sStr2 As String, nRetn As Long
  sStr1 = String(1000, "*")
  nRetn = lstrcpyW(sStr1, sString)
  sStr2 = (StrConv(sStr1, vbFromUnicode))
  PointerToString = Left(sStr2, InStr(sStr2, Chr$(0)) - 1)
End Function

Private Sub AddToListView(ByVal NodeName As String, ByVal NodeValue As String, ByRef aListView As ListView)
  Static aItem As ListItem
  Static FirstNodeName As String
  Static ListItemNumber As Integer
  Static AddHeader As Boolean
 
  'If this is the first run, then initialize ListView
  If aListView.ListItems.Count = 0 Then
    aListView.View = lvwReport
    aListView.ColumnHeaders.Clear
    aListView.ListItems.Clear
    FirstNodeName = NodeName
    AddHeader = True
  End If
 
  'Is the Header not Added, then Add one now
  If (FirstNodeName = NodeName) And (aListView.ListItems.Count <> 0) Then AddHeader = False
  If AddHeader Then Call aListView.ColumnHeaders.Add(, , NodeName)
 
  'If NodeName is the same as the first Node then this is a new ListItem
  If FirstNodeName = NodeName Then 'Add new ListItem
    Set aItem = aListView.ListItems.Add(, , NodeValue, 1, 1)
    ListItemNumber = 1
  Else 'Set the SubItem under the current ListItem
    aItem.SubItems(ListItemNumber) = NodeValue
    ListItemNumber = ListItemNumber + 1
  End If
End Sub

Programmet virker ikke...

"Userdefined type not defined"

Private Sub AddToListView(ByVal NodeName As String, ByVal NodeValue As String, ByRef alistview As ListView)
  Static aItem As ListItem
  Static FirstNodeName As String
  Static ListItemNumber As Integer
  Static AddHeader As Boolean
 
  'If this is the first run, then initialize ListView
  If alistview.ListItems.Count = 0 Then
    alistview.View = lvwReport
    alistview.ColumnHeaders.Clear
    alistview.ListItems.Clear
    FirstNodeName = NodeName
    AddHeader = True
  End If
 
  'Is the Header not Added, then Add one now
  If (FirstNodeName = NodeName) And (alistview.ListItems.Count <> 0) Then AddHeader = False
  If AddHeader Then Call alistview.ColumnHeaders.Add(, , NodeName)
 
  'If NodeName is the same as the first Node then this is a new ListItem
  If FirstNodeName = NodeName Then 'Add new ListItem
    Set aItem = alistview.ListItems.Add(, , NodeValue, 1, 1)
    ListItemNumber = 1
  Else 'Set the SubItem under the current ListItem
    aItem.SubItems(ListItemNumber) = NodeValue
    ListItemNumber = ListItemNumber + 1
  End If
End Sub

Du skal oprette en Form med en CommandButton og en ListView (er en del af Windows Common Controls)

Nårh ja.. Jeg læste det som en listbox :o))

Men bortset fra det, så får jeg nu denne fejl:

Image list must be initialized before it can be used

Inde i Sub AddToListView rettes linien:
    Set aItem = aListView.ListItems.Add(, , NodeValue, 1, 1)
Til følgende:
    Set aItem = aListView.ListItems.Add(, , NodeValue)
Så undgår du at knytte en ImageList til din ListView.

hmm.. jeg får stadigvæk en fejlmeddelelse (NetServerEnum failed: 6118)

hmmm... lukketid....

Du får point's selvom det ikke løste problemet, du hjalp jo trods alt :o)