VB 域名转换IP地址函数

最新推荐文章于 2021-06-30 20:29:29 发布

原创最新推荐文章于 2021-06-30 20:29:29 发布 · 648 阅读

0 ·

CC 4.0 BY-SA版权

该篇博客介绍了一个使用VB编写的函数，用于将域名转换为对应的IP地址。通过调用示例代码展示了如何在FORM中使用这个函数，并且包含了相关WinSock初始化和清理的辅助函数。

它可以将一个域名转换成对应的IP地址。
调用FORM代码示例:

Private Sub Form_Load()
MsgBox DomainNameToIP("http://miaozk2006.blog.163.com")
End Sub

Module:

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

Public Function DomainNameToIP(URL As String) As String
    InitializeWinSock
    DomainNameToIP = 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

摘自：网络整理