Posted By

luckygreentiger on 11/20/13


Tagged

vbscript DHCP


Versions (?)

DHCP failover script


 / Published in: Visual Basic
 

VBscript that runs on a backup DHCP server that would start the DHCP service once the primary DHCP server fails to respond. It was a work project that failed to materialize. It's untested but it should work.

  1. ' Script created by floyd (luckygreentiger at gmail)
  2. ' This should allow a Windows server 2008+ act as a failover
  3. ' server for another (primary) DHCP server. The code should work
  4. ' but is untested. It was going to be used for work but ultimately
  5. ' fell through before it could be used. I am posting it for people
  6. ' to use in the hopes someone gets use out of it. If you do use it
  7. ' let me know please! This may (possibly) work for 2003+ too. For use
  8. ' as-is. No promises to work implied or given. Given freely but
  9. ' I am not liable for any damage done with this script.
  10. ' 19 November 2013
  11.  
  12. ' If you find errors and want to make corrections please email
  13. ' me at the included email address (above). Thank you.
  14.  
  15. ' DECLARE GLOBAL VARIABLES
  16. dim strStatus, strBytes, strTime, strTTL, strHostPrimary
  17. dim bFailover, bDone
  18. dim loopMinutes, leaseMinutes
  19. dim mailMessage, mailRelay
  20.  
  21. bDone = false
  22.  
  23.  
  24. ' DECLARED FUNCTIONS OF SCRIPT
  25. ' function from http://larsmichelsen.com/vbs/quickie-how-to-ping-a-host-in-vbs-i-got-two-ways/
  26. ' uses WMI to ping a server string and returns false for failure; and true for success
  27. function Ping(strHostPrimary)
  28. dim oPing, oRetStatus, bReturn
  29. set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address='" & strHostPrimary & "'")
  30.  
  31. for each oRetStatus in oPing
  32. if IsNull(oRetStatus.StatusCode) or oRetStatus.StatusCode <> 0 then
  33. bReturn = false
  34. strStatus = oRetStatus.StatusCode
  35. else
  36. bReturn = true
  37. strBytes = oRetStatus.BufferSize
  38. strTime = oRetStatus.ResponseTime
  39. strTTL = oRetStatus.ResponseTimeToLive
  40. end if
  41. set oRetStatus = nothing
  42. next
  43. set oPing = nothing
  44.  
  45. Ping = bReturn
  46. end function
  47.  
  48.  
  49. sub writeLogFile
  50. on error resume next
  51.  
  52. dim strFile, strTxt
  53. dim objFSO, objFile
  54.  
  55. strTXT = strTXT & "Status" & strStatus & "; Bytes " & strBytes & "; Time(ms) " & strTime & "; TTL(s) " & strTTL & VbCrLf
  56. strTXT = strTXT & "STATUS: " & cstr(bFailover) & " - " & Now & VbCrLf
  57. strFile = "c:\Logs\log.txt"
  58.  
  59. if (objFSO.driveExists("c:\Logs\")) then
  60. ' folder exists, need to do anything
  61. else
  62. ' folder doesn't exist, create folder
  63. objFSO.CreateDirectory("c:\Logs\")
  64. end if
  65.  
  66. set objFSO = CreateObject("Scripting.FileSystemObject")
  67. set objFile = objFile.OpenTextFile(strFile, ForAppending, true, TristateUseDefault)
  68. objFile.WriteLine strTXT
  69. objFile.Close
  70. end sub
  71.  
  72.  
  73. sub doPing
  74. on error resume next
  75.  
  76. ' part of solution from http://stackoverflow.com/questions/18150241/start-service-with-vbscript
  77. set wmi = GetObject("winmgmts://./root/cimv2") ' <-- this means the local server
  78. set service = wmi.Get("Win32_Service.Name='DHCPServer'")
  79.  
  80. ' IF Ping RETURNS TRUE
  81. if Ping(strHostPrimary) then
  82. ' strHostPrimary is reachable -- turn off failover service
  83. if service.Started = true then
  84. service.StopService
  85. end if
  86. writeLogFile
  87. bFailover = false
  88. ' IF Ping RETURNS FALSE
  89. else
  90. ' strHostPrimary is unreachable -- turn on failover service
  91. if service.Started = false then
  92. service.StartService
  93. end if
  94. writeLogFile
  95. bFailover = true
  96. end if
  97. end sub
  98.  
  99.  
  100. sub doDBTransfer
  101. on error resume next
  102. dim leaseTemp
  103.  
  104. ' if primary is available then run this portion
  105. if bFailover = false then
  106. if bDone = false then
  107. ' if done false then between 8 and 9 try to copy DB
  108. if Hour(Now()) >= 20 and Hour(Now()) < 21 then
  109. set objShell = WScript.CreateObject("WScript.Shell")
  110. ' export dhcp database
  111. objShell.run "netsh dhcp server" & strHostPrimary & "export c:\dhcp.txt all", true
  112. ' import dhcp database
  113. objShell.run "netsh dhcp server import c:\dhcp.txt all", true
  114. ' set lowered lease time
  115. leaseTemp = 60*(leaseMinutes)
  116. objShell.run "netsh dhcp server scope all optionvalue 51 DWORD " & leaseTemp, true
  117. ' nullify object
  118. objShell = nothing
  119. ' regardless if successful or not mark the bool as done
  120. bDone = true
  121. end if
  122. else
  123. ' if done true then after 9 reset switch
  124. if Hour(Now()) >=21 then
  125. bDone = false
  126. end if
  127. end if
  128. end if
  129.  
  130. end sub
  131.  
  132.  
  133. ' =========================
  134.  
  135.  
  136. ' SCRIPT STARTS HERE -- RUN SCRIPT ON THE FAILOVER SERVER WITH AN ACCOUNT WITH SYSTEM SERVICE ACCESS
  137. ' this is the primary DHCP FQDN string variable
  138. strHostPrimary = "host.domain.fqdn"
  139. ' this is how many minutes the script will wait until it loops its logic
  140. loopMinutes = 2
  141. ' this sets the lease time for the failover server
  142. leaseMinutes = 15
  143.  
  144. while true
  145. doPing
  146. doDBTransfer
  147. ' sleep is in milliseconds, so 60*1000 is one minute
  148. wscript.sleep((loopMinutes)*60*1000)
  149. wend

Report this snippet  

You need to login to post a comment.