Query DNS for MX (Mail Exchange) records

[Florent Heyworth]

[UPDATED 20-Jun-2002 small correction in GetNetworkParams as well
as a few tweaks to make it work with PBCC 2.x - 3 and PBDLL 6.x - 7]
[UPDATED 16-May-2001 uses GetNetworkParams if possible]
[UPDATED 04-May-2001 (better DNS server detection)]
[UPDATED 24-Mar-2001, 22-Mar-2001, 18-Mar-2001]

Hi

I saw several people asking how to retrieve the mail host for
a given e-mail address by looking up the MX (Mail Exchange)
DNS records so here's some source that'll do that.

I've only tested it on NT 4.0 SP6 so please test it on your
system. If possible I'd appreciate it if you would confirm
that it works on your system (preferably in the Programming
Forum) as well as inform me of any eventual bugs.

#IF 0
************************************************************************
* ' DNSQRY.BAS - Query DNS servers for domain information
* '
* ' Currently you can ask for any record however I've only
* ' implemented the following record format parsing at
* ' the moment:
* '
* ' - MX record
* '
* ' TODO - XXX implement the other record formats parsing ;-)
* '
* ' Written by  : Florent Heyworth
* ' Date        : 17-Mar-2001
* ' Last edit   : 20-Jun-2002
* '
* ' This code is hereby released in the Public Domain
* ' Use at your own risk, etc       [img]http://www.powerbasic.com/support/forums/smile.gif[/img]
* ' Enjoy!
* '
* ' Usage: dnsqry domain_or_email /t MX [/d Optional DNS Server]
* ' You can redirect the output to file by doing  > out.txt
* ' after the options
* '
* '
* ' Updates     : 18-Mar-2001 - took into account the possibility
* '               of branching from within a compressed DNS
* '               buffer. Seems to work okay... Some DNS answers
* '               are formatted that way (very few so far) and the
* '               tail end of the MX mailhost would get mangled...
* '
* '             : 22-Mar-2001 - added IP address resolution for
* '               MX records hosts - moved some of the parsing
* '               to separate subs, implemented a very primitive
* '               command line parser which accepts an optional
* '               DNS server IP (dotted name notation) from the
* '               command line AS well as a type record (at the
* '               moment only MX records are supported)
* '               The app now returns both the Resource Records
* '               as well as any associated Authority Records
* '
* '             : 24-Mar-2001 - moved futher parts of the parsing to
* '               a subroutine
* '
* '             : 16-May-2001 - added GetNetworkParams for DNS server
* '               resolution (untested since it returns
* '               ERROR_NOT_SUPPORTED on my NT 4.0 SP6 system)
* '
* '             : 20-Jun-2002 - updated to work with both PBCC/PBDLL
* '               6.x/2.x and 7/3
* '
************************************************************************
#ENDIF
#COMPILE EXE
#REGISTER NONE
#INCLUDE "win32api.inc"
#INCLUDE "wsock32.inc"
 
%CLASS_IN = 1 'Internet class
 
%QUERY_A         = 1       'Host Address
%QUERY_NS        = 2       'Authoritative Name Server
%QUERY_MD        = 3       'Mail destination (obsolete)
%QUERY_MF        = 4       'Mail Forwarder (Obsolete)
%QUERY_CNAME     = 5       'Canonical name of an alias
%QUERY_SOA       = 6       'Start Zone of Authority
%QUERY_MB        = 7       'Mailbox Domain Name
%QUERY_MG        = 8       'Mail Group Member
%QUERY_MR        = 9       'Mail Rename Domain Name
%QUERY_NULL      = 10      'Null resource record
%QUERY_WKS       = 11      'Well Known Service description
%QUERY_PTR       = 12      'Domain Name Pointer
%QUERY_HINFO     = 13      'Host Information
%QUERY_MINFO     = 14      'Mailbox or Mail List information
%QUERY_MX        = 15      'Mail Exchange
%QUERY_TXT       = 16      'Text
%QUERY_RP        = 17      'Responsible Person
%QUERY_AFSDB     = 18      'AFS Data Base Location
%QUERY_X25       = 19      'X.25 PSDN Address
%QUERY_ISDN      = 20      'ISDN Address
%QUERY_RT        = 21      'Route Through
%QUERY_NSAP      = 22      'NSAP Style A Record
%QUERY_NSAP_PTR  = 23      'NSAP Style A Record pointer
%QUERY_SIG       = 24      'Security Signature
%QUERY_KEY       = 25      'Security Key
%QUERY_PX        = 26      'X.400 Mail Mapping Information
%QUERY_GPOS      = 27      'Geographical Position
%QUERY_AAAA      = 28      'IP6 Address
%QUERY_LOC       = 29      'Location Information
%QUERY_NXT       = 30      'Next Domain
%QUERY_EID       = 31      'Endpoint Identifier
%QUERY_NIMLOC    = 32      'Nimrod Locator
%QUERY_SRV       = 33      'Server Selection
%QUERY_IXFR      = 251     'Incremental Transfer
%QUERY_AXFR      = 252     'Entire zone transfer
%QUERY_MAILB     = 253     'Mailbox-related RRs (MB, MG, or MR)
%QUERY_MAILA     = 254     'Mail Agent (obsolete)
%QUERY_ALL       = 255     'All Records
 
