Ⅰ 查看局域网计算机ip的VB代码

新建工程，一个CommandButton、一个TextBox，名称默认
文本框输入主机名，点击按钮稍等一会可获得IP

Option Explicit
Private Const SYNCHRONIZE = &H100000
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
Command1.Enabled = False
Dim tmpstr As String, fPath As String, tmpA() As String

fPath = App.Path + "\TmpCmd.bat"
Open fPath For Output As #1
Print #1, "ping " + Text1 + " > TmpCmd.txt"
Close #1

Dim pID As Long, pHnd As Long
pID = Shell(fPath, vbHide)

pHnd = -1
While pHnd <> 0

DoEvents
Sleep 100
pHnd = OpenProcess(SYNCHRONIZE, 0, pID)
CloseHandle pHnd
Wend

fPath = App.Path + "\TmpCmd.txt"
Open fPath For Input As #1

Do While Not EOF(1)
Line Input #1, tmpstr

If Left(tmpstr, 10) = "Reply from" Then
tmpA = Split(tmpstr)
MsgBox "主机IP：" + Left(tmpA(2), Len(tmpA(2)) - 1)
Exit Do
End If

Loop
If EOF(1) Then MsgBox "未检测到主机"
Close #1
Command1.Enabled = True
End Sub

Ⅱ VB怎么 获得局域网内的其他所有电脑的IP地址

可以获取IP
ption Explicit

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type

Private Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpszVendorInfo As Long
End Type

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Private Function hibyte(ByVal wParam As Integer)
hibyte = wParam \ &H100 And &HFF&
End Function

Private Function lobyte(ByVal wParam As Integer)
lobyte = wParam And &HFF&
End Function

Private Sub SocketsInitialize()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String

iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

If iReturn = 0 Then
If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
'Debug.Print sMsg
'sMsg = sMsg & " winsock.dll tarafindan desteklenmiyor. "
'MsgBox sMsg
'End
End If
Else
'Debug.Print "Winsock.dll Error."
End If

End Sub

Public Function GetCurrentIP(ByVal blnExternalIP As Boolean) As String

Dim hostname As String * 256
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
Dim IP As String
Dim Internal As String
Dim EXTERNAL As String

If gethostname(hostname, 256) <> SOCKET_ERROR Then
hostname = Trim$(hostname)

hostent_addr = gethostbyname(hostname)

If hostent_addr <> 0 Then
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4

Do
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength

For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)

' Return Both LAN and External IP Fix
' Master Yoda 30-05-2000
' ##########################################
' HERE'S THE PROBLEM!!!
'TheIP = TheIP + ip_address
' ##########################################
' HERE'S THE FIX!!!
Internal = IP ' Send ONLY the External IP to the CurrentIP Function
EXTERNAL = ip_address ' Send the External IP to the function parameter External
IP = ip_address ' Send LAN IP to the function para Internal

' You don't really need to return parameters,
' it just allows you to get both IPs :)
' ##########################################

ip_address = ""
host.hAddrList = host.hAddrList + LenB(host.hAddrList)
RtlMoveMemory hostip_addr, host.hAddrList, 4
Loop While (hostip_addr <> 0)

If blnExternalIP = True Then
GetCurrentIP = EXTERNAL
Else
GetCurrentIP = Internal
End If
Else
'Debug.Print "Winsock.dll error."

GetCurrentIP = ""
End If
Else
'Debug.Print "Windows Socket Error " & Str(WSAGetLastError())

GetCurrentIP = ""
End If

End Function

Private Sub SocketsCleanup()

Dim lReturn As Long

lReturn = WSACleanup()

If lReturn <> 0 Then
'MsgBox "Socket Error " & Trim$(Str$(lReturn)) & " occurred In Cleanup "
End If
End Sub

Private Sub Class_Initialize()

SocketsInitialize

End Sub

Private Sub Class_Terminate()

SocketsCleanup

End Sub
_________

Ⅲ vb6.0如何获得局域网所有IP地址

Option Explicit
'===================以下定义用于获得本机IP==================
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Type WSA_DATA
wVersion As Integer
wHighVersion As Integer
strDescription(WSADescription_Len + 1) As Byte
strSystemStatus(WSASYS_Status_Len + 1) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type HOSTENT
hname As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal _
wVersionRequired&, lpWSAData As WSA_DATA) As Long
Private Declare Function gethostbyname Lib "ws2_32.dll" (ByVal hostname$) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
'===================以上定义用于获得本机IP==================

'=====================以下定义用于获得MAC====================
Private Declare Function SendARP Lib "iphlpapi" (ByVal dest As Long, ByVal host As Long, ByRef Mac As Any, ByRef length As Long) As Long
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
'=====================以上定义用于获得MAC====================

'获得指定IP地址的MAC地址，用到全局变量hostIpStr为本机IP地址
'输入：IP为本网内的IP地址字符串，函数返回MAC地址，若出错返回空字符串
Function GetMac(IP As String) As String
Dim ldest As Long, lhost As Long, Mac(5) As Byte, length As Long
Dim i As Long, lR As Long, hostIpStr As String
hostIpStr = GetMyIp
GetMac = "" ' 若得不到MAC！
If hostIpStr <> "" Then
ldest = inet_addr(IP) '//目的地的IP转换为IP内码形式
lhost = inet_addr(hostIpStr) '//将本机IP转换为IP内码形式
length = 6
lR = SendARP(ldest, lhost, Mac(0), length)
If length > 0 Then
For i = 0 To length - 1
GetMac = GetMac & Right("00" & Hex(Mac(i)), 2)
Next i
End If
End If
End Function

'获得本机IP地址，函数返回值=本机IP地址，若出错返回空字符串
Function GetMyIp() As String
Dim WSAD As WSA_DATA
Dim lR As Long, MyIp As String
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
lR = WSAStartup(&H202, WSAD)
If lR <> 0 Then 'WSANOERROR Then
MsgBox "启动WSAStartup失败！"
GetMyIp = ""
Exit Function
End If
hostent_addr = gethostbyname("")

If hostent_addr = 0 Then
GetMyIp = "" '注释：主机名不能被解释
Exit Function
End If

CopyMemory host, ByVal hostent_addr, LenB(host)
CopyMemory hostip_addr, ByVal host.hAddrList, 4

ReDim temp_ip_address(1 To host.hLength)
CopyMemory temp_ip_address(1), ByVal hostip_addr, host.hLength

For i = 1 To host.hLength
ip_address = ip_address & temp_ip_address(i) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
GetMyIp = ip_address
WSACleanup
End Function

Private Sub Form_Load()
MsgBox GetMyIp
MsgBox GetMac(GetMyIp)
MsgBox GetMac("192.168.1.1")
End Sub