打印本文 打印本文 关闭窗口 关闭窗口
MX记录获取组件(vb实现)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数2095  更新时间:2009/4/23 18:59:20  文章录入:mintao  责任编辑:mintao

源码是老外的,俺做了点修改,写成了dll

方法:

Public Function GetDNSinfo() As String

获取dns信息

Public Function MX_Query(DNS_Addr As String, ByVal Domain_Addr As String) As String

获取mx最佳记录,

dns_addr,域名解析服务器,可以用getdnsinfo获取,也可以用nslookup命令

domain_addr,想要获取邮件服务器的域名,如163.com ,hotmail.com

http://www.aspcdrom.com/down/mxquery.rar

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  ''''True
  Persistable = 0  ''''NotPersistable
  DataBindingBehavior = 0  ''''vbNone
  DataSourceBehavior  = 0  ''''vbNone
  MTSTransactionMode  = 0  ''''NotAnMTSObject
END
Attribute VB_Name = "mxquery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private WithEvents objWinSock As MSWinsockLib.Winsock
Attribute objWinSock.VB_VarHelpID = -1

Private Const ERROR_BUFFER_OVERFLOW = 111

Private DNSrecieved As Boolean
Private dnsReply() As Byte

Private Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const DNS_RECURSION As Byte = 1
Private Const MAX_HOSTNAME_LEN = 132
Private Const MAX_DOMAIN_NAME_LEN = 132
Private Const MAX_SCOPE_ID_LEN = 260
Private Const MAX_ADAPTER_NAME_LENGTH = 260
Private Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132

Private Type IP_ADDR_STRING
            Next As Long
            IpAddress As String * 16
            IpMask As String * 16
            Context As Long
End Type

Private Type FIXED_INFO
            HostName As String * MAX_HOSTNAME_LEN
            DomainName As String * MAX_DOMAIN_NAME_LEN
            CurrentDnsServer As Long
            DnsServerList As IP_ADDR_STRING
            NodeType As Long
            ScopeId  As String * MAX_SCOPE_ID_LEN
            EnableRouting As Long
            EnableProxy As Long
            EnableDns As Long
End Type

Private Type DNS_HEADER
    qryID As Integer
    options As Byte
    response As Byte
    qdcount As Integer
    ancount As Integer
    nscount As Integer
    arcount As Integer
End Type

Private Type HostEnt
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

Private Const hostent_size = 16

Private Type servent
    s_name As Long
    s_aliases As Long
    s_port As Integer
    s_proto As Long
End Type

Private Function MakeQName(sDomain As String) As String
    Dim iQCount As Integer      '''' Character count (between dots)
    Dim iNdx As Integer         '''' Index into sDomain string
    Dim iCount As Integer       '''' Total chars in sDomain string
    Dim sQName As String        '''' QNAME string
    Dim sDotName As String      '''' Temp string for chars between dots
    Dim sChar As String         '''' Single char from sDomain string
   
    iNdx = 1
    iQCount = 0
    iCount = Len(sDomain)
    '''' While we haven''''t hit end-of-string
    While (iNdx <= iCount)
        '''' Read a single char from our domain
        sChar = Mid(sDomain, iNdx, 1)
        '''' If the char is a dot, then put our character count and the part of the string
        If (sChar = ".") Then
            sQName = sQName & Chr(iQCount) & sDotName
            iQCount = 0
            sDotName = ""
        Else
            sDotName = sDotName + sChar
            iQCount = iQCount + 1
        End If
        iNdx = iNdx + 1
    Wend
   
    sQName = sQName & Chr(iQCount) & sDotName
   
    MakeQName = sQName
End Function
Private Sub ParseName(dnsReply() As Byte, iNdx As Integer, sName As String)
    Dim iCompress As Integer        '''' Compression index (index into original buffer)
    Dim iChCount As Integer         '''' Character count (number of chars to read from buffer)
       
    '''' While we didn''''t encounter a null char (end-of-string specifier)
    While (dnsReply(iNdx) <> 0)
        '''' Read the next character in the stream (length specifier)
        iChCount = dnsReply(iNdx)
        '''' If our length specifier is 192 (0xc0) we have a compressed string
        If (iChCount = 192) Then
            '''' Read the location of the rest of the string (offset into buffer)
            iCompress = dnsReply(iNdx + 1)
            '''' Call ourself again, this time with the offset of the compressed string
            ParseName dnsReply(), iCompress, sName
            '''' Step over the compression indicator and compression index
            iNdx = iNdx + 2
            '''' After a compressed string, we are done
            Exit Sub
        End If
       
        '''' Move to next char
        iNdx = iNdx + 1
        '''' While we should still be reading chars
        While (iChCount)
            '''' add the char to our string
            sName = sName + Chr(dnsReply(iNdx))
            iChCount = iChCount - 1
            iNdx = iNdx + 1
        Wend
        '''' If the next char isn''''t null then the string continues, so add the dot
        If (dnsReply(iNdx) <> 0) Then sName = sName + "."
    Wend
End Sub


Private Function GetMXName(dnsReply() As Byte, iNdx As Integer, iAnCount As Integer) As String
    Dim iChCount As Integer     '''' Character counter
    Dim sTemp As String         '''' Holds original query string
   
    Dim iMXLen As Integer
    Dim iBestPref As Integer &nbs

[1] [2] [3]  下一页

打印本文 打印本文 关闭窗口 关闭窗口