%ERROR_NOERROR  = 0        ' No Error
%ERROR_FORMAT   = 1        ' Format Error
%ERROR_SERVFAIL = 2        ' Server Failure
%ERROR_NXDOMAIN = 3        ' Non-Existent Domain
%ERROR_NOTIMP   = 4        ' Not Implemented
%ERROR_REFUSED  = 5        ' Query Refused
%ERROR_YXDOMAIN = 6        ' Name Exists when it should not
%ERROR_YXRRSET  = 7        ' RR Set Exists when it should not
%ERROR_NXRRSET  = 8        ' RR Set that should exists does not
%ERROR_NOTAUTH  = 9        ' Server Not Authoritative for Zone
 
%DNS_FLAG_QR    = &H8000?
%DNS_FLAG_AA    = &H0800?
%DNS_FLAG_TC    = &H0400?
%DNS_RFLAG      = &H0100?
%DNS_FLAG_RA    = &H0100?
%DNS_RCODE_MASK = &H000F?
%DNS_OPCODE_MASK= &H7800?
 
%PACKETSZ       = 512         ' maximum packet size
%MAXDNAME       = 1025        ' maximum presentation domain name
%MAXCDNAME      = 255         ' maximum compressed domain name
%MAXLABEL       = 63          ' maximum length OF domain label
%HFIXEDSZ       = 12          ' bytes OF fixed data in header
%QFIXEDSZ       = 4           ' bytes OF fixed data in query
%RRFIXEDSZ      = 10          ' bytes OF fixed data in r record
%INADDRSZ       = 4           ' IPv4
%IN6ADDRSZ      = 16          ' IPv6 T_AAAA
 
%MAXALIASES     = 35
%MAXADDRS       = 35
%MAXDOMAINS     = 35
%MAXSERVERS     = 10
 
'User returned error codes
%ERROR_USER_NOERROR  =  0        ' No Error or empty query
%ERROR_USER_FORMAT   = -9        ' Format Error
%ERROR_USER_SERVFAIL = -8        ' Server Failure
%ERROR_USER_NXDOMAIN = -7        ' Non-Existent Domain
%ERROR_USER_NOTIMP   = -6        ' Not Implemented
%ERROR_USER_REFUSED  = -5        ' Query Refused
%ERROR_USER_YXDOMAIN = -4        ' Name Exists when it should not
%ERROR_USER_YXRRSET  = -3        ' RR Set Exists when it should not
%ERROR_USER_NXRRSET  = -2        ' RR Set that should exists does not
%ERROR_USER_NOTAUTH  = -1        ' Server Not Authoritative for Zone
%ERROR_USER_NOQUERY  = -10       ' Query length passed is null or not a query
 
'TODO -XXX define types for other TYPE queries
TYPE MX_RECORD
    wPreference AS WORD
    szName AS ASCIIZ * 256
    szDomain AS ASCIIZ * 256
    szIp AS ASCIIZ * 16
END TYPE
 
TYPE NS_RECORD
    szName AS ASCIIZ * 256
    szDomain AS ASCIIZ * 256
END TYPE
 
TYPE QR_REC
    wQueryType AS WORD
    wQueryClass AS WORD
END TYPE
 
TYPE DNS_HEADER 'fixed part = 12 bytes
    wId AS WORD
 
    'Format of wBitFields is as follows
    'Bit 0 (QR) 0 if Query, 1 if response
    'Bits 1-4 (OPCODE) 0 if standard query, 1 if inverse query, 2 server status request
    'Bit 5 (AA) if set server is authoritative
    'Bit 6 (TC) if set reply size was > 512 bytes and only 512 bytes were returned (UDP only)
    'Bit 7 (RD) if this bit is not set then recursion is denied
    'Bit 8 (RA) if bit is set by responding server indicates that server can handle recursive queries
    'Bits 9-11 (unused bits)
    'Bits 12-15 (RCODE) 0 = no error, 1 malformed query, 2 server failed, 3 name does not exist
    '                   4 = query not supported, 5 = server refused to answer
    wBitFields AS WORD
    'Question count
    wQCount AS WORD
    'Answer Resource record count
    wARCount AS WORD
    'Answer Authority record count
    wAAcount AS WORD
    'Additional Resource record count
    wAAARCount AS WORD
END TYPE
 
TYPE DNS_RR_HEADER
    wType AS WORD  'Type code (A, MX, etc)
    wClass AS WORD 'Class code (IN for internet, etc)
    dwTTL AS DWORD   'Time to live
    wLength AS WORD'Len of wRdata field (in octects)
    dwRData AS DWORD 'Field name address (variable length)
END TYPE
 
TYPE T_QUERY
    tHeader AS DNS_HEADER
    tQrRec AS QR_REC
END TYPE
 
UNION U_PARSE_PTR
    bPtr AS BYTE PTR
    wPtr AS WORD PTR
    lPtr AS LONG PTR
    dwPtr AS DWORD PTR
END UNION
 
'DECLARE SUB ZeroMemory LIB "KERNEL32.DLL" ALIAS "RtlZeroMemory" (BYVAL dwDestination AS DWORD, BYVAL dwLen AS DWORD)

'IPHLPAPI.DLL declares
TYPE IP_ADDRESS_STRING
    IpAddressString AS ASCIIZ * 16
END TYPE
'
TYPE IP_MASK_STRING
    IpMaskString(15) AS ASCIIZ * 16
END TYPE
'
TYPE IP_ADDR_STRING
    lNext      AS LONG
    IpAddress AS IP_ADDRESS_STRING
    IpMask    AS IP_MASK_STRING
    Context   AS LONG
