Microsoft DNS live sync to MySQL (VBScript)

Sometime its handy to have replica of DNS records in MySQL server. You can use this database to build some network diagrams, count computers etc.

In this example I use WMI to synchronize Microsoft DNS database with MySQL server.

This script makes complete snapshot of DNS database first. Then it set a handler for each event: Create/Modify/Delete.

Each event makes changes in MySQL database. This approach allow to have exact replica of DNS records in MySQL without visible delays.

Download dnsmonitor.vbs script

You can find source code below.
Don't forget to change NetBios name of your server and MySQL credentials on top.

'Netbios name of DNS server
Const SERVERNAME = "SERVER"

'MySQL credentials
Const host="localhost"
Const Db="system"
Const login= "user"
Const password="userpassword"

'MySQL connection options
Const MYDRIVER = "MySQL ODBC 5.1 Driver"
Const FLAG_BIG_PACKETS = 8 'Allow big results
Const FLAG_NO_PROMPT = 16 'Dont prompt anything
Const FLAG_DYNAMIC_CURSOR = 32 'Allow dynamic cursor
Const FLAG_COMPRESSED_PROTO = 2048 'Use compressed protocol
Const FLAG_NO_BIGINT = 16384 'Change bigint(8) to int(4)
Const FLAG_MULTI_STATEMENTS = 67108864 'Enable batch statements
Const FLAG_AUTO_RECONNECT = 4194304 'Auto reconnect

'ADODB connection
Dim conn

'Create global objects
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}\\" & SERVERNAME & "\root\MicrosoftDNS")
Set objSink = WScript.CreateObject("WBemScripting.SWbemSink","event_")
Set objShell = CreateObject("WScript.Shell")

'Exit if already running
Set oProcess = Nothing
If alreadyRunning() Then: WScript.Quit

If Not MySQLConnect() Then
WScript.Quit
Else
PrepareDatabase
End If

'Initialize mysql data once
MySQLExecute "DELETE FROM dns_cache"
Set dnsRecords = objWMIService.ExecQuery( "SELECT * FROM MicrosoftDNS_AType", "WQL", 48 )
For Each objRecord in dnsRecords
domain = objRecord.DomainName
name = Replace(objRecord.OwnerName,domain,"")
ip = objRecord.IPAddress 
ttl = objRecord.TTL
timestamp = objRecord.Timestamp
OnCreation domain,name,ip,timestamp,ttl
Next

'Set DNS event handler
objWMIService.ExecNotificationQueryAsync objSink, "Select * from __InstanceOperationEvent within 1 where TargetInstance ISA 'MicrosoftDNS_AType'"

'Infinite loop
Do
WScript.Sleep 1000
Loop

'Events handler
Sub event_OnObjectReady( objEvent, objContext )
With objEvent
domain = objEvent.TargetInstance.DomainName
name = Replace(objEvent.TargetInstance.OwnerName,domain,"")
ip = objEvent.TargetInstance.IPAddress 
ttl = objEvent.TargetInstance.TTL
timestamp = objEvent.TargetInstance.timestamp
if name <> "" Then
Select Case .Path_.Class
Case "__InstanceModificationEvent"
OnModify domain,name,ip,timestamp,ttl
Case "__InstanceCreationEvent"
OnCreation domain,name,ip,timestamp,ttl
Case "__InstanceDeletionEvent"
OnDeletion domain,name,ip
End Select
End If
End With
End Sub

'Handler for modify event
Sub OnModify( domain, name,ip,timestamp,ttl )
update = "domainname='" & domain & "',hostname='" & name & "',ipaddress=inet_aton('" & ip & "')," & _ 
"refreshon=IF(" & timestamp & "=0,Null,'1601-01-01 00:00') + INTERVAL " & timestamp & " HOUR,ttl=" & ttl
MySQLExecute "INSERT INTO dns_cache SET " & update & " ON DUPLICATE KEY UPDATE " & update
End Sub

