VB将域名转换成IP地址


Option Explicit   
  
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 256) As Byte  
	szSystemStatus(0 To 128) 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 As Integer, lpWSAData As WSADATA) As Long  
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long  
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHostname As String, ByVal HostLen As Long) As Long  
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHostname As String) As Long  
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)   
  
Private Const WS_VERSION_REQD = &H101   
  
Private Function Test(URL As String) As String  
	InitializeWinSock   
	Test = GetAddressByName(URL)   
	TerminateWinSock   
End Function  
  
Private Function GetAddressByName(strHostname As String)   
	Dim lngAddr As Long  
	Dim udtHost As HOSTENT   
	Dim lngIP As Long  
	Dim bteTmp() As Byte  
	Dim i As Integer  
	Dim strIP As String  
  
	lngAddr = gethostbyname(strHostname)   
  
	If lngAddr = 0 Then  
		MsgBox "Kein Host gefunden."  
		GetAddressByName = Null   
		Exit Function  
	End If  
  
	RtlMoveMemory udtHost, lngAddr, LenB(udtHost)   
	RtlMoveMemory lngIP, udtHost.hAddrList, 4   
  
	ReDim bteTmp(1 To udtHost.hLength)   
	RtlMoveMemory bteTmp(1), lngIP, udtHost.hLength   
	For i = 1 To udtHost.hLength   
		strIP = strIP & bteTmp(i) & "."  
	Next  
	strIP = Mid$(strIP, 1, Len(strIP) - 1)   
  
	GetAddressByName = strIP   
End Function  
  
Private Sub InitializeWinSock()   
	Dim udtWSAD As WSADATA   
	Dim lngRet As Long  
	lngRet = WSAStartup(WS_VERSION_REQD, udtWSAD)   
	If lngRet <> 0 Then  
		MsgBox "Winsock.dll konnte nicht initialisiert werden."  
		End  
	End If  
End Sub  
  
Private Sub TerminateWinSock()   
	Dim lngRet As Long  
	lngRet = WSACleanup()   
	If lngRet <> 0 Then  
		MsgBox "Fehler " & lngRet & " beim Beenden von Winsock.dll"  
		End  
	End If  
End Sub  
  
Private Sub Command1_Click()   
	Dim MyURL As String  
	MyURL = "domain"  
	MsgBox MyURL & "的IP地址是:" & Test(MyURL)   
End Sub 


17年前4月8日 阅读:311 评论:0

青锋幽灵

゛. - 看過世间最冷漠滴眼神,  爱過⒈生最无缘滴人﹎

评论 More..

该页面还没有任何评论,赶快占个沙发吧!

登录 注册

您没有登录,如果还不是会员请先注册

文明上网,理性发帖!


顶部