How to lock down USB Keys and Be Notified IN USE

1.

 How to lock down USB Keys and Be Notified IN USE

Locking down USB Drives to Read Only

HKEY_LOCAL_MACHINE = &H80000002
Err.Clear
' On Error Resume Next
strComputer = inputbox ("Please Enter Computer Name","Enter Computer Name","IT-0")
' Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
' If Err.Number Then
' Wscript.Quit
' End If
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
if strcomputer = "" then
Wscript.Quit
End if
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies"
objReg.CreateKey HKEY_LOCAL_MACHINE, strKeyPath
ValueName = "WriteProtect"
DwordValue = "1"
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 now OPEN: Not Read Only! - ", DwordValue
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
2.

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

Firstly create a text document in the same directory as your VBScript called changelog.log
Then continue to cut and paste below into a text document with your heading and an extension of .vbs
----------------------------
' On Error Resume Next
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"
strTo = "it@yourcompany.com"
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

Conclusion

You can also run this script to see whether the change you have made is successful:
' On Error Resume Next
HKEY_LOCAL_MACHINE = &H80000002
strComputer = inputbox ("Please Enter Computer Name","Enter Computer Name")
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\StorageDevicePolicies"
ValueName = "WriteProtect"
objReg.GetDwordValue HKEY_LOCAL_MACHINE, strKeyPath, ValueName, DwordValue
If IsNull(DwordValue) Then
Wscript.Echo "The value is either Null or could not be found in the registry."
Elseif DwordValue=0 then
Wscript.Echo "The USB Key is: Not Read Only - ", DwordValue
else
Wscript.Echo "The USB Key is Secured and Read Only - ", DwordValue
End If