END TYPE
'
%MAX_HOSTNAME_LEN = 128
%MAX_DOMAIN_NAME_LEN = 128
%MAX_SCOPE_ID_LEN = 256
' 
TYPE FIXED_INFO
    HostName(%MAX_HOSTNAME_LEN + 4 - 1)AS BYTE
    DomainName(%MAX_DOMAIN_NAME_LEN + 4 - 1) AS BYTE
    CurrentDnsServer AS LONG
    DnsServerList    AS IP_ADDR_STRING PTR
    NodeType         AS LONG
    ScopeId(%MAX_SCOPE_ID_LEN + 4 - 1) AS BYTE
    EnableRouting    AS LONG
    EnableProxy      AS LONG
    EnableDns        AS LONG
END TYPE
 
DECLARE FUNCTION GetNetworkParams ALIAS "GetNetworkParams" (BYREF pFixedInfo AS FIXED_INFO, BYREF pOutBufLen AS DWORD) AS LONG
 
%ERROR_NOT_SUPPORTED = 50
%ERROR_BUFFER_OVERFLOW = 111
%ERROR_INVALID_PARAMETER = 87
%ERROR_NO_DATA = 232
 
FUNCTION DoConnect(szHostname AS ASCIIZ,wPort AS WORD, BYREF sock_sa AS sockaddr_in) AS LONG
   DIM sock_hp AS hostentStru PTR
   DIM sock_socket AS LONG
   DIM lResult AS LONG
 
   sock_hp=gethostbyname(szHostname)
   IF sock_hp=%NULL THEN
      FUNCTION=%INVALID_SOCKET
      EXIT FUNCTION
   END IF
 
   sock_sa.sin_addr.s_addr = @[email protected]@h_list
   sock_sa.sin_family = %AF_INET
   sock_sa.sin_port = htons(wPort)
   sock_sa.sin_zero=STRING$(8, 0)
   sock_socket=socket(%PF_INET,%SOCK_DGRAM,0)
 
   IF sock_socket=%INVALID_SOCKET THEN
      FUNCTION=%INVALID_SOCKET
      EXIT FUNCTION
   END IF
 
   IF cconnect(sock_socket,sock_sa,SIZEOF(sock_sa)) = %SOCKET_ERROR THEN
      FUNCTION=%INVALID_SOCKET
      EXIT FUNCTION
   END IF
 
   FUNCTION=sock_socket
 
END FUNCTION
 
FUNCTION GetDnsFromIpHlpApi( BYREF szDns AS ASCIIZ ) AS LONG
    'Untested since it returns ERROR_NOT_SUPPORTED on my system NT 4.0 SP6
    LOCAL lResult AS LONG
    LOCAL hLib AS LONG
    LOCAL dwCodePtr AS DWORD
    LOCAL dwNetInfoSize AS DWORD
    LOCAL ptNetInfo AS FIXED_INFO PTR
    LOCAL ptIpAddr AS IP_ADDR_STRING PTR
 
    hLib = LoadLibrary( "iphlpapi.dll" )
    IF hLib = %NULL THEN
        EXIT FUNCTION
    END IF
 
    dwCodePtr = GetProcAddress( hLib, "GetNetworkParams" )
    IF dwCodePtr = %NULL THEN
        GOTO Clean_Up
    END IF
 
    'Get information about network params allocation size
    CALL DWORD dwCodePtr USING GetNetworkParams( BYVAL %NULL, dwNetInfoSize ) TO lResult
    IF lResult THEN
        IF lResult <> %ERROR_BUFFER_OVERFLOW THEN
            GOTO Clean_Up
        END IF
    END IF
 
    ptNetInfo = HeapAlloc( GetProcessHeap(), BYVAL %HEAP_ZERO_MEMORY, dwNetInfoSize )
    IF ptNetInfo = %NULL THEN
        GOTO Clean_Up
    END IF
 
    'Get params
    CALL DWORD dwCodePtr USING GetNetworkParams( BYVAL ptNetInfo, dwNetInfoSize ) TO lResult
    IF lResult THEN
        GOTO Clean_Up
    END IF
 
    ptIpAddr = @ptNetInfo.DnsServerList
    DO WHILE ptIpAddr
        szDns = szDns + TRIM$(@ptIpAddr.IpAddress, CHR$(0)) + " "
        ptIpAddr = @ptIpAddr.lNext
    LOOP
 
    IF LEN(szDns) THEN
        FUNCTION = %TRUE
    END IF
 
Clean_Up:
    IF hLib THEN CALL FreeLibrary( hLib )
    IF ptNetInfo THEN CALL HeapFree( GetProcessHeap(), 0, BYVAL ptNetInfo )
 
END FUNCTION
 