'Handler for create event
Sub OnCreation( domain, name,ip,timestamp,ttl )
update = "domainname='" & domain & "',hostname='" & name & "',ipaddress=inet_aton('" & ip & "')," & _
"refreshon=IF(" & timestamp & "=0,Null,'1601-01-01 00:00') + INTERVAL " & timestamp & " HOUR,ttl=" & ttl
MySQLExecute "INSERT INTO dns_cache SET " & update & " ON DUPLICATE KEY UPDATE " & update 
End Sub

'Handler for delete event
Sub OnDeletion( domain, name,ip )
MySQLExecute "DELETE FROM dns_cache WHERE hostname='" & name & "' AND ipaddress=inet_aton('" & ip & "') AND domainname='" & domain & "'"
End Sub

'Create database and tables if it wasn't done
Function PrepareDatabase
CreateDatabase = False
On Error Resume Next
MySQLExecute "CREATE DATABASE IF NOT EXISTS " & db & " CHARACTER SET utf8 COLLATE utf8_general_ci"
On Error Goto 0
MySQLExecute "USE " & db
MySQLExecute "CREATE TABLE IF NOT EXISTS dns_cache(" & _
"hostname VARCHAR(255) NOT NULL," & _
"domainname VARCHAR(255) NOT NULL," & _
"ipaddress INT(11) UNSIGNED NOT NULL," & _
"refreshon DATETIME DEFAULT NULL," & _
"ttl INT(11) NOT NULL DEFAULT 0," & _
"PRIMARY KEY (ipaddress, hostname, domainname)," & _
"INDEX IX_dns_cache_deadline (refreshon)," & _
"INDEX IX_dns_cache_domainname (domainname)," & _
"INDEX IX_dns_cache_ipaddress (ipaddress)," & _
"INDEX IX_dns_cache_name (hostname)," & _
"INDEX IX_dns_cache_ttl (ttl)" & _
") " & _
"ENGINE = INNODB " & _
"AVG_ROW_LENGTH = 68 " & _
"CHARACTER SET utf8 " & _
"COLLATE utf8_general_ci;"
If Err.Number <> 0 Then: CreateDatabase = True
End Function

Function alreadyRunning()
alreadyRunning = False
wscrCount = ProcessCount( "%wscript%" & WScript.ScriptName & "%" )
cscrCount = ProcessCount( "%cscript%" & WScript.ScriptName & "%" )
If wscrCount > 1 or cscrCount > 1 Then:alreadyRunning = True
End Function

Public Function ProcessCount(likestr)
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}\\.\root\cimv2")
Set colItems = objWMI.ExecQuery("SELECT Name,CommandLine FROM Win32_Process WHERE CommandLine Like '" & likestr & "'")
ProcessCount = colItems.Count
End Function 

'MySQL routines
Function MySQLExecute( cmd )
On Error Resume Next
Set rst = conn.Execute( cmd )
If conn.Errors.Count > 0 Then
If conn.Errors(conn.Errors.Count-1).NativeError = 2006 Then 
conn.Errors.Clear
If InitConnection() Then
Set rst = conn.Execute( cmd )
End If
End If 
End If
If rst.State = 1 And Err.Number = 0 Then
Set MySQLExecute = rst
Else
Set MySQLExecute = conn.Execute( "SELECT Null LIMIT 0" )
End If
On Error Goto 0
End Function

Function MySQLConnect
Set conn = CreateObject("ADODB.Connection")
MySQLConnect = False
On Error Resume next
conn.ConnectionString = "DRIVER={" & MYDRIVER & "};" & _
"SERVER=" & host & ";" & _
"UID=" & login & ";" & _
"PWD=" & password & ";" & _
"OPTION=" & (FLAG_BIG_PACKETS + FLAG_COMPRESSED_PROTO + FLAG_NO_BIGINT + FLAG_MULTI_STATEMENTS)
conn.ConnectionTimeout = 3
conn.Open
If Err.Number = -2147467259 Then
MsgBox "MyODBC isn't installed. Can't connect to MySQL!"
Exit Function
End If
If Err.Number <> 0 Then
MsgBox err.description
Exit Function
End If
MySQLConnect = True
On Error GoTo 0
End Function

Sub MySQLDisconnect
conn.Close
Set conn = Nothing
End Sub