网页功能: 加入收藏 设为首页 网站搜索  
用VB动态获取所有网络邻居的名称及其IP地址
发表日期:2003-12-09作者:[] 出处:  

这有一个取IP的function:

Public Const MIN_SOCKETS_REQD As Long = 1

Public Const WS_VERSION_REQD As Long = &H101

Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&

Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&

Public Const SOCKET_ERROR As Long = -1

Public Const WSADESCRIPTION_LEN = 257

Public Const WSASYS_STATUS_LEN = 129

Public Const MAX_WSADescription = 256

Public Const MAX_WSASYSStatus = 128

Public 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

Type WSADataInfo

  wVersion As Integer

  wHighVersion As Integer

  szDescription As String * WSADESCRIPTION_LEN

  szSystemStatus As String * WSASYS_STATUS_LEN

  iMaxSockets As Integer

  iMaxUdpDg As Integer

  lpVendorInfo As String

End Type

Public Type HOSTENT

  hName As Long

  hAliases As Long

  hAddrType As Integer

  hLen As Integer

  hAddrList As Long

End Type

Declare Function WSAStartupInfo Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long

Declare Function WSACleanup Lib "WSOCK32" () As Long

Declare Function WSAGetLastError Lib "WSOCK32" () As Long

Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long

Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long

Declare Function gethostbyname Lib "WSOCK32" (ByVal szHost As String) As Long

Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Public Function GetIPAddress() As String

  Dim sHostName As String * 256

  Dim lpHost As Long

  Dim HOST As HOSTENT

  Dim dwIPAddr As Long

  Dim tmpIPAddr() As Byte

  Dim I As Integer

  Dim sIPAddr As String

  If Not SocketsInitialize() Then

    GetIPAddress = ""

    Exit Function

  End If

  If gethostname(sHostName, 256) = SOCKET_ERROR Then

    GetIPAddress = ""

    MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."

    SocketsCleanup

    Exit Function

  End If

  sHostName = Trim$(sHostName)

  lpHost = gethostbyname(sHostName)

  If lpHost = 0 Then

    GetIPAddress = ""

    MsgBox "Windows Sockets are not responding. " & "Unable to successfully get Host Name."

    SocketsCleanup

    Exit Function

  End If

  CopyMemoryIP HOST, lpHost, Len(HOST)

  CopyMemoryIP dwIPAddr, HOST.hAddrList, 4

  ReDim tmpIPAddr(1 To HOST.hLen)

  CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen

  For I = 1 To HOST.hLen

    sIPAddr = sIPAddr & tmpIPAddr(I) & "."

  Next

  GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

  SocketsCleanup

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 "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."

    SocketsCleanup

    Exit Function

  End If

  GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)

  SocketsCleanup

End Function

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 error occurred in Cleanup."

  End If

End Sub

Public Function SocketsInitialize() As Boolean

  Dim WSAD As WSAData

  Dim sLoByte As String

 &n