DNS就是我们所熟知的域名系统，当我们访问一个网站的时候，可以直接输入域名地址，之后我们的请求会通过公共的DNS服务器进行解析，由DNS服务器返回域名所在服务器的IP地址，再通过IP与网站服务器进行交互。

DNS除了提供网址IP的A记录功能之外，其实还有许多其他功能，比如CNAME别名记录、MX邮件记录、NS域名服务器、TXT文本记录等。
虽然.NET系统提供了丰富的网络连接功能，却没有一个比较好用的DNS记录获取功能，如果你想获取一个域名的TXT或者MX等数据，就需要调用Windows系统内置的 DnsQuery API。
只不过 DnsQuery 用起来比较麻烦，并且返回值还需要通过指针从非托管内存中来拷贝出数据，所以我直接在网上找到了现成的C#库源码，然后用工具转化成了VB，再手动修正了一些代码错误。

以下示例的C#源码来自于 https://github.com/xiangyuecn/DNS-csharp
我出于个人需求转化为VB并进行除错和调整，如有错漏请指正。

用法示例：

' 查询A记录（获取IP）
Dim d As New DNS.DNS_A
Dim ret = d.QueryOne("bilibili.com")
If ret.IsError Then
    Beep()
Else
    MsgBox(ret.Value)
End If

' 查询TXT记录（QueryAll查询所有记录）
Dim t As New DNS.DNS_TXT
Dim ret = t.QueryAll("bilibili.com")
MsgBox(ret.Value.Count) '获取的记录数
For Each tt In ret.Value
    MsgBox(tt)
Next

' 其他查询MX、CNAME记录的方式基本雷同

核心库 DNS.vb

' source by https://github.com/xiangyuecn/DNS-csharp
' vb.net by https://clso.fun

Imports System.Collections.Generic
Imports System.Linq
Imports System.Net
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Threading.Tasks

