DNS lookup and reverse DNS lookup [Win2k and newer only]

[alokdube]

i think its easier to use the nslookup and findstring
most of the time the output stays the same across OS versions, you can always check the version etc if you want via PB

[DoubleDutch]

Anyone got this code to work on Win7 or Vista yet? Could be very useful...

[srod]

Works fine here on Vista if I compile with the Unicode switch.

[srod]

Curiously, it works fine in either Ascii or Unicode mode if I switch the p-Unicode pseudotype for a buffer and physcially poke a Unicode copy of the string etc.

Code: Select all

#DNS_TYPE_A          = $0001      ; //  1
#DNS_TYPE_NS         = $0002      ; //  2
#DNS_TYPE_MD         = $0003      ; //  3
#DNS_TYPE_MF         = $0004      ; //  4
#DNS_TYPE_CNAME      = $0005      ; //  5
#DNS_TYPE_SOA        = $0006      ; //  6
#DNS_TYPE_MB         = $0007      ; //  7
#DNS_TYPE_MG         = $0008      ; //  8
#DNS_TYPE_MR         = $0009      ; //  9
#DNS_TYPE_NULL       = $000a      ; //  10
#DNS_TYPE_WKS        = $000b      ; //  11
#DNS_TYPE_PTR        = $000c      ; //  12
#DNS_TYPE_HINFO      = $000d      ; //  13
#DNS_TYPE_MINFO      = $000e      ; //  14
#DNS_TYPE_MX         = $000f      ; //  15
#DNS_TYPE_TEXT       = $0010      ; //  16

#DNS_QUERY_STANDARD                  = $00000000
#DNS_QUERY_ACCEPT_TRUNCATED_RESPONSE = $00000001
#DNS_QUERY_USE_TCP_ONLY              = $00000002
#DNS_QUERY_NO_RECURSION              = $00000004
#DNS_QUERY_BYPASS_CACHE              = $00000008

#DNS_QUERY_NO_WIRE_QUERY             = $00000010
#DNS_QUERY_NO_LOCAL_NAME             = $00000020
#DNS_QUERY_NO_HOSTS_FILE             = $00000040
#DNS_QUERY_NO_NETBT                  = $00000080

#DNS_QUERY_WIRE_ONLY                 = $00000100
#DNS_QUERY_RETURN_MESSAGE            = $00000200

#DNS_QUERY_TREAT_AS_FQDN             = $00001000
#DNS_QUERY_DONT_RESET_TTL_VALUES     = $00100000
#DNS_QUERY_RESERVED                  = $ff000000

Enumeration ; DNS_FREE_TYPE
  #DnsFreeFlat = 0
  #DnsFreeRecordList
  #DnsFreeParsedMessageFields
EndEnumeration 

Structure DNS_A_DATA
  IpAddress.l
EndStructure

Structure DNS_PTR_DATAA
  *pNameHost
EndStructure

Structure DNS_RECORD 
  *pNext.DNS_RECORD;  
  pName.s
  wType.w
  wDataLength.w
  StructureUnion
    DW.l 
    S.l
  EndStructureUnion
  dwTtl.l
  dwReserved.l
  
  ; Note: The Union def is incomplete. see DNS_RECORD in the psdk for more fields
  StructureUnion
    A.DNS_A_DATA 
    PTR.DNS_PTR_DATAA
    CNAME.DNS_PTR_DATAA
  EndStructureUnion 
EndStructure

Prototype DnsQuery_W(Name, wType.w, fOptions.l, *aopServers, *ppQueryResultSet, *pReserved)
Prototype DnsRecordListFree(*RecordList, FreeType)
Global DnsQuery_W.DnsQuery_W, DnsRecordListFree.DnsRecordListFree

; =========================================================

; Load the Dnsapi.dll. Use it just like OpenLibrary()
; Library is the #Library number for the new lib (can be #PB_Any)
;
Procedure LoadDnsApi(Library)
  Protected Result

  Result = OpenLibrary(Library, "Dnsapi.dll")
  If Result
    If Library = #PB_Any
      Library = Result
    EndIf
    
    DnsQuery_W        = GetFunction(Library, "DnsQuery_W")
    DnsRecordListFree = GetFunction(Library, "DnsRecordListFree")    
    
    If DnsQuery_W = 0 Or  DnsRecordListFree = 0
      CloseLibrary(Library)
      Result = 0
    EndIf      
  EndIf

  ProcedureReturn Result
