DNS服务器名列表在注册表中可以查到，用 Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long 打开注册表中的对应项 用 Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long 获取相应项的值。具体的DNS列表在注册表中的位置要视具体的操作系统而定，你自己查一下。
http://expert.csdn.net/Expert/topic/1106/1106039.xml?temp=.3827783 接上面的貼子 ' The type of query (15 means MX query) iTemp = htons(15) MemCopy dnsQuery(dnsQueryNdx), iTemp, Len(iTemp) dnsQueryNdx = dnsQueryNdx + Len(iTemp)
' The class of query (1 means INET) iTemp = htons(1) MemCopy dnsQuery(dnsQueryNdx), iTemp, Len(iTemp) dnsQueryNdx = dnsQueryNdx + Len(iTemp)
ReDim Preserve dnsQuery(dnsQueryNdx - 1) ' Send the query to the DNS server iRC = sendto(iSock, dnsQuery(0), dnsQueryNdx + 1, 0, SocketBuffer, Len(SocketBuffer)) If (iRC = SOCKET_ERROR) Then MsgBox "Problem sending" Exit Function End If
' Wait for answer from the DNS server DoEvents Sleep (2) iRC = recvfrom(iSock, dnsReply(0), 2048, 0, SocketBuffer, Len(SocketBuffer)) If (iRC = SOCKET_ERROR) Then MsgBox "Problem receiving" Exit Function End If
' Get the number of answers MemCopy iAnCount, dnsReply(6), 2 iAnCount = ntohs(iAnCount) ' Parse the answer buffer sBestMX = GetMXName(dnsReply(), 12, iAnCount) End Function' 取得Windows的版本 Private Sub GetWinVersion() Dim W_Version As OSVERSIONINFO W_Version.dwOSVersionInfoSize = Len(W_Version) GetVersionEx W_Version
' Windows 9X If W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 10 And LoWord(W_Version.dwBuildNumber) = 1998 Then Is98 = True ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 10 And LoWord(W_Version.dwBuildNumber) = 2222 Then Is98se = True ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 90 And LoWord(W_Version.dwBuildNumber) = 3000 Then IsME = True ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 0 And LoWord(W_Version.dwBuildNumber) = 950 Then Is95 = True ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 0 And LoWord(W_Version.dwBuildNumber) = 1111 Then Is95B = True End If
' Windows NT If W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 3 Then IsNT3 = True ElseIf W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 4 Then IsNT4 = True ElseIf W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 5 And W_Version.dwMinorVersion = 0 Then Is2000 = True ElseIf W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 5 And W_Version.dwMinorVersion = 1 Then IsXP = True End If End SubPublic Property Get LocalDNSCount() As Integer LocalDNSCount = mi_DNSCount End PropertyPublic Property Get LocalDNSServer(ByVal Index As Integer) As String LocalDNSServer = sDNS(Index) End PropertyPrivate Function LoWord(lngIn As Long) As Integer If (lngIn And &HFFFF&) > &H7FFF Then LoWord = (lngIn And &HFFFF&) - &H10000 Else LoWord = lngIn And &HFFFF& End If End Function' Takes sDomain and converts it to the QNAME-type string, returns that. QNAME is how a ' DNS server expects the string. ' ' Ex... Pass - mail.com ' Returns - &H4mail&H3com ' ^ ^ ' |______|____ These two are character counters, they count the ' number of characters appearing after them 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 FunctionPublic Property Get MXServer(ByVal Index As Integer) MXServer = sMX(Index) End PropertyPublic Property Get MXServerCount() As Integer MXServerCount = mi_MXCount End Property' Parse the server name out of the MX record, returns it in variable sName, iNdx is also ' modified to point to the end of the parsed structure. Private Sub ParseName(dnsReply() As Byte, iNdx As Integer, sname As String) Dim iCompress As Integer ' Compression index (index to original buffer) Dim iChCount As Integer ' Character count (number of chars to read from buffer)
' While we dont 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 SubPublic Function Pref(ByVal Index As String) As String Pref = sPref(Index) End FunctionPublic Property Get PrefCount() As Integer PrefCount = mi_MXCount End Property
' 去除字符串中所有的空字符 Private Function StripTerminator(ByVal strString As String) As String Dim intZeroPos As Integer intZeroPos = InStr(strString, Chr$(0)) If intZeroPos > 0 Then StripTerminator = Left$(strString, intZeroPos - 1) Else StripTerminator = strString End If End FunctionPrivate Sub Class_Initialize() GetWinVersion End Sub
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
打开注册表中的对应项
用
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
获取相应项的值。具体的DNS列表在注册表中的位置要视具体的操作系统而定，你自己查一下。
http://expert.csdn.net/Expert/topic/1106/1106039.xml?temp=.3827783
接上面的貼子 ' The type of query (15 means MX query)
iTemp = htons(15)
MemCopy dnsQuery(dnsQueryNdx), iTemp, Len(iTemp)
dnsQueryNdx = dnsQueryNdx + Len(iTemp)
' The class of query (1 means INET)
iTemp = htons(1)
MemCopy dnsQuery(dnsQueryNdx), iTemp, Len(iTemp)
dnsQueryNdx = dnsQueryNdx + Len(iTemp)
ReDim Preserve dnsQuery(dnsQueryNdx - 1)
' Send the query to the DNS server
iRC = sendto(iSock, dnsQuery(0), dnsQueryNdx + 1, 0, SocketBuffer, Len(SocketBuffer))
If (iRC = SOCKET_ERROR) Then
MsgBox "Problem sending"
Exit Function
End If
' Wait for answer from the DNS server
DoEvents
Sleep (2)
iRC = recvfrom(iSock, dnsReply(0), 2048, 0, SocketBuffer, Len(SocketBuffer))
If (iRC = SOCKET_ERROR) Then
MsgBox "Problem receiving"
Exit Function
End If
' Get the number of answers
MemCopy iAnCount, dnsReply(6), 2
iAnCount = ntohs(iAnCount)
' Parse the answer buffer
sBestMX = GetMXName(dnsReply(), 12, iAnCount)
End Function' 取得Windows的版本
Private Sub GetWinVersion()
Dim W_Version As OSVERSIONINFO
W_Version.dwOSVersionInfoSize = Len(W_Version)
GetVersionEx W_Version
' Windows 9X
If W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 10 And LoWord(W_Version.dwBuildNumber) = 1998 Then
Is98 = True
ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 10 And LoWord(W_Version.dwBuildNumber) = 2222 Then
Is98se = True
ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 90 And LoWord(W_Version.dwBuildNumber) = 3000 Then
IsME = True
ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 0 And LoWord(W_Version.dwBuildNumber) = 950 Then
Is95 = True
ElseIf W_Version.dwPlatformId = 1 And W_Version.dwMinorVersion = 0 And LoWord(W_Version.dwBuildNumber) = 1111 Then
Is95B = True
End If
' Windows NT
If W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 3 Then
IsNT3 = True
ElseIf W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 4 Then
IsNT4 = True
ElseIf W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 5 And W_Version.dwMinorVersion = 0 Then
Is2000 = True
ElseIf W_Version.dwPlatformId = 2 And W_Version.dwMajorVersion = 5 And W_Version.dwMinorVersion = 1 Then
IsXP = True
End If
End SubPublic Property Get LocalDNSCount() As Integer
LocalDNSCount = mi_DNSCount
End PropertyPublic Property Get LocalDNSServer(ByVal Index As Integer) As String
LocalDNSServer = sDNS(Index)
End PropertyPrivate Function LoWord(lngIn As Long) As Integer
If (lngIn And &HFFFF&) > &H7FFF Then
LoWord = (lngIn And &HFFFF&) - &H10000
Else
LoWord = lngIn And &HFFFF&
End If
End Function' Takes sDomain and converts it to the QNAME-type string, returns that. QNAME is how a
' DNS server expects the string.
'
' Ex... Pass - mail.com
' Returns - &H4mail&H3com
' ^ ^
' |______|____ These two are character counters, they count the
' number of characters appearing after them
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 FunctionPublic Property Get MXServer(ByVal Index As Integer)
MXServer = sMX(Index)
End PropertyPublic Property Get MXServerCount() As Integer
MXServerCount = mi_MXCount
End Property' Parse the server name out of the MX record, returns it in variable sName, iNdx is also
' modified to point to the end of the parsed structure.
Private Sub ParseName(dnsReply() As Byte, iNdx As Integer, sname As String)
Dim iCompress As Integer ' Compression index (index to original buffer)
Dim iChCount As Integer ' Character count (number of chars to read from buffer)
' While we dont 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 SubPublic Function Pref(ByVal Index As String) As String
Pref = sPref(Index)
End FunctionPublic Property Get PrefCount() As Integer
PrefCount = mi_MXCount
End Property
' 去除字符串中所有的空字符
Private Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End FunctionPrivate Sub Class_Initialize()
GetWinVersion
End Sub