上面的办法可以,不过txt文件中找出ip地址,的确麻烦一些没有更简单的方法使用winsock api函数得到 Private Const SOCKET_ERROR As Long = -1 Private Const MAX_WSADescription = 256 Private Const MAX_WSASYSStatus = 128 Private Const ERROR_SUCCESS As Long = 0 Private Const WS_VERSION_REQD As Long = &H101 Private Const MIN_SOCKETS_REQD As Long = 1 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 Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLen As Integer hAddrList As Long End TypePrivate 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 TypePrivate Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)Private Function GetIPAddress(Optional sHost As String) As String '返回给定机器名的Ip地址,机器名为空时返回本机Ip地址 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 Dim werr As Long If Not SocketsInitialize() Then GetIPAddress = "" Exit Function End If
If sHost = "" Then If gethostname(sHostName, 256) = SOCKET_ERROR Then werr = WSAGetLastError() GetIPAddress = "" SocketsCleanup Exit Function End If sHostName = Trim$(sHostName) Else sHostName = Trim$(sHost) & Chr$(0) End If
lpHost = gethostbyname(sHostName) If lpHost = 0 Then werr = WSAGetLastError() GetIPAddress = "" SocketsCleanup Exit Function End If CopyMemory HOST, lpHost, Len(HOST) CopyMemory dwIPAddr, HOST.hAddrList, 4 ReDim tmpIPAddr(1 To HOST.hLen) CopyMemory 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 FunctionPrivate Function SocketsInitialize(Optional sErr As String) As Boolean Dim WSAD As WSADATA, sLoByte As String, sHiByte As String If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then sErr = "The 32-bit Windows Socket is not responding." SocketsInitialize = False Exit Function End If If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then sErr = "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)) sErr = "Sockets version " & sLoByte & "." & sHiByte & _ " is not supported by 32-bit Windows Sockets." SocketsInitialize = False Exit Function End If SocketsInitialize = True End FunctionPrivate Sub SocketsCleanup() If WSACleanup() <> ERROR_SUCCESS Then App.LogEvent "Socket error occurred in Cleanup.", vbLogEventTypeError End If End SubPrivate Function HiByte(ByVal wParam As Integer) HiByte = wParam \ &H1 And &HFF& End FunctionPrivate Function LoByte(ByVal wParam As Integer) LoByte = wParam And &HFF& End FunctionPrivate Sub Command1_Click() On Error Resume Next Screen.MousePointer = vbHourglass TxtIp.Text = GetIPAddress(TxtCmpName.Text) Screen.MousePointer = vbDefault End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) '不是回车和退格键的时候,校验长度和字符 If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then '是否输入了数字 If ((KeyAscii < vbKey0) Or (KeyAscii > vbKey9)) And KeyAscii <> 46 Then Beep 50, 10 KeyAscii = 0 End If
'校验长度 If Len(txtInfo(Index).Text) >= 5 Then MsgBox "您输入的数字太长!", vbInformation, "提示" KeyAscii = 0 Exit Sub End If End If End Sub
UP 学习 晚上出去上自习还在想ping可以解析域名--IP 怎么获得ping得到的数据 还是老大有经验 呵呵 管道操作 导入文本 再分析数据
给你一个简单的..可以再完善功能.. Private Sub Command1_Click() MsgBox "IP地址为:" & Me.Winsock1.RemoteHostIP '返回IP地址为218.30.108.68 End SubPrivate Sub Form_Load() Me.Winsock1.RemoteHost = "www.sina.com.cn" '指定域名 Me.Winsock1.RemotePort = 80 '指定端口 Me.Winsock1.Connect '首先建立连接 End Sub
来返回
其中txtnumber是次数ShellX = Shell("command.com /c ping -n " & txtNumber.Text & " " & txtIP.Text & " > C:\log.txt", vbHide)
Private Const SOCKET_ERROR As Long = -1
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const ERROR_SUCCESS As Long = 0
Private Const WS_VERSION_REQD As Long = &H101
Private Const MIN_SOCKETS_REQD As Long = 1
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 Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End TypePrivate 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 TypePrivate Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)Private Function GetIPAddress(Optional sHost As String) As String
'返回给定机器名的Ip地址,机器名为空时返回本机Ip地址
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
Dim werr As Long If Not SocketsInitialize() Then
GetIPAddress = ""
Exit Function
End If
If sHost = "" Then
If gethostname(sHostName, 256) = SOCKET_ERROR Then
werr = WSAGetLastError()
GetIPAddress = ""
SocketsCleanup
Exit Function
End If sHostName = Trim$(sHostName)
Else
sHostName = Trim$(sHost) & Chr$(0)
End If
lpHost = gethostbyname(sHostName) If lpHost = 0 Then
werr = WSAGetLastError()
GetIPAddress = ""
SocketsCleanup
Exit Function
End If CopyMemory HOST, lpHost, Len(HOST)
CopyMemory dwIPAddr, HOST.hAddrList, 4 ReDim tmpIPAddr(1 To HOST.hLen)
CopyMemory 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 FunctionPrivate Function SocketsInitialize(Optional sErr As String) As Boolean
Dim WSAD As WSADATA, sLoByte As String, sHiByte As String
If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
sErr = "The 32-bit Windows Socket is not responding."
SocketsInitialize = False
Exit Function
End If If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
sErr = "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)) sErr = "Sockets version " & sLoByte & "." & sHiByte & _
" is not supported by 32-bit Windows Sockets." SocketsInitialize = False
Exit Function
End If
SocketsInitialize = True
End FunctionPrivate Sub SocketsCleanup()
If WSACleanup() <> ERROR_SUCCESS Then
App.LogEvent "Socket error occurred in Cleanup.", vbLogEventTypeError
End If
End SubPrivate Function HiByte(ByVal wParam As Integer)
HiByte = wParam \ &H1 And &HFF&
End FunctionPrivate Function LoByte(ByVal wParam As Integer)
LoByte = wParam And &HFF&
End FunctionPrivate Sub Command1_Click()
On Error Resume Next
Screen.MousePointer = vbHourglass
TxtIp.Text = GetIPAddress(TxtCmpName.Text)
Screen.MousePointer = vbDefault
End Sub
'不是回车和退格键的时候,校验长度和字符
If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
'是否输入了数字
If ((KeyAscii < vbKey0) Or (KeyAscii > vbKey9)) And KeyAscii <> 46 Then
Beep 50, 10
KeyAscii = 0
End If
'校验长度
If Len(txtInfo(Index).Text) >= 5 Then
MsgBox "您输入的数字太长!", vbInformation, "提示"
KeyAscii = 0
Exit Sub
End If
End If
End Sub
晚上出去上自习还在想ping可以解析域名--IP
怎么获得ping得到的数据
还是老大有经验 呵呵
管道操作 导入文本 再分析数据
但是不正规或者乱输的则为123 或者abcde或者新浪,此为根本不存在的,把他不做处理,然后程序检测到正规格式的域名则做出解析的代码,谢谢了,麻烦给我现成的代码!
给你一个简单的..可以再完善功能..
Private Sub Command1_Click()
MsgBox "IP地址为:" & Me.Winsock1.RemoteHostIP '返回IP地址为218.30.108.68
End SubPrivate Sub Form_Load()
Me.Winsock1.RemoteHost = "www.sina.com.cn" '指定域名
Me.Winsock1.RemotePort = 80 '指定端口
Me.Winsock1.Connect '首先建立连接
End Sub
另外,以上程序对实际存在的域名可以解析出IP地址来,但是对如别人免费申请的域名,如免费析的通过页面转向的IP地址不能实现效果!如http://hhlvod.yeah.net 就不能解析出他实际的主机地址来,而是把域名提供商的地址给解析出来了,这个需要怎么做!
----------------------------------------------------------------------------------
不可能,这是采用的虚拟主机技术实现的,原则上所有的*.yeah.net都是解析到一个IP的