vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · Netzwerk   |   VB-Versionen: VB5, VB604.07.01
Infos über Rechner im Netzwerk

Das Beispiel ermittelt die IP-Adresse, Betriebssystem, Domain, u.a. Daten von Rechnern im Netzwerk.

Autor:   Andreas LinnemannBewertung:     [ Jetzt bewerten ]Views:  56.990 
ohne HomepageSystem:  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

Dieser Tipp wurde bereits 56.990 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel