Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Query DNS for MX (Mail Exchange) records

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Query DNS for MX (Mail Exchange) records

    [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.

    Code:
    #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       
    * ' 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       - 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).]

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

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

    Comment


    • #3
      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

      ------------------
      Software makes Hardware Happen

      Comment


      • #4
        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).]

        Comment


        • #5
          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


          ------------------
          Software makes Hardware Happen

          Comment


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

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

            Comment


            • #7
              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).]
              Michael Burns

              Comment


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

                Cheers

                Florent

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

                Comment


                • #9
                  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.


                  Code:
                  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
                  Code:
                  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:
                  Code:
                    ...
                  '  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).]

                  Comment

                  Working...
                  X