FUNCTION GetSystemDns( BYREF szDns AS ASCIIZ ) AS LONG
    'returns True on success, False on failure
    'if successful the DNS server is placed in szDns
    LOCAL lKeyAddr AS LONG
    LOCAL lSize AS LONG
    LOCAL lType AS LONG
    LOCAL szTmp AS ASCIIZ * 256
 
    IF GetDnsFromIpHlpApi( szDns ) THEN
        FUNCTION = %TRUE
        EXIT FUNCTION
    END IF
 
    IF RegOpenKeyEx( %HKEY_LOCAL_MACHINE, _
                    "SYSTEM\CurrentControlSet\Services\TcpIp\Parameters", _
                    0, _
                    %KEY_READ, lKeyAddr _
                   ) <> %ERROR_SUCCESS THEN
        FUNCTION = %FALSE
    ELSE
        lSize = SIZEOF(szTmp)
        IF RegQueryValueEx( lKeyAddr, "DhcpNameServer", BYVAL %NULL, _
                                lType, szTmp, lSize ) = %ERROR_SUCCESS THEN
            IF lSize > 1 THEN
                szDns = LEFT$(szTmp, lSize-1 )
                CALL RegCloseKey( lKeyAddr )
                FUNCTION = %TRUE
                EXIT FUNCTION
            ELSE
                FUNCTION = %FALSE
            END IF
        ELSE
            FUNCTION = %FALSE
        END IF
    END IF
 
    CALL RegCloseKey( lKeyAddr )
  
    IF RegOpenKeyEx( %HKEY_LOCAL_MACHINE, _
                    "SYSTEM\CurrentControlSet\Services\TcpIp\Parameters", _
                    0, _
                    %KEY_READ, lKeyAddr _
                   ) <> %ERROR_SUCCESS THEN
        FUNCTION = %FALSE
    ELSE
        lSize = SIZEOF(szTmp)
        IF RegQueryValueEx( lKeyAddr, "NameServer", BYVAL %NULL, _
                                lType, szTmp, lSize ) = %ERROR_SUCCESS THEN
            IF lSize > 1 THEN
                szDns = LEFT$(szTmp, lSize-1 )
                CALL RegCloseKey( lKeyAddr )
                FUNCTION = %TRUE
                EXIT FUNCTION
            ELSE
                FUNCTION = %FALSE
            END IF
        ELSE
            FUNCTION = %FALSE
        END IF
    END IF
 
    CALL RegCloseKey( lKeyAddr )
 
    IF RegOpenKeyEx( %HKEY_LOCAL_MACHINE, _
                    "SYSTEM\CurrentControlSet\Services\TcpIp\Parameters\Transient", _
                    0, _
                    %KEY_READ, lKeyAddr _
                   ) <> %ERROR_SUCCESS THEN
        FUNCTION = %FALSE
    ELSE
        lSize = SIZEOF(szTmp)
        IF RegQueryValueEx( lKeyAddr, "NameServer", BYVAL %NULL, _
                                lType, szTmp, lSize ) = %ERROR_SUCCESS THEN
            IF lSize > 1 THEN
                szDns = LEFT$(szTmp, lSize-1 )
                CALL RegCloseKey( lKeyAddr )
                FUNCTION = %TRUE
                EXIT FUNCTION
            ELSE
                FUNCTION = %FALSE
            END IF
        ELSE
            FUNCTION = %FALSE
        END IF
    END IF
 
    CALL RegCloseKey( lKeyAddr )
 
    IF RegOpenKeyEx( %HKEY_LOCAL_MACHINE, _
                    "System\CurrentControlSet\Services\VxD\MSTCP", _
                    0, _
                    %KEY_READ, lKeyAddr _
                   ) <> %ERROR_SUCCESS THEN
        FUNCTION = %FALSE
    ELSE
        lSize = SIZEOF(szTmp)
        IF RegQueryValueEx( lKeyAddr, "NameServer", BYVAL %NULL, _
                                lType, szTmp, lSize ) = %ERROR_SUCCESS THEN
            IF lSize > 1 THEN
                szDns = LEFT$(szTmp, lSize-1 )
                CALL RegCloseKey( lKeyAddr )
                FUNCTION = %TRUE
                EXIT FUNCTION
            ELSE
                FUNCTION = %FALSE
            END IF
        ELSE
            FUNCTION = %FALSE
        END IF
    END IF
 
    CALL RegCloseKey( lKeyAddr )
 
END FUNCTION
 
FUNCTION ParseFixedHeaders( BYREF sRawQuery AS STRING, BYREF t AS DNS_HEADER, q AS QR_REC ) AS LONG
    'Returns Offset to record headers on success - or one of the %ERROR_USER messages
    LOCAL lCounter AS LONG
    LOCAL uParse AS U_PARSE_PTR 'Union used for parsing
 
    uParse.bPtr = STRPTR(sRawQuery)
 
    'XXX- Header section
    CALL MoveMemory( BYVAL VARPTR(t), BYVAL uParse.dwPtr, SIZEOF(t) )
 
    'Check RCODE
    IF  ([email protected][3] AND  %DNS_RCODE_MASK) <> %ERROR_NOERROR THEN
        FUNCTION = ([email protected][3] AND  %DNS_RCODE_MASK) -10
        EXIT FUNCTION
    END IF
 
    'network to host short
    t.Wid = ntohs(t.Wid)
    t.wQCount = ntohs(t.wQCount)
    t.wARCount = ntohs(t.wARCount)
    t.wAACount = ntohs(t.wAACount)
    t.wAAARCount= ntohs(t.wAAARCount)
 
    uParse.bPtr = uParse.bPtr + SIZEOF(t)
 
    'XXX - Question Header
    'skip the name
    DO WHILE [email protected]
        INCR uParse.bPtr
        INCR lCounter
    LOOP
 
    CALL MoveMemory(BYVAL VARPTR(q), BYVAL uParse.dwPtr +1, SIZEOF(q))
    q.wQueryClass = ntohs(q.wQueryClass)
    q.wQueryType = ntohs(q.wQueryType)
    'End of fixed section
 
    FUNCTION = SIZEOF(t) + SIZEOF(q) + lCounter + 1
 
END FUNCTION
 
