|
在窗体上加入下列控件TextBox:Text1,ListBox:List1,CommandButton:Command1
在窗体上加入如下代码：
'--------------------------Form1---------------------------------
Option Explicit
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 SocketsCleanup()
If WSACleanup() <> ERROR_SUCCESS Then
MsgBox "Socket error occurred in Cleanup."
End If
End Sub
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSAData
Dim sLoByte As String
Dim sHiByte As String
If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
MsgBox "The 32-bit Windows Socket is not responding."
SocketsInitialize = False
Exit Function
End If
If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
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 "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
SocketsInitialize = False
Exit Function
End If
SocketsInitialize = True
End Function
Private Function GetName() As String
Dim sHostName As String * 256
If Not SocketsInitialize() Then
GetName = ""
Exit Function
End If
If gethostname(sHostName, 256) = SOCKET_ERROR Then
GetName = ""
MsgBox "Windows Sockets error Unable to successfully get Host Name."
SocketsCleanup
Exit Function
End If
GetName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
SocketsCleanup
End Function
Private Sub GetHostIP()
Dim I As Integer
If Not SocketsInitialize() Then
MsgBox "Windows Sockets error"
Exit Sub
End If
Dim lngPtrToHOSTENT As Long
Dim udtHostent As HOSTENT
Dim lngPtrToIP As Long
Dim arrIpAddress() As Byte
Dim strIpAddress As String
List1.Clear
lngPtrToHOSTENT = gethostbyname(Trim$(Text1.Text))
If lngPtrToHOSTENT = 0 Then
MsgBox "Windows Sockets error Unable to successfully get Host Ip."
Else
RtlMoveMemory udtHostent, lngPtrToHOSTENT, LenB(udtHostent)
RtlMoveMemory lngPtrToIP, udtHostent.hAddrList, 4
Do Until lngPtrToIP = 0
ReDim arrIpAddress(1 To udtHostent.hLength)
RtlMoveMemory arrIpAddress(1), lngPtrToIP, udtHostent.hLength
For I = 1 To udtHostent.hLength
strIpAddress = strIpAddress & arrIpAddress(I) & "."
Next
strIpAddress = Left$(strIpAddress, Len(strIpAddress) - 1)
List1.AddItem strIpAddress
strIpAddress = ""
udtHostent.hAddrList = udtHostent.hAddrList + LenB(udtHostent.hAddrList)
RtlMoveMemory lngPtrToIP, udtHostent.hAddrList, 4
Loop
End If
SocketsCleanup
End Sub
Private Sub Command1_Click()
GetHostIP
End Sub
Private Sub Form_Load()
Text1.Text = GetName
End Sub
'----------------------------end Form1----------------------------------
在模块部分添加
'----------------------------Module1------------------------------------
Option Explicit
Public Const INADDR_NONE = &HFFFF
Public Const SOCKET_ERROR = -1
Public Const WSABASEERR = 10000
Public Const WSAEFAULT = (WSABASEERR + 14)
Public Const WSAEINVAL = (WSABASEERR + 22)
Public Const WSAEINPROGRESS = (WSABASEERR + 50)
Public Const WSAENETDOWN = (WSABASEERR + 50)
Public Const WSASYSNOTREADY = (WSABASEERR + 91)
Public Const WSAVERNOTSUPPORTED = (WSABASEERR + 92)
Public Const WSANOTINITIALISED = (WSABASEERR + 93)
Public Const WSAHOST_NOT_FOUND = 11001
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const WSATRY_AGAIN = 11002
Public Const WSANO_RECOVERY = 11003
Public Const WSANO_DATA = 11004
Public Const WS_VERSION_REQD As Long = &H101
Public Const ERROR_SUCCESS = 0
Public Const MIN_SOCKETS_REQD As Long = 1
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 Type WSAData
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 Long
End Type
Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Public Type servent
s_name As Long
s_aliases As Long
s_port As Integer
s_proto As Long
End Type
Public Type protoent
p_name As String 'Official name of the protocol
p_aliases As Long 'Null-terminated array of alternate names
p_proto As Long 'Protocol number, in host byte order
End Type
Public Declare Function WSAStartup _
Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSAData) As Long
Public Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Public Declare Function gethostbyaddr _
Lib "ws2_32.dll" (addr As Long, ByVal addr_len As Long, _
ByVal addr_type As Long) As Long
Public Declare Function gethostbyname _
Lib "ws2_32.dll" (ByVal host_name As String) As Long
Public Declare Function gethostname _
Lib "ws2_32.dll" (ByVal host_name As String, _
ByVal namelen As Long) As Long
Public Declare Function getservbyname _
Lib "ws2_32.dll" (ByVal serv_name As String, _
ByVal proto As String) As Long
Public Declare Function getprotobynumber _
Lib "ws2_32.dll" (ByVal proto As Long) As Long
Public Declare Function getprotobyname _
Lib "ws2_32.dll" (ByVal proto_name As String) As Long
Public Declare Function getservbyport _
Lib "ws2_32.dll" (ByVal port As Integer, ByVal proto As Long) As Long
Public Declare Function inet_addr _
Lib "ws2_32.dll" (ByVal cp As String) As Long
Public Declare Function inet_ntoa _
Lib "ws2_32.dll" (ByVal inn As Long) As Long
Public Declare Function htons _
Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Public Declare Function htonl _
Lib "ws2_32.dll" (ByVal hostlong As Long) As Long
Public Declare Function ntohl _
Lib "ws2_32.dll" (ByVal netlong As Long) As Long
Public Declare Function ntohs _
Lib "ws2_32.dll" (ByVal netshort As Integer) As Integer
Public Declare Sub RtlMoveMemory _
Lib "kernel32" (hpvDest As Any, _
ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Public Declare Function lstrcpy _
Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, _
ByVal lpString2 As Long) As Long
Public Declare Function lstrlen _
Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
'----------------------------end Module1--------------------------------
好了，下面我们来测试一下:
先运行，然后点command1，怎么样？是不是把你本地的ip都加到了列表框了？
好，这次我们在文本框里输入：www.moon-soft.com，然后点command1
最后一次测试，我们输入:www.microsoft.com，然后点command1，天哪，他的服务器有那么多ip:(
|