Wednesday, July 21, 2010

Open USB Drives but be notified by a Email and a Log File VB Script

HKEY_LOCAL_MACHINE = &H80000002

strComputer = inputbox ("Please Enter Computer Name","Enter Computer Name","My-Computer")

On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
If Err.Number Then
WScript.Echo "Computer Name Does Not Exist"
Wscript.Quit
End If

dim objNetwork
Dim fso
Dim CurrentDate
Dim LogFile
CurrentDate = Now
Set objNetwork = WScript.CreateObject("WScript.Network")
Set fso = CreateObject("Scripting.FileSystemObject")
strUser = objNetwork.UserDomain

Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies"

objReg.CreateKey HKEY_LOCAL_MACHINE, strKeyPath

ValueName = "WriteProtect"

DwordValue = "0"

objReg.SetDwordValue HKEY_LOCAL_MACHINE, strKeyPath, ValueName, DwordValue

If IsNull(DwordValue) Then

Wscript.Echo "The Registry Key for " & strComputer & " is not found. - ", DwordValue

Elseif DwordValue=0 then

Wscript.Echo "The USB Key for computer " & strComputer & " is: Open and Not Read Only! - ", DwordValue
Set LogFile = fso.OpenTextFile(BinPath & "ChangeLog.log",8,true,0)
LogFile.WriteBlankLines 1
LogFile.WriteLine("================================================================================")
LogFile.WriteLine("USB Access changed to OPEN" & " By User " & objNetwork.UserName )
LogFile.WriteLine(Now & " - The Registry Key for " & strComputer & " is open.")
LogFile.WriteLine("================================================================================")
LogFile.WriteBlankLines 1
LogFile.Close

' ------ NOTIFY OF USB KEY CHANGE ACCESS ------
strFrom = "usbaccess@yourdomain.com.au"
strTo = "it@yourcompany.com.au"
strSub = "USB Access changed to OPEN" & " By User " & objNetwork.UserName
strBody = "USB Access changed to OPEN" & " By User " & objNetwork.UserName & " on " & Now & " - The Registry Key for " & strComputer & " is now open."
strSMTP = "YOUR-INTERNAL-SMTP-SERVER"
' ------ END CONFIGURATION ---------
set objEmail = CreateObject("CDO.Message")
objEmail.From = strFrom
objEmail.To = strTo
objEmail.Subject = strSub
objEmail.Textbody = strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
objEmail.Configuration.Fields.Update
objEmail.Send

else

Wscript.Echo "The USB Key for computer " & strComputer & " is Secured and Read Only - ", DwordValue

End if

If Msgbox("Do you want to reboot machine now for the change to take affect? " & strComputer, vbYesNo, "Reboot Machine") = vbYes then

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\" & _
strComputer & "\root\cimv2")

Set colOS = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each objOS in colOS
objOS.Reboot()
Next

End If

No comments:

Post a Comment