Namespace DNS

    Public Class DNS_A
        Inherits DNSBase

        <StructLayout(LayoutKind.Sequential)> _
        Private Class A
            Inherits Record
            'https://docs.microsoft.com/zh-cn/windows/desktop/api/windns/ns-windns-__unnamed_struct_2
            Public IpAddress As UInteger
        End Class

        Protected Overrides ReadOnly Property RecordType() As Type
            Get
                Return GetType(A)
            End Get
        End Property

        Protected Overrides Function GetVal(ByVal obj As Object) As String
            Return New IPAddress((CType(obj, A)).IpAddress).ToString()
        End Function

    End Class


    Public Class DNS_MX
        Inherits DNSBase

        <StructLayout(LayoutKind.Sequential)> _
        Private Class MX
            Inherits Record
            Public pNameExchange As IntPtr
            Public wPreference As Short
            Public Pad As Short
        End Class

        Protected Overrides ReadOnly Property RecordType() As Type
            Get
                Return GetType(MX)
            End Get
        End Property
        Protected Overrides Function GetVal(ByVal obj As Object) As String
            Return Marshal.PtrToStringUni((CType(obj, MX)).pNameExchange)
        End Function
    End Class

    Public Class DNS_CNAME
        Inherits DNSBase

        <StructLayout(LayoutKind.Sequential)> _
        Private Class CNAME
            Inherits Record
            Public pNameHost As IntPtr
        End Class

        Protected Overrides ReadOnly Property RecordType() As Type
            Get
                Return GetType(CNAME)
            End Get
        End Property
        Protected Overrides Function GetVal(ByVal obj As Object) As String
            Return Marshal.PtrToStringUni((CType(obj, CNAME)).pNameHost)
        End Function
    End Class

    Public Class DNS_NS
        Inherits DNSBase

        <StructLayout(LayoutKind.Sequential)> _
        Private Class NS
            Inherits Record
            Public pNameHost As IntPtr
        End Class

        Protected Overrides ReadOnly Property RecordType() As Type
            Get
                Return GetType(NS)
            End Get
        End Property
        Protected Overrides Function GetVal(ByVal obj As Object) As String
            Return Marshal.PtrToStringUni((CType(obj, NS)).pNameHost)
        End Function
    End Class

    Public Class DNS_PTR
        Inherits DNSBase

        <StructLayout(LayoutKind.Sequential)> _
        Private Class PTR
            Inherits Record
            Public pNameHost As IntPtr
        End Class

        Protected Overrides ReadOnly Property RecordType() As Type
            Get
                Return GetType(PTR)
            End Get
        End Property
        Protected Overrides Function GetVal(ByVal obj As Object) As String
            Return Marshal.PtrToStringUni((CType(obj, PTR)).pNameHost)
        End Function
        Private Shared exp As New Regex("^(\d+)\.(\d+)\.(\d+)\.(\d+)$")
        Protected Overrides Function TransformDomain(ByVal domain As String) As Result(Of String)
            Dim m As Match = exp.Match(domain)
            If m.Success Then
                domain = m.Groups(4).Value & "." & m.Groups(3).Value & "." & m.Groups(2).Value & "." & m.Groups(1).Value & ".in-addr.arpa"
            End If

            Return MyBase.TransformDomain(domain)
        End Function
    End Class

    Public Class DNS_TXT
        Inherits DNSBase

        <StructLayout(LayoutKind.Sequential)> _
        Private Class TXT
            Inherits Record
            Public dwStringCount As UInteger
            Public pStringArray As IntPtr
        End Class

        Protected Overrides ReadOnly Property RecordType() As Type
            Get
                Return GetType(TXT)
            End Get
        End Property
        Protected Overrides Function GetVal(ByVal obj As Object) As String
            Return Marshal.PtrToStringUni((CType(obj, TXT)).pStringArray)
        End Function
    End Class


    <StructLayout(LayoutKind.Sequential)> _
    Public MustInherit Class DNSBase
        Protected MustOverride ReadOnly Property RecordType() As Type
        Protected MustOverride Function GetVal(ByVal obj As Object) As String
        ''' <summary>
        ''' 如果此查询需要对域名进行特殊处理，就处理一下
        ''' </summary>
        Protected Overridable Function TransformDomain(ByVal domain As String) As Result(Of String)
            Dim rtv As New Result(Of String)()
            rtv.Value = domain
            Return rtv
        End Function

        Private Shared Types As New Dictionary(Of String, Integer)()
        ''' <summary>
        ''' 注册一个类型，比如A,0x1，类型参考https://docs.microsoft.com/zh-cn/windows/desktop/DNS/dns-constants中的DNS Record Types
        ''' </summary>
        Public Shared Sub RegisterType(ByVal type As String, ByVal value As Integer)
            Types(type) = value
        End Sub
        Shared Sub New()
            RegisterType("A", &H1)
            RegisterType("MX", &HF)
            RegisterType("CNAME", &H5)
            RegisterType("NS", &H2)
            RegisterType("PTR", &HC)
            RegisterType("TXT", &H10)
        End Sub


        ''' <summary>
        ''' 查询一条记录，如果没有记录或查询失败会返回原因
        ''' </summary>
        Public Function QueryOne(ByVal domain As String, Optional ByVal options As DNSQueryOptions = DNSQueryOptions.STANDARD) As Result(Of String)
            Dim rtv As New Result(Of String)()
            Dim res = QueryAll(domain, options)
            If res.IsError Then
                res.errorTo(rtv)
                Return rtv
            End If
            Dim val = res.Value
            If val.Count = 0 Then
                rtv.[error]("未查询到" & RecordType.Name & "记录")
                Return rtv
            End If

            rtv.Value = val(0)
            Return rtv
        End Function
        ''' <summary>
        ''' 查询此类型的记录列表，如果查询失败会返回原因
        ''' </summary>
        Public Function QueryAll(ByVal domain As String, Optional ByVal options As DNSQueryOptions = DNSQueryOptions.STANDARD) As Result(Of List(Of String))
            Dim rtv As New Result(Of List(Of String))()
            Dim list As New List(Of String)()
            rtv.Value = list

            If [String].IsNullOrEmpty(domain) Then
                rtv.[error]("查询" & RecordType.Name & "记录域名不能为空")
                Return rtv
            End If
            Try
                Dim tdRes = TransformDomain(domain)
                If tdRes.IsError Then
                    tdRes.errorTo(rtv)
                    Return rtv
                End If
                domain = tdRes.Value

                Dim ptr1 As IntPtr = IntPtr.Zero
                Dim ptr2 As IntPtr = IntPtr.Zero
                Dim rec As Record

                Dim type = Types(RecordType.Name)
                Dim num As Integer = DnsQuery(domain, type, options, 0, ptr1, 0)
                If num <> 0 Then
                    rtv.[error]("查询出错[" & num & "]")
                    Return rtv
                End If
                ptr2 = ptr1
                While Not ptr2.Equals(IntPtr.Zero)
                    rec = CType(Marshal.PtrToStructure(ptr2, RecordType), Record)
                    If rec.wType = type Then
                        list.Add(GetVal(rec))
                    End If
                    ptr2 = rec.pNext
                End While
                DnsRecordListFree(ptr2, 0)

                Return rtv
            Catch e As Exception
                rtv.fail("查询" & RecordType.Name & "记录出错：" & e.Message, e.ToString())
                Return rtv
            End Try
        End Function






        <DllImport("dnsapi", EntryPoint:="DnsQuery_W", CharSet:=CharSet.Unicode, SetLastError:=True, ExactSpelling:=True)> _
        Private Shared Function DnsQuery(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef pszName As String, ByVal wType As Integer, ByVal options As DNSQueryOptions, ByVal aipServers As Integer, ByRef ppQueryResults As IntPtr, ByVal pReserved As Integer) As Integer
        End Function

        <DllImport("dnsapi", CharSet:=CharSet.Auto, SetLastError:=True)> _
        Private Shared Sub DnsRecordListFree(ByVal pRecordList As IntPtr, ByVal FreeType As Integer)
        End Sub


        <StructLayout(LayoutKind.Sequential)> _
        Protected MustInherit Class Record
            'https://docs.microsoft.com/zh-cn/windows/desktop/api/windns/ns-windns-_dnsrecorda 固定数据
            Public pNext As IntPtr
            Public pName As IntPtr
            Public wType As Short
            Public wDataLength As Short
            Public flags As Integer
            Public dwTtl As Integer
            Public dwReserved As Integer
        End Class
    End Class


    'https://docs.microsoft.com/zh-cn/windows/desktop/DNS/dns-constants
    Public Enum DNSQueryOptions
        STANDARD = &H0
        ACCEPT_TRUNCATED_RESPONSE = &H1
        USE_TCP_ONLY = &H2
        NO_RECURSION = &H4
        BYPASS_CACHE = &H8
        NO_WIRE_QUERY = &H10
        NO_LOCAL_NAME = &H20
        NO_HOSTS_FILE = &H40
        NO_NETBT = &H80
        WIRE_ONLY = &H100
        RETURN_MESSAGE = &H200
        MULTICAST_ONLY = &H400
        NO_MULTICAST = &H800
        TREAT_AS_FQDN = &H1000
        ADDRCONFIG = &H2000
        DUAL_ADDR = &H4000
        MULTICAST_WAIT = &H20000
        MULTICAST_VERIFY = &H40000
        DONT_RESET_TTL_VALUES = &H100000
        DISABLE_IDN_ENCODING = &H200000
        APPEND_MULTILABEL = &H800000
        'RESERVED = 0xf0000000
    End Enum

