Q

Home » Work » Loki’s Toolbox – The DNS Cross Validator

Loki’s Toolbox – The DNS Cross Validator

Enter your email address to follow this blog and receive notifications of new posts by email.

Join 43 other followers

I just posted this on SourceForge:

https://sourceforge.net/projects/qscrossdnslookup/?source=navbar

QSCrossValidator

Interested? Download it here.

DNSDL

CrossValidator

Visual Basic 6.0 Source Code:

The project configuration:

frmLookup

frmLookup.frm

Option Explicit

Private Sub cmdAddDNS_Click()
    lvDNS.ListItems.Add(, , txtWho.Text).SubItems(1) = txtDNSServer.Text
    txtWho.Text = ""
    txtDNSServer.Text = ""
    txtWho.SetFocus
End Sub

Private Sub cmdCheckHosts_Click()
    Dim oCol As New Collection
    Dim oDNS As ListItem
    Dim oHostName As ListItem
    For Each oHostName In lvHostnames.ListItems
        For Each oDNS In lvDNS.ListItems
            Dim oHL As New CHostLookup
            Dim sCmd As String
            Dim sReturn As String
            
            sCmd = Replace(Replace("nslookup %s2 %s1", "%s1", oDNS.SubItems(1)), "%s2", oHostName.Text)
            sReturn = GetCommandOutput(sCmd)
            DoEvents
            If (oHL.Create(sCmd, sReturn)) Then
                Dim bNeedAdd As Boolean
                
                On Error Resume Next
                If (oCol(LCase(oHL.UniqueKey)) Is Nothing) Then
                    bNeedAdd = True
                Else
                    bNeedAdd = False
                End If
                
                On Error GoTo 0
                If (bNeedAdd) Then
                    oCol.Add oHL, LCase(oHL.UniqueKey)
                    txtHosts.Text = txtHosts.Text & "Command: """ & sCmd & """" & vbCrLf & _
                        sReturn & vbCrLf & Replace(Space(30), " ", "-") & vbCrLf
                End If
            End If
        Next oDNS
    Next oHostName
    txtHosts.Text = txtHosts.Text & vbCrLf & "Done"
End Sub

Private Sub Form_Load()
    buildDNSList GetSetting("Loki's Toolbelt", App.Title, "DNSs")
    buildHostList GetSetting("Loki's Toolbelt", App.Title, "Hosts")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SaveSetting "Loki's Toolbelt", App.Title, "DNSs", getDNSS()
    SaveSetting "Loki's Toolbelt", App.Title, "Hosts", getHOSTS()
End Sub

Private Sub cmdAddHost_Click()
    lvHostnames.ListItems.Add , , txtHostName.Text: txtHostName.Text = ""
End Sub

Private Sub lvDNS_KeyDown(KeyCode As Integer, Shift As Integer)
    If (KeyCode = vbKeyDelete And Not lvDNS.SelectedItem Is Nothing) Then
        If (MsgBox("Are you sure you wish to delete this?", vbOKCancel, "Delete?") = vbOK) Then
            lvDNS.ListItems.Remove lvDNS.SelectedItem.Index
            If (lvDNS.ListItems.Count > 0) Then
                Set lvDNS.SelectedItem = lvDNS.ListItems(1)
            End If
            lvDNS.SetFocus
        End If
    ElseIf (KeyCode = vbKeyDelete) Then
        Beep
    End If
End Sub

Private Sub buildDNSList(ByVal sData As String)
    Dim nX As Integer
    Dim vData As Variant
    If (Len(sData) > 0) Then
        vData = Split(sData, "#")
        For nX = LBound(vData) To UBound(vData) - 1 Step 1
            Dim vCur As Variant
            vCur = Split(vData(nX), "|")
            lvDNS.ListItems.Add(, , vCur(0)).SubItems(1) = vCur(1)
        Next nX
    End If
End Sub

Private Sub buildHostList(ByVal sData As String)
    Dim nIndex As Integer
    Dim vCur As Variant
    If (Len(sData) > 0) Then
        vCur = Split(sData, "#")
        Dim nCur As Long
        For nCur = LBound(vCur) To UBound(vCur) - 1 Step 1
            lvHostnames.ListItems.Add , , vCur(nCur)
        Next nCur
    End If
End Sub

Private Function getDNSS() As String
    Dim sData As String
    Dim oLI As ListItem
    
    For Each oLI In lvDNS.ListItems
        sData = sData & oLI.Text & "|" & oLI.SubItems(1) & "#"
    Next oLI
    getDNSS = sData
End Function

Private Function getHOSTS() As String
    Dim sData As String
    Dim GHI As ListItem
    
    For Each GHI In lvHostnames.ListItems
        sData = sData & GHI.Text & "#"
    Next GHI
    getHOSTS = sData
End Function

cmdOutput.bas (Thank you, Joacim!)

Option Explicit
''''''''''''''''''''''''''''''''''''''''
' Joacim Andersson, Brixoft Software
' http://www.brixoft.net
''''''''''''''''''''''''''''''''''''''''

' STARTUPINFO flags
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100

' ShowWindow flags
Private Const SW_HIDE = 0

' DuplicateHandle flags
Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const DUPLICATE_SAME_ACCESS = &H2

' Error codes
Private Const ERROR_BROKEN_PIPE = 109

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Declare Function CreatePipe _
 Lib "kernel32" ( _
 phReadPipe As Long, _
 phWritePipe As Long, _
 lpPipeAttributes As Any, _
 ByVal nSize As Long) As Long

Private Declare Function ReadFile _
 Lib "kernel32" ( _
 ByVal hFile As Long, _
 lpBuffer As Any, _
 ByVal nNumberOfBytesToRead As Long, _
 lpNumberOfBytesRead As Long, _
 lpOverlapped As Any) As Long

Private Declare Function CreateProcess _
 Lib "kernel32" Alias "CreateProcessA" ( _
 ByVal lpApplicationName As String, _
 ByVal lpCommandLine As String, _
 lpProcessAttributes As Any, _
 lpThreadAttributes As Any, _
 ByVal bInheritHandles As Long, _
 ByVal dwCreationFlags As Long, _
 lpEnvironment As Any, _
 ByVal lpCurrentDriectory As String, _
 lpStartupInfo As STARTUPINFO, _
 lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function GetCurrentProcess _
 Lib "kernel32" () As Long

Private Declare Function DuplicateHandle _
 Lib "kernel32" ( _
 ByVal hSourceProcessHandle As Long, _
 ByVal hSourceHandle As Long, _
 ByVal hTargetProcessHandle As Long, _
 lpTargetHandle As Long, _
 ByVal dwDesiredAccess As Long, _
 ByVal bInheritHandle As Long, _
 ByVal dwOptions As Long) As Long

Private Declare Function CloseHandle _
 Lib "kernel32" ( _
 ByVal hObject As Long) As Long

Private Declare Function OemToCharBuff _
 Lib "user32" Alias "OemToCharBuffA" ( _
 lpszSrc As Any, _
 ByVal lpszDst As String, _
 ByVal cchDstLength As Long) As Long

' Function GetCommandOutput
'
' sCommandLine:  [in] Command line to launch
' blnStdOut        [in,opt] True (defualt) to capture output to STDOUT
' blnStdErr        [in,opt] True to capture output to STDERR. False is default.
' blnOEMConvert:   [in,opt] True (default) to convert DOS characters to Windows, False to skip conversion
'
' Returns:       String with STDOUT and/or STDERR output
'
Public Function GetCommandOutput( _
 sCommandLine As String, _
 Optional blnStdOut As Boolean = True, _
 Optional blnStdErr As Boolean = False, _
 Optional blnOEMConvert As Boolean = True _
) As String

    Dim hPipeRead As Long, hPipeWrite1 As Long, hPipeWrite2 As Long
    Dim hCurProcess As Long
    Dim sa As SECURITY_ATTRIBUTES
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION
    Dim baOutput() As Byte
    Dim sNewOutput As String
    Dim lBytesRead As Long
    Dim fTwoHandles As Boolean

    Dim lRet As Long

    Const BUFSIZE = 1024      ' pipe buffer size

    ' At least one of them should be True, otherwise there's no point in calling the function
    If (Not blnStdOut) And (Not blnStdErr) Then
        Err.Raise 5         ' Invalid Procedure call or Argument
    End If

    ' If both are true, we need two write handles. If not, one is enough.
    fTwoHandles = blnStdOut And blnStdErr

    ReDim baOutput(BUFSIZE - 1) As Byte

    With sa
        .nLength = Len(sa)
        .bInheritHandle = 1    ' get inheritable pipe handles
    End With

    If CreatePipe(hPipeRead, hPipeWrite1, sa, BUFSIZE) = 0 Then
        Exit Function
    End If

    hCurProcess = GetCurrentProcess()

    ' Replace our inheritable read handle with an non-inheritable. Not that it
    ' seems to be necessary in this case, but the docs say we should.
    Call DuplicateHandle(hCurProcess, hPipeRead, hCurProcess, hPipeRead, 0&, _
                         0&, DUPLICATE_SAME_ACCESS Or DUPLICATE_CLOSE_SOURCE)

    ' If both STDOUT and STDERR should be redirected, get an extra handle.
    If fTwoHandles Then
        Call DuplicateHandle(hCurProcess, hPipeWrite1, hCurProcess, hPipeWrite2, 0&, _
                             1&, DUPLICATE_SAME_ACCESS)
    End If

    With si
        .cb = Len(si)
        .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        .wShowWindow = SW_HIDE          ' hide the window

        If fTwoHandles Then
            .hStdOutput = hPipeWrite1
            .hStdError = hPipeWrite2
        ElseIf blnStdOut Then
            .hStdOutput = hPipeWrite1
        Else
            .hStdError = hPipeWrite1
        End If
    End With

    If CreateProcess(vbNullString, sCommandLine, ByVal 0&, ByVal 0&, 1, 0&, _
     ByVal 0&, vbNullString, si, pi) Then

        ' Close thread handle - we don't need it
        Call CloseHandle(pi.hThread)

        ' Also close our handle(s) to the write end of the pipe. This is important, since
        ' ReadFile will *not* return until all write handles are closed or the buffer is full.
        Call CloseHandle(hPipeWrite1)
        hPipeWrite1 = 0
        If hPipeWrite2 Then
            Call CloseHandle(hPipeWrite2)
            hPipeWrite2 = 0
        End If

        Do
            ' Add a DoEvents to allow more data to be written to the buffer for each call.
            ' This results in fewer, larger chunks to be read.
            'DoEvents

            If ReadFile(hPipeRead, baOutput(0), BUFSIZE, lBytesRead, ByVal 0&) = 0 Then
                Exit Do
            End If

            If blnOEMConvert Then
                ' convert from "DOS" to "Windows" characters
                sNewOutput = String$(lBytesRead, 0)
                Call OemToCharBuff(baOutput(0), sNewOutput, lBytesRead)
            Else
                ' perform no conversion (except to Unicode)
                sNewOutput = Left$(StrConv(baOutput(), vbUnicode), lBytesRead)
            End If

            GetCommandOutput = GetCommandOutput & sNewOutput

            ' If you are executing an application that outputs data during a long time,
            ' and don't want to lock up your application, it might be a better idea to
            ' wrap this code in a class module in an ActiveX EXE and execute it asynchronously.
            ' Then you can raise an event here each time more data is available.
            'RaiseEvent OutputAvailabele(sNewOutput)
        Loop

        ' When the process terminates successfully, Err.LastDllError will be
        ' ERROR_BROKEN_PIPE (109). Other values indicates an error.

        Call CloseHandle(pi.hProcess)
    Else
        GetCommandOutput = "Failed to create process, check the path of the command line."
    End If

    ' clean up
    Call CloseHandle(hPipeRead)
    If hPipeWrite1 Then
        Call CloseHandle(hPipeWrite1)
    End If
    If hPipeWrite2 Then
        Call CloseHandle(hPipeWrite2)
    End If
End Function



CHostLookup.cls

Option Explicit
Private m_sMyData As String
Private m_sMyKey As String
Private m_sDNS As String
Private m_sAddresses As String
Private m_sName As String
Private m_sServer As String
Private m_sMyCmd As String

Public Function Create(ByVal sCmd As String, ByVal sReturn As String)
    m_sMyData = sReturn
    m_sMyCmd = sCmd
    Create = parseData()
End Function

Public Property Get UniqueKey() As String
    UniqueKey = m_sMyKey
End Property

Public Property Get DNS() As String
    DNS = m_sDNS
End Property

Public Property Get Server() As String
    Server = m_sServer
End Property

Public Property Get Addresses() As String
    Addresses = m_sAddresses
End Property

Public Property Get HostName() As String
    HostName = m_sName
End Property

Private Function parseData() As Boolean
    ' NSLOOKUP string should look like this format:
    ' C:\Documents and Settings\Brian>nslookup cnn.com 8.8.8.8
    ' Server:  google-public-dns-a.google.com
    ' Address:  8.8.8.8
    ' Non-authoritative answer:
    ' Name:    cnn.com
    ' Addresses:  157.166.226.25, 157.166.226.26
    
    ' Do a pre-check on the code
    If (InStr(1, LCase(m_sMyData), "unknown") <> 0) Then
        parseData = False
        Exit Function
    End If
    
    m_sServer = getValues("Server")
    m_sAddresses = getValues("Addresses")
    m_sName = getValues("Name")
    
    m_sMyKey = Replace(Replace(Replace((m_sName & m_sAddresses), " ", ""), ".", ""), ",", "")
    parseData = True
End Function

Private Function getValues(ByVal curToken As String) As String
    Dim nStart As Integer
    Dim nEnd As Integer
    nStart = InStr(1, m_sMyData, curToken) + Len(curToken) + 2  ' go past the semicolon
    nEnd = InStr(nStart, m_sMyData, vbLf, vbBinaryCompare)
    getValues = Trim(Mid(m_sMyData, nStart, nEnd - nStart - 1))
End Function

Lookup return data:

nslookup cnn.com 89.233.43.71
Server:  ns1.censurfridns.dk
Address:  89.233.43.71

Name:    cnn.com
Addresses:  157.166.226.26, 157.166.226.25


------------------------------
nslookup cnn.com 91.239.100.100
Server:  anycast.censurfridns.dk
Address:  91.239.100.100

Name:    cnn.com
Addresses:  157.166.226.25, 157.166.226.26


------------------------------
nslookup www.cnn.com 89.233.43.71
Server:  ns1.censurfridns.dk
Address:  89.233.43.71

Name:    fallback.global-ssl.fastly.net
Addresses:  185.31.17.185, 185.31.17.184
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 91.239.100.100
Server:  anycast.censurfridns.dk
Address:  91.239.100.100

Name:    fallback.global-ssl.fastly.net
Addresses:  185.31.17.184, 185.31.17.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 156.154.70.1
Server:  rdns1.ultradns.net
Address:  156.154.70.1

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.47.184, 199.27.79.184
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 84.200.69.80
Server:  resolver1.ihgip.net
Address:  84.200.69.80
Aliases:  80.69.200.84.in-addr.arpa

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.43.184, 23.235.43.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 216.146.35.35
Server:  resolver1.dyndnsinternetguide.com
Address:  216.146.35.35

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.47.184, 199.27.79.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 8.8.8.8
Server:  google-public-dns-a.google.com
Address:  8.8.8.8

Name:    fallback.global-ssl.fastly.net
Addresses:  199.27.79.184, 23.235.47.184
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 74.82.42.42
Server:  ordns.he.net
Address:  74.82.42.42

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.44.184, 23.235.44.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 209.244.0.4
Server:  resolver2.level3.net
Address:  209.244.0.4

Name:    fallback.global-ssl.fastly.net
Addresses:  199.27.79.185, 199.27.79.184
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 50.116.23.211
Server:  www.eqnic.net
Address:  50.116.23.211

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.44.184, 23.235.40.184
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 195.46.39.39
Server:  dns1.safedns.com
Address:  195.46.39.39

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.40.185, 23.235.44.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 195.46.39.40
Server:  dns2.safedns.com
Address:  195.46.39.40

Name:    fallback.global-ssl.fastly.net
Addresses:  23.235.44.185, 23.235.40.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 208.76.50.50
Server:  ip-50.50.76.208.datasub.com
Address:  208.76.50.50

Name:    fallback.global-ssl.fastly.net
Addresses:  199.27.76.185, 23.235.46.184
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


------------------------------
nslookup www.cnn.com 208.76.51.51
Server:  ip-51.51.76.208.datasub.com
Address:  208.76.51.51

Name:    fallback.global-ssl.fastly.net
Addresses:  199.27.76.184, 23.235.46.185
Aliases:  www.cnn.com, global.prod.fastly.net, global-ssl.fastly.net


Done

Enter your email address to follow this blog and receive notifications of new posts by email.