SUB DoRecordHeader(BYVAL pStart AS BYTE PTR, uParse AS U_PARSE_PTR, BYREF r AS DNS_RR_HEADER, BYVAL pTmp AS BYTE PTR)
    'Parse record header and position for record
    LOCAL pJmp AS BYTE PTR
 
    'Domain this record relates to
    pJmp = pStart + (ntohs([email protected]) AND &H3FFF) 'blank out first 2 bits
    'pointer is relative to start of buffer
    DO WHILE @pJmp
        IF @pJmp < 33 THEN
            @pTmp = 46
        ELSE
            @pTmp = @pJmp
        END IF
        ! inc pTmp
        ! inc pJmp
    LOOP
    IF NOT ((@pTmp[-1] > 47 AND @pTmp[-1] < 59) OR (@pTmp[-1] > 64 AND @pTmp[-1] < 90) _
            OR (@pTmp[-1] > 97 AND @pTmp[-1] < 123)) THEN
        @pTmp[-1] = 0
    END IF
 
    INCR uParse.wPtr
    r.wType = ntohs([email protected])
    INCR uParse.wPtr
    r.wClass = ntohs([email protected])
    INCR uParse.wPtr
    r.dwTTL = ntohs([email protected])
    INCR uParse.dwPtr
    r.wLength = ntohs([email protected])
    INCR uParse.wPtr
 
END SUB
 
SUB DoRecord( BYVAL pStart AS BYTE PTR, uParse AS U_PARSE_PTR, BYVAL pTmp AS BYTE PTR, BYVAL lLength AS LONG )
    'parse a record and position uParse for next
    LOCAL i AS LONG
    LOCAL pJmp AS BYTE PTR
 
    FOR i = 0 TO lLength
        IF [email protected] = 192 THEN 'pointer
            'pointer is relative to start of buffer
            pJmp = pStart + (ntohs([email protected]) AND &H3FFF)
            uParse.bPtr = uParse.bPtr +3
            DO WHILE @pJmp
                IF @pJmp < 33 THEN
                    @pTmp = 46
                ELSE
                    IF @pJmp = 192 THEN 'a pointer jump within a pointer
                        pJmp = pStart +(((@pJmp[0] * 256) + @pJmp[1]) AND &H3FFF)
                        ITERATE
                    END IF
                    @pTmp = @pJmp
                END IF
                INCR pJmp
                INCR pTmp
            LOOP
 
        ELSE
            IF [email protected] < 33 THEN
                @pTmp = 46
            ELSE
                @pTmp = [email protected]
            END IF
            INCR uParse.bPtr
            INCR pTmp
        END IF
 
    NEXT
 
    IF NOT ((@pTmp[-1] > 47 AND @pTmp[-1] < 59) OR (@pTmp[-1] > 64 AND @pTmp[-1] < 90) _
            OR (@pTmp[-1] > 97 AND @pTmp[-1] < 123)) THEN
        @pTmp[-1] = 0
    END IF
 
END SUB
 
FUNCTION GetDnsMxRecords( BYREF sRawQuery AS STRING, BYVAL lIsWinsockInitialised AS LONG, BYREF tMxArray() AS MX_RECORD, BYREF tNSArray() AS NS_RECORD ) AS LONG
    'returns %ERROR_USER_NOERROR on success with tMxArray(), tNSArray() being filled or
    'one of %ERROR_USER_* codes on error
    '
    LOCAL lReplyOffset AS LONG
    LOCAL t AS DNS_HEADER   'Header record
    LOCAL q AS QR_REC       'Question record
 
    IF LEN(sRawQuery) = 0 THEN
        IF ISFALSE( lIsWinsockInitialised ) THEN 'call WSACleanUp if we did WSAStartup
            CALL WSACleanUp()
        END IF
 
        FUNCTION = %ERROR_USER_NOQUERY
        EXIT FUNCTION
    END IF
 
    lReplyOffset = ParseFixedHeaders( sRawQuery, t, q )
    IF lReplyOffset > 0 THEN
        LOCAL i AS LONG
        LOCAL lIncr AS LONG
        LOCAL lRecordCount AS LONG
        LOCAL pStart AS BYTE PTR'Start of buffer
        LOCAL pTmp AS BYTE PTR
        LOCAL pEom AS BYTE PTR  'End of buffer
        LOCAL pJmp AS BYTE PTR  'Jump pointer (used in offsets)
        LOCAL r AS DNS_RR_HEADER'Reply record
        LOCAL uParse AS U_PARSE_PTR 'Union used for parsing
        LOCAL pHost AS hostentstru PTR
        LOCAL paddr AS ASCIIZ PTR
 
        uParse.bPtr = STRPTR(sRawQuery) + lReplyOffset
        pStart = STRPTR(sRawQuery)
 
        'DIMension the arrays
        REDIM tMxArray(0:t.wARCount -1)
        REDIM tNsArray(0:t.wAACount -1)
          
        'Check answer records
        FOR lRecordCount = 0 TO t.wARCount -1'parse all answers
 
            pTmp = VARPTR(tMxArray(lRecordCount).szDomain)
            'XXX - Record Header
            CALL DoRecordHeader( pStart, uParse, r, pTmp )
 
            'MX record
            IF q.wQueryType = %QUERY_MX AND r.wType = %QUERY_MX THEN
 
                tMxArray(lRecordCount).wPreference = ntohs([email protected])
                INCR uParse.wPtr
                pTmp = VARPTR(tMxArray(lRecordCount).szName)
                pEom = uParse.bPtr + r.wLength -2
 
                CALL DoRecord( pStart, uParse, pTmp, r.wLength -3 )
 
                tMxArray(lRecordCount).szName = TRIM$(tMxArray(lRecordCount).szName, ".")
                tMxArray(lRecordCount).szDomain = TRIM$(tMxArray(lRecordCount).szDomain, ".")
                pHost = gethostbyname(tMxArray(lRecordCount).szName)
                IF pHost THEN
                   pAddr = inet_ntoa(@[email protected]@h_List)
                   IF pAddr THEN
                       tMxArray(lRecordCount).szIp = @pAddr
                   END IF
                END IF
                uParse.bPtr = pEom
 
            ELSE
                uParse.bPtr = uParse.bPtr + r.wLength
            END IF
        NEXT
 
        'Check authority records
        FOR lRecordCount = 0 TO t.wAACount -1'parse all answers
 
            pTmp = VARPTR(tNSArray(lRecordCount).szDomain)
            CALL DoRecordHeader( pStart, uParse, r, pTmp )
 
            'NS (Authoritative Name Server) record
            IF r.wType = %QUERY_NS THEN
 
                pEom = uParse.bPtr + r.wLength
                pTmp = VARPTR(tNSArray(lRecordCount).szName)
 
                CALL DoRecord( pStart, uParse, pTmp, r.wLength -1 )
 
                tNSArray(lRecordCount).szName = TRIM$(tNSArray(lRecordCount).szName, ".")
                tNSArray(lRecordCount).szDomain = TRIM$(tNSArray(lRecordCount).szDomain, ".")
 
                uParse.bPtr = pEom
 
            ELSE
                uParse.bPtr = uParse.bPtr + r.wLength
            END IF
        NEXT
 
        FUNCTION = %ERROR_USER_NOERROR
    ELSE
        'propagate the error back to the user
        FUNCTION = lReplyOffset
 
    END IF
 
    IF ISFALSE( lIsWinsockInitialised ) THEN
        'we started winsock - clean up
        CALL WSACleanUp()
    END IF
 
