Infos über Rechner im Netzwerk Das Beispiel ermittelt die IP-Adresse, Betriebssystem, Domain, u.a. Daten von Rechnern im Netzwerk.
Autor:   Andreas Linnemann	Bewertung:	Views:  57.040
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Manchmal ist es interessant mehr über Rechner im Netzwerk zu erfahren. Folgender Code ermittelt anhand des Computernamens die IP-Adresse, das Betriebssystem, die Domain, das Root-Verzeichnis (nur Win9x), die Winsock Version und die Anzahl der eingeloggten User.

' Die nötigen Konstanten Typ- und
' Funktionsdeklarationen für die API-Aufrufe
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = _
  WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = _
  WS_VERSION_REQD And &HFF&
Private Const ERROR_SUCCESS = 0&
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const PLATFORM_ID_DOS = 300
Private Const PLATFORM_ID_OS2 = 400
Private Const PLATFORM_ID_NT = 500
Private Const PLATFORM_ID_OSF = 600
Private Const PLATFORM_ID_VMS = 700
 
Private Type WSAData
  wVersion As Integer
  wHighVersion As Integer
  szDescription(0 To MAX_WSADescription) As Byte
  szSystemStatus(0 To MAX_WSASYSStatus) As Byte
  wMaxSockets As Integer
  wMaxUDPDG As Integer
  dwVendorInfo As Long
End Type
 
Private Type WKSTA_INFO_102
  wki100_platform_id As Long
  pwki100_computername As Long
  pwki100_langroup As Long
  wki100_ver_major As Long
  wki100_ver_minor As Long
  pwki102_lanroot As Long
  wki102_logged_on_users As Long
End Type
 
Private Type HOSTENT
  hName As Long
  hAliases As Long
  hAddrType As Integer
  hLen As Integer
  hAddrList As Long
End Type
 
Declare Function WSAStartup Lib "WSOCK32" ( _
  ByVal wVersionRequired As Long, _
  lpWSADATA As WSAData) As Long
Declare Function WSACleanup Lib "WSOCK32" () As Long
Declare Function NetWkstaGetInfo Lib "netapi32" ( _
  ByVal servername As String, _
  ByVal level As Long, _
  lpBuf As Any) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" ( _
  ByVal Buffer As Long) As Long
 
Declare Function gethostbyname Lib "WSOCK32" ( _
  ByVal szHost As String) As Long
Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  hpvDest As Any, _
  ByVal hpvSource As Long, _
  ByVal cbCopy As Long)
 