EndProcedure

; Get the IP for the server name
; returns 0 on failure
;
Procedure.l DnsQuery(ServerName$)
  Protected IP = 0, CName$, *Record.DNS_RECORD, UnicodeBuffer
  
  If DnsQuery_W And DnsRecordListFree
    UnicodeBuffer = AllocateMemory(Len(ServerName$) * 2 + 2)
    If UnicodeBuffer
      PokeS(UnicodeBuffer, ServerName$, -1, #PB_Unicode)
      If DnsQuery_W(UnicodeBuffer, #DNS_TYPE_A, #DNS_QUERY_STANDARD, #Null, @*Record.DNS_RECORD, #Null) = 0 And *Record
        If *Record\wType = #DNS_TYPE_A ; dns record
          IP = *Record\A\IpAddress
        ElseIf *Record\wType = #DNS_TYPE_CNAME ; redirection
          CName$ = PeekS(*Record\CNAME\pNameHost, -1, #PB_Unicode)
          If CName$
            IP = DnsQuery(CName$)
          EndIf
        EndIf 
        DnsRecordListFree(*Record, #DnsFreeRecordList)
      EndIf
      FreeMemory(UnicodeBuffer)
    
    EndIf
  EndIf
  
  ProcedureReturn IP
EndProcedure

; Get the name for the given IP
; returns "" on failure
;
; =========================================================
; Example
;

If LoadDnsApi(0)

  ip = DnsQuery("www.google.com")
  If ip
    Debug "IP lookup: " + IPString(ip)
    
  Else
    Debug "IP lookup failed."
  EndIf
    
  CloseLibrary(0)
Else
  Debug "loading failed"
EndIf

[netmaestro]

I think this is a safer way of making a version which is unicode- or ascii-safe. Basically, all references to DnsQuery_W are replaced with DnsQuery_ , string references changed to generic and this small modification is made:

Code: Select all

    CompilerIf #PB_Compiler_Unicode
      DnsQuery_ = GetFunction(Library, "DnsQuery_W")
    CompilerElse
       DnsQuery_ = GetFunction(Library, "DnsQuery_A")
    CompilerEndIf

Works well here in either mode using Windows 7. Here's the full modified code:

Code: Select all

#DNS_TYPE_A          = $0001      ; //  1
#DNS_TYPE_NS         = $0002      ; //  2
#DNS_TYPE_MD         = $0003      ; //  3
#DNS_TYPE_MF         = $0004      ; //  4
#DNS_TYPE_CNAME      = $0005      ; //  5
#DNS_TYPE_SOA        = $0006      ; //  6
#DNS_TYPE_MB         = $0007      ; //  7
#DNS_TYPE_MG         = $0008      ; //  8
#DNS_TYPE_MR         = $0009      ; //  9
#DNS_TYPE_NULL       = $000a      ; //  10
#DNS_TYPE_WKS        = $000b      ; //  11
#DNS_TYPE_PTR        = $000c      ; //  12
#DNS_TYPE_HINFO      = $000d      ; //  13
#DNS_TYPE_MINFO      = $000e      ; //  14
#DNS_TYPE_MX         = $000f      ; //  15
#DNS_TYPE_TEXT       = $0010      ; //  16

#DNS_QUERY_STANDARD                  = $00000000
#DNS_QUERY_ACCEPT_TRUNCATED_RESPONSE = $00000001
#DNS_QUERY_USE_TCP_ONLY              = $00000002
#DNS_QUERY_NO_RECURSION              = $00000004
#DNS_QUERY_BYPASS_CACHE              = $00000008

#DNS_QUERY_NO_WIRE_QUERY             = $00000010
#DNS_QUERY_NO_LOCAL_NAME             = $00000020
#DNS_QUERY_NO_HOSTS_FILE             = $00000040
#DNS_QUERY_NO_NETBT                  = $00000080

#DNS_QUERY_WIRE_ONLY                 = $00000100
#DNS_QUERY_RETURN_MESSAGE            = $00000200

#DNS_QUERY_TREAT_AS_FQDN             = $00001000
#DNS_QUERY_DONT_RESET_TTL_VALUES     = $00100000
#DNS_QUERY_RESERVED                  = $ff000000

Enumeration ; DNS_FREE_TYPE
  #DnsFreeFlat = 0
  #DnsFreeRecordList
  #DnsFreeParsedMessageFields
EndEnumeration 

Structure DNS_A_DATA
  IpAddress.l
EndStructure

Structure DNS_PTR_DATAA
  *pNameHost
EndStructure

Structure DNS_RECORD 
  *pNext.DNS_RECORD;  
  pName.s
  wType.w
  wDataLength.w
  StructureUnion
    DW.l 
    S.l
  EndStructureUnion
  dwTtl.l
  dwReserved.l
  
  ; Note: The Union def is incomplete. see DNS_RECORD in the psdk for more fields
  StructureUnion
    A.DNS_A_DATA 
    PTR.DNS_PTR_DATAA
    CNAME.DNS_PTR_DATAA
  EndStructureUnion 
EndStructure

Prototype DnsQuery_(Name.s, wType.w, fOptions.l, *aopServers, *ppQueryResultSet, *pReserved)
Prototype DnsRecordListFree(*RecordList, FreeType)
Global DnsQuery_.DnsQuery_, DnsRecordListFree.DnsRecordListFree

; =========================================================

; Load the Dnsapi.dll. Use it just like OpenLibrary()
; Library is the #Library number for the new lib (can be #PB_Any)
;
Procedure LoadDnsApi(Library)
  Protected Result

  Result = OpenLibrary(Library, "Dnsapi.dll")
  If Result
    If Library = #PB_Any
      Library = Result
    EndIf
    
    CompilerIf #PB_Compiler_Unicode
      DnsQuery_ = GetFunction(Library, "DnsQuery_W")
    CompilerElse
       DnsQuery_ = GetFunction(Library, "DnsQuery_A")
    CompilerEndIf
    
    DnsRecordListFree = GetFunction(Library, "DnsRecordListFree")    
    
    If DnsQuery_ = 0 Or  DnsRecordListFree = 0
      CloseLibrary(Library)
      Result = 0
    EndIf      
  EndIf

  ProcedureReturn Result
EndProcedure

; Get the IP for the server name
; returns 0 on failure
;
Procedure.l DnsQuery(ServerName$)
  Protected IP = 0, CName$, *Record.DNS_RECORD
  
  If DnsQuery_ And DnsRecordListFree
    If DnsQuery_(ServerName$, #DNS_TYPE_A, #DNS_QUERY_STANDARD, #Null, @*Record.DNS_RECORD, #Null) = 0 And *Record
      If *Record\wType = #DNS_TYPE_A ; dns record
        IP = *Record\A\IpAddress
      ElseIf *Record\wType = #DNS_TYPE_CNAME ; redirection
        CName$ = PeekS(*Record\CNAME\pNameHost)
        If CName$
          IP = DnsQuery(CName$)
        EndIf
      EndIf 
      DnsRecordListFree(*Record, #DnsFreeRecordList)
    EndIf
  EndIf
  
  ProcedureReturn IP
EndProcedure

; Get the name for the given IP
; returns "" on failure
;
Procedure.s ReverseDnsQuery(IP.l)
  Protected Name$ = "", *Record.DNS_RECORD
  Protected Query$ = Str((IP>>24) & $FF)+"."+Str((IP>>16) & $FF)+"."+Str((IP>>8) & $FF)+"."+Str(IP & $FF)+".IN-ADDR.ARPA" ; ip must be reversed!
  
  If DnsQuery_ And DnsRecordListFree
    If DnsQuery_(Query$, #DNS_TYPE_PTR, #DNS_QUERY_STANDARD, #Null, @*Record.DNS_RECORD, #Null) = 0 And *Record
      If *Record\wType = #DNS_TYPE_PTR
        Name$ = PeekS(*Record\PTR\pNameHost)
      EndIf 
      DnsRecordListFree(*Record, #DnsFreeRecordList)
    EndIf
  EndIf
  
  ProcedureReturn Name$  
EndProcedure

; =========================================================
; Example
;

If LoadDnsApi(0)

  ip = DnsQuery("www.google.com")
  If ip
    Debug "IP lookup: " + IPString(ip)
    
    Name$ = ReverseDnsQuery(ip)
    If Name$
      Debug "Name lookup: " + Name$
    Else
      Debug "Reverse lookup failed."
    EndIf    
  Else
    Debug "IP lookup failed."
  EndIf
    
  CloseLibrary(0)
Else
  Debug "loading failed"
EndIf

[SFSxOI]

netmaestro, works fine here in either mode with Win 7. Thanks

[pdwyer]

Works fine here on Vista if I compile with the Unicode switch.

Thanks! (sorry, late to see this ) just bumped into it

I love bumping into a solved problem

[jassing]

I tried to modify the code, perhaps I didn't do it right.. But I have a need to test a specific dns server.
I modfied the code:

Code: Select all

; ...
Dim aServers.s(1)
aServers(0)="192.168.254.2"
  If DnsQuery_(ServerName$, nRecordType, #DNS_QUERY_STANDARD, @aServers(0), @*Record.DNS_RECORD, #Null) = 0 And *Record
; ...

Here, there is no 192.168.254.2 system, it simply does not exist, and there is no corresponding entry in hosts file.

Is there a way I can specify a specific name server?


Note, reading the original code/prototype, I had originally tried to pass an array of pointers, but it resulted in an IMA:

Code: Select all

dim aServers(1)
aServers(0)=@"192.168.254.2"
  If DnsQuery_(ServerName$, nRecordType, #DNS_QUERY_STANDARD, @aServers(0), @*Record.DNS_RECORD, #Null) = 0 And *Record

but this worked, even tho it shouldn't have resolved the server IP to anything:

Code: Select all

Dim aServers(1)
aServers(0)=@"192.168.254.2"
  If DnsQuery_(ServerName$, nRecordType, #DNS_QUERY_STANDARD, aServers(0), @*Record.DNS_RECORD, #Null) = 0 And *Record

[jpd]

Hi jassing,

here a link to a sample that able to deal with the needed requirement.

best
jpd

[jassing]

here a link to a sample that able to deal with the needed requirement.

Thank you!
-j

[jpd]

Thank you!
-j

Your welcome.

[xakep]

Hi jassing,

here a link to a sample that able to deal with the needed requirement.

best
jpd

Maybe someone could upload this .zip, i also try to resolve domains using custom DNS and i can't succeed.

Sorry for bringing the life to this old topic.

LE:
VB6 working code:

Code: Select all

Dim pRecord     As Long
        ReDim laServers(1)
        laServers(0) = 1
        laServers(1) = inet_addr("8.8.8.8")
        
    If DnsQuery("google.de", DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, VarPtr(laServers(0)), pRecord, 0) = 0 Then

My PB not working code:

Code: Select all

   define DomainName.s
    DomainName = "google.de"
     *UnicodeBuffer = AllocateMemory(StringByteLength(DomainName) + SizeOf(Character))
     uBufferLen = PokeS(*UnicodeBuffer, DomainName, -1, #PB_Unicode)

      Dim aServers.l(1)
      aServers(0) = 1
      aServers(1) = inet_addr_("8.8.8.8")
        
        If Dnsapi_Query(*UnicodeBuffer, #DNS_TYPE_A, #DNS_QUERY_BYPASS_CACHE, @aServers(0), @*Record, #Null) = #ERROR_SUCCESS

This should work, but i get an don't send error.

LE2: Fount the problem:
inet_addr_ seems to not resolve the right address, due to unicode problems.
Will post working code latter.

[xakep]

There is unicode working code:

Code: Select all

EnableExplicit

#DNS_TYPE_A = $0001
#DNS_TYPE_CNAME = $0005

#DNS_QUERY_NO_HOSTS_FILE = $00000040
#DNS_QUERY_STANDARD = $00000000
#DNS_QUERY_BYPASS_CACHE = $00000008
#DnsFreeRecordList = 2

Structure DNS_A_DATA
  IpAddress.l
EndStructure

Structure DNS_PTR_DATAA
  *pNameHost
EndStructure

Structure DNS_RECORD
  *pNext.DNS_RECORD; 
  pName.s
  wType.w
  wDataLength.w
  StructureUnion
    DW.l
    S.l
  EndStructureUnion
  dwTtl.l
  dwReserved.l
 
  ; Note: The Union def is incomplete. see DNS_RECORD in the psdk for more fields
  StructureUnion
    A.DNS_A_DATA
    PTR.DNS_PTR_DATAA
    ;NS.DNS_PTR_DATAA
    CNAME.DNS_PTR_DATAA
  EndStructureUnion
EndStructure

;Ws2_32.dll
Global Ws2_32_DLL.l
Global inet_addr.l
Global inet_ntoa.l
Prototype W_inet(*Addr)
;Ws2_32.dll

;Dnsapi.dll
Global Dnsapi_DLL.l
Global DnsQuery.l
Global DnsRecordListFree.l
Prototype D_DnsQuery(*Name, wType.w, fOptions.l, aopServers.l, *ppQueryResultSet, *pReserved)
Prototype D_DnsRecordListFree(*RecordList, FreeType)
;Dnsapi.dll

Procedure ResolveFunc(lDll.l, lpProcName.s)
  Define ProfileLen, *ProfileNow, lRet.l
  
  If lDll
    ProfileLen = StringByteLength(lpProcName, #PB_Ascii)
    
    If ProfileLen > 2
      *ProfileNow = AllocateMemory(ProfileLen + SizeOf(Character))
      
      If *ProfileNow
        
        If PokeS(*ProfileNow, lpProcName, -1, #PB_Ascii) = ProfileLen
          lRet = GetProcAddress_(lDll, *ProfileNow)
        EndIf
      
        FreeMemory(*ProfileNow)
      EndIf
    EndIf
    
    ProfileLen = 0
    ProcedureReturn lRet
  EndIf
EndProcedure

Procedure.s Ws2_32_inet_ntoa(*Addr)
  Define Ws2.W_inet, lRet.l
  
  If inet_ntoa
    Ws2.W_inet = inet_ntoa
    lRet = Ws2(*Addr)
    
    If lRet
      ProcedureReturn PeekS(lRet, -1, #PB_Ascii)
    EndIf
    
  EndIf
EndProcedure

Procedure Ws2_32_inet_addr(sIP.s)
  Define Ws2.W_inet, lenIP.l, *IPNow, lRet.l
  
  If inet_addr
    Ws2.W_inet = inet_addr
    
    lenIP = StringByteLength(sIP, #PB_Ascii)
    
    If lenIP > 6
      *IPNow = AllocateMemory(lenIP + SizeOf(Character))
      
      If *IPNow
        
        If PokeS(*IPNow, sIP, -1, #PB_Ascii) = lenIP
          lRet = Ws2(*IPNow)
        EndIf
        
        FreeMemory(*IPNow)
      EndIf
    EndIf
    
    lenIP = 0
    ProcedureReturn lRet
  EndIf
  
EndProcedure

Procedure Ws2_32_Init()
  
  If Ws2_32_DLL = #False
    Ws2_32_DLL = LoadLibrary_("Ws2_32.dll")
  EndIf
  
  If Ws2_32_DLL <> #False
    
    If inet_addr = #False
      inet_addr = ResolveFunc(Ws2_32_DLL, "inet_addr")
    EndIf
    
    If inet_ntoa = #False
      inet_ntoa = ResolveFunc(Ws2_32_DLL, "inet_ntoa")
    EndIf
    
    If inet_addr <> #False And inet_ntoa <> #False
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
    
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure Ws2_32_End()
  If Ws2_32_DLL <> #False
    FreeLibrary_(Ws2_32_DLL)
  EndIf
  
  Ws2_32_DLL = 0 : inet_addr = 0 : inet_ntoa = 0
EndProcedure

Procedure Dnsapi_Init()
  
  If Dnsapi_DLL = #False
    Dnsapi_DLL = LoadLibrary_("Dnsapi.dll")
  EndIf
  
  If Dnsapi_DLL <> #False
    
    If DnsQuery = #False
      DnsQuery = ResolveFunc(Dnsapi_DLL, "DnsQuery_W")
    EndIf
    
    If DnsRecordListFree = #False
      DnsRecordListFree = ResolveFunc(Dnsapi_DLL, "DnsRecordListFree")
    EndIf
    
    If DnsQuery <> #False And DnsRecordListFree <> #False
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
    
  Else
    ProcedureReturn #False
  EndIf
  
EndProcedure

Procedure Dnsapi_End()
  
  If Dnsapi_DLL <> #False
    FreeLibrary_(Dnsapi_DLL)
  EndIf
  
  Dnsapi_DLL = 0 : DnsQuery = 0 : DnsRecordListFree = 0  
EndProcedure

Procedure Dnsapi_Query(*Name, wType.w, fOptions.l, aopServers.l, *ppQueryResultSet, *pReserved)
  Define DNS.D_DnsQuery
  
  If DnsQuery
    DNS.D_DnsQuery = DnsQuery
    
    ProcedureReturn DNS(*Name, wType, fOptions, aopServers, *ppQueryResultSet, *pReserved)
  EndIf
  
EndProcedure

Procedure Dnsapi_RecordListFree(*RecordList, FreeType)
  Define DNS.D_DnsRecordListFree
  
  If DnsRecordListFree
    DNS.D_DnsRecordListFree = DnsRecordListFree
    
    ProcedureReturn DNS(*RecordList, FreeType)
  EndIf
  
EndProcedure

Procedure.s DNS_Q(DomainName.s, DNS_Server.s)
  Define *UnicodeBuffer, uBufferLen.l, *Record.DNS_RECORD, CName.s, sIP.s, tIPAddress.l, lCall.l, lCall2.l
  
  If Ws2_32_DLL = #False
    If Ws2_32_Init() = #False
      ProcedureReturn
    EndIf
  EndIf
  
  If Dnsapi_DLL = #False
    If Dnsapi_Init() = #False
      ProcedureReturn
    EndIf
  EndIf
  
  *UnicodeBuffer = AllocateMemory(StringByteLength(DomainName, #PB_Unicode) + SizeOf(Character))
  
  If *UnicodeBuffer
    uBufferLen = PokeS(*UnicodeBuffer, DomainName, -1, #PB_Unicode)
    
    If uBufferLen > 2
      tIPAddress = Ws2_32_inet_addr(DNS_Server)
      
      If tIPAddress
        Dim aServers.l(1)
        aServers(0) = 1
        aServers(1) = tIPAddress
        lCall = Dnsapi_Query(*UnicodeBuffer, #DNS_TYPE_A, #DNS_QUERY_BYPASS_CACHE|#DNS_QUERY_NO_HOSTS_FILE, @aServers(0), @*Record, #Null)
      Else
        lCall = Dnsapi_Query(*UnicodeBuffer, #DNS_TYPE_A, #DNS_QUERY_NO_HOSTS_FILE, #Null, @*Record, #Null)
      EndIf
 
      If lCall = #ERROR_SUCCESS
        If *Record\wType = #DNS_TYPE_A ; dns record
          sIP = Ws2_32_inet_ntoa(*Record\A\IpAddress)
        ElseIf *Record\wType = #DNS_TYPE_CNAME ; redirection
          CName = PeekS(*Record\CNAME\pNameHost, -1, #PB_Unicode)
          If CName
            sIP = DNS_Q(CName, DNS_Server)
          EndIf
        EndIf
          
          Dnsapi_RecordListFree(*Record, #DnsFreeRecordList)
      EndIf
    EndIf
    FreeMemory(*UnicodeBuffer)
  EndIf
  
  Ws2_32_End()
  Dnsapi_End()
  CName = ""
  tIPAddress = 0 : lCall2 = 0 : uBufferLen = 0 : lCall = 0
  ProcedureReturn sIP
EndProcedure


Debug DNS_Q("purebasic.fr", "8.8.8.8")