/ 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.
Expand |
Embed | Plain Text
Copy this code and paste it in your HTML
' Script created by floyd (luckygreentiger at gmail) ' This should allow a Windows server 2008+ act as a failover ' server for another (primary) DHCP server. The code should work ' but is untested. It was going to be used for work but ultimately ' fell through before it could be used. I am posting it for people ' to use in the hopes someone gets use out of it. If you do use it ' let me know please! This may (possibly) work for 2003+ too. For use ' as-is. No promises to work implied or given. Given freely but ' I am not liable for any damage done with this script. ' 19 November 2013 ' If you find errors and want to make corrections please email ' me at the included email address (above). Thank you. ' DECLARE GLOBAL VARIABLES dim strStatus, strBytes, strTime, strTTL, strHostPrimary dim bFailover, bDone dim loopMinutes, leaseMinutes dim mailMessage, mailRelay bDone = false ' DECLARED FUNCTIONS OF SCRIPT ' function from http://larsmichelsen.com/vbs/quickie-how-to-ping-a-host-in-vbs-i-got-two-ways/ ' uses WMI to ping a server string and returns false for failure; and true for success function Ping(strHostPrimary) dim oPing, oRetStatus, bReturn set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address='" & strHostPrimary & "'") for each oRetStatus in oPing if IsNull(oRetStatus.StatusCode) or oRetStatus.StatusCode <> 0 then bReturn = false strStatus = oRetStatus.StatusCode else bReturn = true strBytes = oRetStatus.BufferSize strTime = oRetStatus.ResponseTime strTTL = oRetStatus.ResponseTimeToLive end if set oRetStatus = nothing next set oPing = nothing Ping = bReturn end function sub writeLogFile on error resume next dim strFile, strTxt dim objFSO, objFile strTXT = strTXT & "Status" & strStatus & "; Bytes " & strBytes & "; Time(ms) " & strTime & "; TTL(s) " & strTTL & VbCrLf strTXT = strTXT & "STATUS: " & cstr(bFailover) & " - " & Now & VbCrLf strFile = "c:\Logs\log.txt" if (objFSO.driveExists("c:\Logs\")) then ' folder exists, need to do anything else ' folder doesn't exist, create folder objFSO.CreateDirectory("c:\Logs\") end if set objFSO = CreateObject("Scripting.FileSystemObject") set objFile = objFile.OpenTextFile(strFile, ForAppending, true, TristateUseDefault) objFile.WriteLine strTXT objFile.Close end sub sub doPing on error resume next ' part of solution from http://stackoverflow.com/questions/18150241/start-service-with-vbscript set wmi = GetObject("winmgmts://./root/cimv2") ' <-- this means the local server set service = wmi.Get("Win32_Service.Name='DHCPServer'") ' IF Ping RETURNS TRUE if Ping(strHostPrimary) then ' strHostPrimary is reachable -- turn off failover service if service.Started = true then service.StopService end if writeLogFile bFailover = false ' IF Ping RETURNS FALSE else ' strHostPrimary is unreachable -- turn on failover service if service.Started = false then service.StartService end if writeLogFile bFailover = true end if end sub sub doDBTransfer on error resume next dim leaseTemp ' if primary is available then run this portion if bFailover = false then if bDone = false then ' if done false then between 8 and 9 try to copy DB if Hour(Now()) >= 20 and Hour(Now()) < 21 then set objShell = WScript.CreateObject("WScript.Shell") ' export dhcp database objShell.run "netsh dhcp server" & strHostPrimary & "export c:\dhcp.txt all", true ' import dhcp database objShell.run "netsh dhcp server import c:\dhcp.txt all", true ' set lowered lease time leaseTemp = 60*(leaseMinutes) objShell.run "netsh dhcp server scope all optionvalue 51 DWORD " & leaseTemp, true ' nullify object objShell = nothing ' regardless if successful or not mark the bool as done bDone = true end if else ' if done true then after 9 reset switch if Hour(Now()) >=21 then bDone = false end if end if end if end sub ' ========================= ' SCRIPT STARTS HERE -- RUN SCRIPT ON THE FAILOVER SERVER WITH AN ACCOUNT WITH SYSTEM SERVICE ACCESS ' this is the primary DHCP FQDN string variable strHostPrimary = "host.domain.fqdn" ' this is how many minutes the script will wait until it loops its logic loopMinutes = 2 ' this sets the lease time for the failover server leaseMinutes = 15 while true doPing doDBTransfer ' sleep is in milliseconds, so 60*1000 is one minute wscript.sleep((loopMinutes)*60*1000) wend