END FUNCTION
 
FUNCTION SetDNSQuery( BYREF tDns AS T_QUERY, BYREF sDomain AS STRING, BYVAL wQueryType AS WORD, BYVAL wQueryClass AS WORD ) AS STRING
    'returns a formatted DNS query string
    LOCAL lPos AS LONG
    LOCAL i AS LONG
    LOCAL lCount AS LONG
    LOCAL pByte AS BYTE PTR
    LOCAL s AS STRING
 
    RANDOMIZE
    tDns.tHeader.wId = RND(1, 65535) 'make an ID for this query
    'prepend a . to domain name (replaced by count in bytes)
    IF LEFT$(sDomain, 1) <> "." THEN sDomain = "." + sDomain
 
    lPos = LEN(sDomain)
    pByte = STRPTR(sDomain) + lPos
    FOR i = lPos TO 0 STEP -1
        IF @pByte = 46 THEN '. transform it to a byte count
            @pByte = lCount-1
            lCount = 0
        END IF
        DECR pbyte
        INCR lCount
    NEXT
 
    tDns.tQrRec.wQueryType = htons(wQueryType)
    tDns.tQrRec.wQueryClass = htons(wQueryClass)
    tDns.tHeader.wId = htons(tDns.tHeader.wId)    'Query ID
    tDns.tHeader.wBitFields = htons(%DNS_RFLAG)   'Recursive flag
    tDns.tHeader.wQCount = htons(1)               '1 query at a time - more is *theoretically* possible however
                                                  'I haven't tested it....
    tDns.tHeader.wARCount = 0
    tDns.tHeader.wAACount = 0
    tDns.tHeader.wAAARCount = 0
 
    s = PEEK$(VARPTR(tDns), 12) + sDomain + CHR$(0) + PEEK$(VARPTR(tdns)+12, 4) + CHR$(0)
 
    FUNCTION = s
 
END FUNCTION
  
