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 256As Byte  
    szSystemStatus(
0 To 128As 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 LongAs Long  
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHostname As StringAs 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 StringAs 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, 1Len(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  

posted on 2010-10-20 20:20 aiaiwoo 阅读(359) 评论(0)  编辑  收藏


只有注册用户登录后才能发表评论。


网站导航:
 
<2022年8月>
31123456
78910111213
14151617181920
21222324252627
28293031123
45678910

导航

统计

常用链接

留言簿

随笔分类

文章分类

文章档案

搜索

最新评论

阅读排行榜

评论排行榜