p; '''' Holds the "best" preference number (lowest) Dim sBestMX As String '''' Holds the "best" MX record (the one with the lowest preference) iBestPref = -1 ParseName dnsReply(), iNdx, sTemp '''' Step over null iNdx = iNdx + 2 '''' Step over 6 bytes (not sure what the 6 bytes are, but all other '''' documentation shows steping over these 6 bytes) iNdx = iNdx + 6 On Error Resume Next While (iAnCount) '''' Check to make sure we received an MX record If (dnsReply(iNdx) = 15) Then Dim sName As String Dim iPref As Integer sName = "" '''' Step over the last half of the integer that specifies the record type (1 byte)
'''' Step over the RR Type, RR Class, TTL (3 integers - 6 bytes) iNdx = iNdx + 1 + 6 '''' Read the MX data length specifier '''' (not needed, hence why it''''s commented out) MemCopy iMXLen, dnsReply(iNdx), 2 iMXLen = ntohs(iMXLen) '''' Step over the MX data length specifier (1 integer - 2 bytes) iNdx = iNdx + 2 MemCopy iPref, dnsReply(iNdx), 2 iPref = ntohs(iPref) '''' Step over the MX preference value (1 integer - 2 bytes) iNdx = iNdx + 2 '''' Have to step through the byte-stream, looking for 0xc0 or 192 (compression char) Dim iNdx2 As Integer iNdx2 = iNdx ParseName dnsReply(), iNdx2, sName If (iBestPref = -1 Or iPref < iBestPref) Then iBestPref = iPref sBestMX = sName End If iNdx = iNdx + iMXLen + 1 '''' Step over 3 useless bytes ''''iNdx = iNdx + 3 Else GetMXName = sBestMX Exit Function End If iAnCount = iAnCount - 1 Wend GetMXName = sBestMX End Function
Public Function GetDNSinfo() As String Dim error As Long Dim FixedInfoSize As Long Dim strDNS As String Dim FixedInfo As FIXED_INFO Dim Buffer As IP_ADDR_STRING Dim FixedInfoBuffer() As Byte FixedInfoSize = 0 error = GetNetworkParams(ByVal 0&, FixedInfoSize) If error <> 0 Then If error <> ERROR_BUFFER_OVERFLOW Then MsgBox "GetNetworkParams sizing failed with error: " & error Exit Function End If End If ReDim FixedInfoBuffer(FixedInfoSize - 1)
error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize) If error = 0 Then CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo) strDNS = FixedInfo.DnsServerList.IpAddress strDNS = Replace(strDNS, vbCr, "") strDNS = Replace(strDNS, vbLf, "") strDNS = Replace(strDNS, vbNullChar, "") strDNS = Trim(strDNS) GetDNSinfo = strDNS End If End Function
Private Sub Class_Initialize() Set objWinSock = New MSWinsockLib.Winsock objWinSock.Protocol = sckUDPProtocol objWinSock.RemotePort = 53 End Sub
Private Sub Class_Terminate() Set objWinSock = Nothing '''' End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''class '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub objWinSock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Debug.Print Description End Sub
Private Sub objWinSock_DataArrival(ByVal bytesTotal As Long) DNSrecieved = True ReDim dnsReply(bytesTotal) As Byte objWinSock.GetData dnsReply, vbArray + vbByte End Sub
Public Function MX_Query(DNS_Addr As String, ByVal Domain_Addr As String) As String Dim IpAddr As Long Dim iRC As Integer Dim dnsHead As DNS_HEADER Dim iSock As Integer '''' Set the DNS parameters dnsHead.qryID = htons(&H11DF) dnsHead.options = DNS_RECURSION dnsHead.qdcount = htons(1) dnsHead.ancount = 0 dnsHead.nscount = 0 dnsHead.arcount = 0 '''' Query Variables Dim dnsQuery() As Byte Dim sQName As String Dim dnsQueryNdx As Integer Dim iTemp As Integer Dim iNdx As Integer dnsQueryNdx = 0 ReDim dnsQuery(4000) '''' Setup the dns structure to send the query in '''' First goes the DNS header information MemCopy dnsQuery(dnsQueryNdx), dnsHead, 12 dnsQueryNdx = dnsQueryNdx + 12 '''' Then the domain name (as a QNAME) sQName = MakeQName(Domain_Addr) iNdx = 0 While (iNdx < Len(sQName)) dnsQuery(dnsQueryNdx + iNdx) = Asc(Mid(sQName, iNdx + 1, 1)) iNdx = iNdx + 1 Wend
dnsQueryNdx = dnsQueryNdx + Len(sQName) '''' Null terminate the string dnsQuery(dnsQueryNdx) = &H0 dnsQueryNdx = dnsQueryNdx + 1 '''' The type of query (15 means MX query) iTemp = htons(15) MemCopy dnsQuery(dnsQueryNdx), iTemp, Len(iTemp) dnsQueryNdx = dnsQueryNdx + Len(iTemp)
上一页 [1] [2] [3] 下一页 [VB.NET程序]循环链表以及相关操作(VB实现) [VB.NET程序]浏览文件夹中的图片(用VB实现)
|