FUNCTION GetRawDnsQuery( BYREF tDns AS T_QUERY, BYVAL lIsWinsockInitialised AS LONG, BYREF sQuery AS STRING, BYREF szUseDns AS ASCIIZ ) AS STRING
    'returns a RAW answer from the DNS server if successful or a 0 string on failure
    LOCAL sock_sa AS sockaddr_in
    LOCAL lSock AS LONG
 
    IF ISFALSE(lIsWinsockInitialised) THEN
        LOCAL tWsaData AS WSADATA
 
        IF WSAStartUp( MAKLNG(2, 0), tWsaData ) THEN 'Could not initialise Winsock
            FUNCTION = ""
            EXIT FUNCTION
        END IF
 
    END IF
 
    'If we were passed a DNS server ip then use that otherwise:
    'connect to nearest DNS server       [img]http://www.powerbasic.com/support/forums/smile.gif[/img]- there's no standard way to do this
    'we look in the registry to see if we find a DNS server...
    'This works under NT 4.0 NOT TESTED on Win 9.x, ME, W2k - I would appreciate
    'feedback on whether this works on other Windows versions!
 
    'We 1st look under %HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\TcpIp\Parameters
    'if not we look at %HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\TcpIp\Parameters\Transient
    '+ others for dynamic DHCP and Win9.x to see if we get the NameServer entry...
    LOCAL x AS LONG, y AS LONG
    LOCAL szDns AS ASCIIZ * 256
    LOCAL sBuf AS STRING
    LOCAL szDnsArr() AS ASCIIZ * 256
 
    'If we were passed a DNS server ip then use that otherwise attempt to get the dns from the registry
    IF LEN(szUseDns) = 0 THEN
        IF GetSystemDns( szDns ) THEN
            'Save each DNS server
            y = PARSECOUNT(szDns, " ")
            REDIM szDnsArr(0:y-1)
 
            FOR x = 1 TO y
                szDnsArr(x-1) = PARSE$(szDns, " ", x)
            NEXT
 
        ELSE
            IF ISFALSE(lIsWinsockInitialised) THEN
                'we initiated Winsock - clean up
 
                CALL WSACleanUp()
            END IF
            CALL Tell( "Error: Could not find DNS server" )
            CALL Tell( "specify /d<DNS_Server_Address> ON the command line" )
            EXIT FUNCTION
        END IF
    ELSE
        'we were passed a DNS server from the command line
        REDIM szDnsArr(0:0)
        szDnsArr(0) = szUseDns
    END IF
 
    LOCAL lNonBlock AS LONG
    LOCAL lLast AS LONG
    LOCAL lTimeStart AS LONG, lTimeEnd AS LONG
 
    'Retry strategy if send fails - try secondary DNSes - if that fails
    'then bail out
    FOR x = 0 TO UBOUND(szDnsArr(),1)
 
        lSock = DoConnect( szDnsArr(x), 53, sock_sa )
        IF lSock <> %INVALID_SOCKET THEN
            'Send query
 
            lNonBlock = 1 'Set to non-blocking: better in this case since other ppl might use
            'it in their code.... Ordinarily though you'll want to use blocking calls or
            'asynchronous (or even better overlapped) - for this situation though this is fine...
            CALL ioctlsocket( lSock, %FIONBIO, lNonBlock)
            'use sendto instead of send with UDP datagrams
            y = sendto( lSock, BYVAL STRPTR(sQuery), LEN(sQuery), 0, sock_sa, SIZEOF(sock_sa) )
 
            IF y > 0 THEN
                'okay let's receive the answer
 
                y = 0
                'allow 5 seconds to return query
                lTimeStart = GetTickCount() + 5000
                sBuf = STRING$(%PACKETSZ, 0)
 
                DO
                    'use recvfrom instead of recv with UDP datagrams
                    y = recvfrom( lSock, BYVAL STRPTR(sBuf), LEN(sBuf), 0, sock_sa, SIZEOF(sock_sa) )
                    lLast = WSAGetLastError()
                    lTimeEnd = GetTickCount()
                    SLEEP 10
 
                'which ever comes 1st
                LOOP UNTIL ((lLast <> %WSAEWOULDBLOCK) OR (y > 0) OR (lTimeEnd > lTimeStart))
 
                IF y > 0 THEN
                    'on success leave FOR
                    EXIT FOR
                ELSE
                    CALL closesocket(lSock)
                    lSock = %INVALID_SOCKET
                END IF
 
            END IF 'y > 0
 
        END IF 'lSock <> %INVALID_SOCKET
 
    NEXT
 
    IF lSock <> %INVALID_SOCKET THEN
        CALL closesocket( lSock )
    END IF
 
    FUNCTION = LEFT$(sBuf, y)
 
END FUNCTION
 
SUB Tell( sMessage AS STRING )
 
    #IF %DEF(%PB_CC32)
    STDOUT sMessage
    #ELSEIF %DEF(%PB_DLL32)
    MSGBOX sMessage
    #ENDIF
 
END SUB
 
SUB Usage()
 
    CALL Tell("Usage: dnsqry.exe domain_or_mail address /t Record Type [/d DNS Server ] [> filename]")
 
END SUB
 
FUNCTION PBMAIN() AS LONG
    LOCAL i AS LONG
    LOCAL lError AS LONG
    LOCAL lQueryType AS LONG
    LOCAL tDns AS T_QUERY
    DIM tMx(0:0) AS MX_RECORD
    DIM tNs(0:0) AS NS_RECORD
    LOCAL szDns AS ASCIIZ * 256
    LOCAL s AS STRING
    LOCAL sCheck AS STRING
    LOCAL sType AS STRING
    LOCAL sCommand AS STRING
    LOCAL sCmdLine AS STRING
    DIM sErrorDesc(0:10) AS STRING
    LOCAL lPos AS LONG
 
    'Fill up our error descriptions (in case we get some)
    sErrorDesc( 0) = "No Data"
    sErrorDesc( 1) = "Format Error"
    sErrorDesc( 2) = "Server Failure"
    sErrorDesc( 3) = "Non-Existent Domain"
    sErrorDesc( 4) = "Not Implemented"
    sErrorDesc( 5) = "Query Refused"
    sErrorDesc( 6) = "Name Exists when it should not"
    sErrorDesc( 7) = "RR Set Exists when it should not"
    sErrorDesc( 8) = "RR Set that should exists does not"
    sErrorDesc( 9) = "Server Not Authoritative for Zone"
    sErrorDesc(10) = "Query length passed is zero or not a query"
 
    #IF %DEF(%PB_CC32)
    PRINT "dnsqry.exe: Query DNS MX records"
    PRINT
    #ENDIF
 
    sCmdLine = COMMAND$
    sCheck = TRIM$(EXTRACT$( sCmdLine,  "/" ))
 
    FOR i = 1 TO PARSECOUNT(sCmdLine,  "/") -1
        sCommand = TRIM$(PARSE$(sCmdLine, "/", i+1))
        IF LCASE$(LEFT$(sCommand,1)) = "d" THEN 'DNS from command line
            szDns = TRIM$(RIGHT$(sCommand, LEN(sCommand)-1))
        ELSEIF LCASE$(LEFT$(sCommand,1)) = "t" THEN 'Type of record (only MX is implemented right now)
            sType = TRIM$(RIGHT$(sCommand, LEN(sCommand)-1))
        ELSE
            CALL Usage()
            EXIT FUNCTION
        END IF
    NEXT
 
    IF LEN(sType) = 0 THEN
        CALL Usage()
        EXIT FUNCTION
    END IF
 
    SELECT CASE LCASE$(sType)
        CASE "mx"
            lQueryType = %QUERY_MX
        CASE ELSE
            CALL Tell( "Not implemented yet" )
            EXIT FUNCTION
    END SELECT
 
    'don't forget to extract the domain name before making the query (if an email address is passed)
    lPos = INSTR( sCheck, "@" )
    IF lPos THEN
        sCheck = TRIM$( MID$( sCheck, lPos+1 ) )
    END IF
 
    s = GetRawDnsQuery( tDns, 0, SetDnsQuery( tDns, sCheck, lQueryType, %CLASS_IN ), szDns )
    lError = GetDnsMxRecords( s, 0, tMx(), tNs() )
    IF lError = %ERROR_USER_NOERROR THEN
 
        ARRAY SORT tMx()
        CALL Tell( "MX (Mail Exchange) Records" )
        FOR i = LBOUND(tMx(),1) TO UBOUND(tMx(),1)
            CALL Tell( tMx(i).szDomain + " " + FORMAT$(tMx(i).wPreference) + " IN MX " _
                        + tMx(i).szName + " [" + tMx(i).szIp + "]" )
 
        NEXT
 
        CALL Tell(CHR$(13,10) + "NS (Nameserver) Records" )
        FOR i = LBOUND(tNs(),1) TO UBOUND(tNs(),1)
            CALL Tell( tNs(i).szDomain + " IN NS " + tNs(i).szName )
 
        NEXT
 
    ELSE
        CALL Tell( sErrorDesc(lError+10) )
    END IF
 