Dim WSAD As WSAData
 
 
' Zu übergeben ist der Computername inkl. vorangestellten
' "\\", also z.B. "\\PCTest"
' Zurückgelifert wird ein String, in dem die Werte per
' vbCrLf getrennt sind
Public Function GetComputerInfo(ByVal strComputername As _
 String) As String
 
  Dim lpHost As Long
  Dim m_Host As HOSTENT
  Dim lIP As Long
  Dim tmpIP() As Byte
  Dim i As Integer
  Dim strIP As String
  Dim strErgebnis As String
  Dim strTemp As String
 
  ' Winsock initialisieren
  If Not SocketsInitialize() Then Exit Function
 
  ' ====================================================
  ' IP-ADRESSE DES COMPUTERS ERMITTELN
  ' 
  ' Anschliessend die Daten holen und für VB zugänglich
  ' machen
  ' Zuerst kümmern wir uns um die IP-Adresse
  lpHost = gethostbyname(ByVal Replace(strComputername, _
    "\", ""))
  If lpHost = 0 Then Exit Function
  CopyMemory m_Host, ByVal lpHost, ByVal Len(m_Host)
 
  ' erst die Adresse in eine Longvariable kopieren
  CopyMemory lIP, ByVal m_Host.hAddrList, ByVal 4
 
  ' und dann Stück für Stück in ein Bytefeld
  ReDim tmpIP(1 To m_Host.hLen)
  CopyMemory tmpIP(1), ByVal lIP, ByVal m_Host.hLen
 
  ' Das Bytefeld in einen String umwandeln
  For i = 1 To m_Host.hLen
    strIP = strIP & tmpIP(i) & "."
  Next
 
  ' aber den letzten Punkt weglassen
  strErgebnis = "IP-Adresse: " & Mid$(strIP, 1, _
    Len(strIP) - 1) & vbCrLf
  ' 
  ' ====================================================
 
  ' Wir wollen auch die Winsock Daten haben
  ' (weil Sie da sind;-))
  With WSAD
    ' Winsock-Version
    For i = LBound(.szDescription) To UBound(.szDescription)
      If .szDescription(i) <> 0 Then
        strTemp = strTemp & Chr$(.szDescription(i))
      Else
        Exit For
      End If
    Next i
    strErgebnis = strErgebnis & "Winsock Version: " & _
      strTemp & vbCrLf
    strTemp = ""
 
    ' Winsock-Status
    For i = LBound(.szSystemStatus) To UBound(.szSystemStatus)
      If .szSystemStatus(i) <> 0 Then
        strTemp = strTemp & Chr$(WSAD.szSystemStatus(i))
      Else
        Exit For
      End If
    Next i
    strErgebnis = strErgebnis & "Winsock Status: " & _
      strTemp & vbCrLf
  End With
 
  ' Ab hier sind wir mit Winsock fertig und räumen auf
  SocketsCleanup
 
  ' Nun geht es an die Netzwerkdaten eines Computer
  Dim pWrkInfo As Long
  Dim WrkInfo(0) As WKSTA_INFO_102
  Dim lResult As Long
 
  lResult = NetWkstaGetInfo(StrConv(strComputername, _
    vbUnicode), 102, pWrkInfo)
  If lResult = 0 Then
    Dim cname As String
    cname = String$(255, 0)
    CopyMemory WrkInfo(0), ByVal pWrkInfo, _
      ByVal Len(WrkInfo(0))
    CopyMemory ByVal cname, _
      ByVal WrkInfo(0).pwki100_langroup, ByVal 255
    strErgebnis = strErgebnis & "Domain: " & _
      StripTerminator(StrConv(cname, vbFromUnicode)) & _
      vbCrLf
    strErgebnis = strErgebnis & "Betriebssystem: "
 
    Select Case WrkInfo(0).wki100_platform_id
      Case PLATFORM_ID_DOS
        strErgebnis = strErgebnis & "DOS"
      Case PLATFORM_ID_OS2
        If WrkInfo(0).wki100_ver_major = "4" Then
          strErgebnis = strErgebnis & "Win9x"
        Else
          strErgebnis = strErgebnis & "OS2"
        End If
      Case PLATFORM_ID_NT
        If WrkInfo(0).wki100_ver_major = "5" Then
          strErgebnis = strErgebnis & "Win 2000"
        Else
          strErgebnis = strErgebnis & "NT"
        End If
      Case PLATFORM_ID_OSF
        strErgebnis = strErgebnis & "OSF"
      Case PLATFORM_ID_VMS
        strErgebnis = strErgebnis & "VMS"
    End Select
    strErgebnis = strErgebnis & " Version " & _
      WrkInfo(0).wki100_ver_major & "." & _
      WrkInfo(0).wki100_ver_minor
 
    cname = String$(255, 0)
    CopyMemory ByVal cname, _
      ByVal WrkInfo(0).pwki102_lanroot, ByVal 255
    strErgebnis = strErgebnis & "Lan Root: " & _
      StripTerminator(StrConv(cname, vbFromUnicode))
    strErgebnis = strErgebnis & "Eingeloggte Benutzer: " & _
      Str$(WrkInfo(0).wki102_logged_on_users)
 
    ' Nach einem erfolgreichen NetWkstaGetInfo den
    ' benutzten API-Buffer wieder freigeben
    NetApiBufferFree ByVal pWrkInfo
  End If
  GetComputerInfo = strErgebnis
End Function
 
' Dieser Teil stammt aus dem Programm API-Guide
' KPD-Team 1999
' URL: http://www.allapi.net/
' E-Mail: KPDTeam@Allapi.net
Public Function HiByte(ByVal wParam As Integer)
  HiByte = wParam \ &H100 And &HFF&
End Function
 
Public Function LoByte(ByVal wParam As Integer)
  LoByte = wParam And &HFF&
End Function
 
Public Sub SocketsCleanup()
  If WSACleanup() <> ERROR_SUCCESS Then
    MsgBox "Socket Fehler in Cleanup"
  End If
End Sub
 
Private Function SocketsInitialize() As Boolean
  Dim sLoByte As String
  Dim sHiByte As String
 
  ' Prüfen, ob Winsock.DLL vorhanden
  If WSAStartup(WS_VERSION_REQD, WSAD) <> _
    ERROR_SUCCESS Then
    MsgBox "Programm konnte keine funktionsfähige " & _
      "Winsock.DLL finden"
    SocketsInitialize = False
    Exit Function
  End If
 
  ' nicht genügend Sockets
  If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
    MsgBox "Das Programm muß mindestens " & _
      CStr(MIN_SOCKETS_REQD) & _
      " Sockets öffnen können."
    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 "Die Socket Version " & sLoByte & "." & _
      sHiByte & " wird nicht unterstützt."
    SocketsInitialize = False
    Exit Function
  End If
 
  SocketsInitialize = True
End Function
 
' Diese Funktion erleichtert einen VB-String um
' Chr$(0) am Ende
Private Function StripTerminator(sInput As String) As _
  String
 
  Dim ZeroPos As Integer
 
  ZeroPos = InStr(1, sInput, vbNullChar)
  If ZeroPos > 0 Then
    StripTerminator = Left$(sInput, ZeroPos - 1)
  Else
    StripTerminator = sInput
  End If
End Function

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.