End Namespace

辅助库 DNS_Unit.vb

' source by https://github.com/xiangyuecn/DNS-csharp
' vb.net by https://clso.fun

Imports System.Linq
Imports System.Security.Cryptography
Imports System.Text
Imports System.Threading.Tasks
Imports System.Runtime.CompilerServices

Namespace DNS

    ''' <summary>
    ''' 封装的一些通用方法
    ''' </summary>
    Public Module Extensions
        ''' <summary>
        ''' 用join字符串拼接数组内元素,list[0]+join+list[1]...
        ''' getFn:返回格式化后的字符串，比如"aa"，返回null不拼接此字符串
        ''' </summary>
        <Extension()>
        Public Function join(ByVal list As IEnumerable, ByVal joins As String, Optional ByVal getFn As Func(Of Object, String) = Nothing) As String
            Dim str As New StringBuilder()
            Dim start As Boolean = False
            For Each o As Object In list
                If getFn IsNot Nothing Then
                    Dim val As String = getFn(o)
                    If val IsNot Nothing Then
                        If start Then
                            str.Append(joins)
                        End If
                        str.Append(val)
                    Else
                        Continue For
                    End If
                Else
                    If start Then
                        str.Append(joins)
                    End If
                    str.Append(o)
                End If
                start = True
            Next
            Return str.ToString()
        End Function
    End Module

    Public Class Result
        Inherits IResult(Of Object)
    End Class

    Public Class Result(Of T)
        Inherits IResult(Of T)
    End Class


    Public MustInherit Class IResult(Of T)

        Public ReadOnly Property Json() As Dictionary(Of String, Object)
            Get
                Return _json
            End Get
        End Property
        Protected _json As Dictionary(Of String, Object)

        Public Sub New()
            _json = New Dictionary(Of String, Object)

            ErrorMessage = ""
            ServerErrorMessage = ""
        End Sub

        Protected isErr As Boolean = False
        Protected isSevErr As Boolean = False

        Public Property ErrorMessage() As String

        Public Property ServerErrorMessage() As String

        Public Property Value() As T
            Get
                Dim val As Object = Nothing
                Json.TryGetValue("v", val)

                'return val == null ? default(T) : (T)val;
                'Return If(val Is Nothing, Nothing, CType(val, T))
                Dim ret As T '尝试获取一个默认值
                Return If(val Is Nothing, ret, CType(val, T))
            End Get
            Set(ByVal value As T)
                Json("v") = value
            End Set
        End Property

        Public Function buildResult() As IResult(Of T)
            Json("c") = If(isErr, 1, 0)
            Json("m") = ErrorMessage
            If isSevErr Then
                Json("m_sev") = ServerErrorMessage
            End If

            Return Me
        End Function

        ''' <summary>
        ''' 运行过程中是否出现错误，如果出错后续业务不应该被执行
        ''' </summary>
        Public ReadOnly Property IsError() As Boolean
            Get
                Return isErr
            End Get
        End Property

        ''' <summary>
        ''' 运行异常，比如无法处理的捕获异常
        ''' </summary>
        ''' <param name="message">用户提示</param>
        ''' <param name="serverMessage">服务器错误详细信息</param>
        Public Sub fail(ByVal message As String, ByVal serverMessage As String)
            isSevErr = True
            ServerErrorMessage = serverMessage
            [error](message)
        End Sub

        ''' <summary>
        ''' 出现错误，给用户友好提示
        ''' </summary>
        ''' <param name="message">用户提示</param>
        Public Sub [error](ByVal message As String)
            isErr = True
            ErrorMessage = message
        End Sub

        ''' <summary>
        ''' 把错误信息设置到另外一个对象，包括服务器错误，如果result已经有错将不会复制，新的错误会添加到现有错误前面
        ''' </summary>
        Public Sub errorTo(Of X)(ByVal result As IResult(Of X), Optional ByVal newErr As String = "", Optional ByVal newSrvErr As String = "")
            If result.isErr OrElse Not isErr Then
                Return
            End If
            Dim err As String = If([String].IsNullOrEmpty(newErr), "", newErr & vbLf & "by" & vbLf)
            err &= ErrorMessage
            Dim srvErr As String = If([String].IsNullOrEmpty(newErr), "", newSrvErr & vbLf & "by" & vbLf)

            If isSevErr OrElse srvErr <> "" Then
                srvErr &= ServerErrorMessage

                result.fail(err, srvErr)
            Else
                result.[error](err)
            End If
        End Sub

    End Class

End Namespace