END FUNCTION

[This message has been edited by Florent Heyworth (edited June 20, 2002).]

[Florent Heyworth]

Update 18-Mar-2001: See Last Edit in source code for details

------------------

[Joe Byrne]

Florent,
Nice code! I tested it on W2k Professional and it failed trying to get
the DNS server entry in the registry. This PC uses DHCP if that helps any.
It did work fine on my NT4 server (SP6) with static entries. Perhaps you
add an option to pass it the IP address of a DNS server? I often want to
check for MX records but I may want an outside DNS server to make sure the
data has propagated across the Internet and is not just reflecting the
entry in my DNS server. Also, does your function get the IP address for the
MX host anywhere? Its nice to know what mail preference the MX records are
but I think its more useful to know where the email server (IP address) is.

--Joe

------------------

[Florent Heyworth]

Hi Joe

thanks for the feedback Do those registry keys exist under
Win2k? (I'm thinking it *might* be an authorization thing in which
case I would just need to write code to authorize viewing these
keys). The code is meant as startup code to intregrate in your own
routines however your point is well taken:

I'll add a command line processing option which will override
the DNS registry lookup code as well as implementing A and CNAME
record queries which will let you 'dig' into the Ip address for a
given domain.

Cheers

Florent



[This message has been edited by Florent Heyworth (edited March 20, 2001).]

[Joe Byrne]

Florent,
I'm not real strong in the Windows Registry, but looking through the keys,
I found my TCP/IP setting (via DHCP) here:

HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\{54489601-7F8D-472F-A5DD-F6927433C163}

With an entry of: DhcpNameServer Reg_sz 192.186.1.10 (the ip of the DNS server)

This situation might be different only because I am using dynamic addressing.
I found your code to be a great starting point. I don't have the time right
now to customize it for my use, which is why I asked if you were "taking suggestions" as it
were

Thanks again. This is a real help.
--Joe


------------------

[Florent Heyworth]

Update 22-Mar-2001: implemented Joe Byrne's suggestions, see
source code for details

------------------

[Michael Burns]

the post i originally placed here is now over at http://www.powerbasic.com/support/pb...ead.php?t=3741

[this message has been edited by michael burns (edited may 15, 2001).]

[Florent Heyworth]

Updated 20-Jun-2002: a few tweaks for compatibility with
PBCC 2.x - 3 and PBDLL 6.x - PBWIN 7.

Cheers

Florent

------------------

[Walter Schütz]

Hi

I tested the above 'GetDnsFromIpHlpApi' and found that it missed one DNS-server. If you exchange the following parts it will run as expected! I just commented the erroneous lines and inserted corrected code to allow to reenact my changes.

TYPE IP_ADDR_STRING
'  lNext     AS LONG                          'this will not change functionality, but looks more clear ...
  lNext     AS IP_ADDR_STRING POINTER
  IpAddress AS IP_ADDRESS_STRING
  IpMask    AS IP_MASK_STRING
  Context   AS LONG
END TYPE

TYPE FIXED_INFO
  HostName(%MAX_HOSTNAME_LEN + 4 - 1)      AS BYTE
  DomainName(%MAX_DOMAIN_NAME_LEN + 4 - 1) AS BYTE
  CurrentDnsServer                         AS LONG
  'DnsServerList                            AS IP_ADDR_STRING PTR
  DnsServerList                            AS IP_ADDR_STRING
  NodeType                                 AS LONG
  ScopeId(%MAX_SCOPE_ID_LEN + 4 - 1)       AS BYTE
  EnableRouting                            AS LONG
  EnableProxy                              AS LONG
  EnableDns                                AS LONG
END TYPE

And in FUNCTION GetDnsFromIpHlpApi:

  ...
'  ptIpAddr = @ptNetInfo.DnsServerList.lNext
  ptIpAddr = VARPTR(@ptNetInfo.DnsServerList)
  WHILE ptIpAddr
    msgbox TRIM$(@ptIpAddr.IpAddress, CHR$(0)) + " "
    szDns = szDns + TRIM$(@ptIpAddr.IpAddress, CHR$(0)) + " "
    ptIpAddr = @ptIpAddr.lNext
  LOOP
  ...

------------------
TERRA Datentechnik

[This message has been edited by Walter Schütz (edited July 27, 2006).]