'==========================================================================
'
' NAME: ReportThumbdrives.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: [URL unfurl="true"]http://www.thespidersparlor.com[/URL]
' DATE : 5/8/2009
' COPYRIGHT © 2009, All Rights Reserved
'
' COMMENT: Reports PCs in domain with USB drives attached.
' Useful for Security audits.
' Block USB drive access via GPO
' [URL unfurl="true"]http://www.petri.co.il/disable_usb_disks_with_gpo.htm[/URL]
'
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF
' ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED To
' THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
' PARTICULAR PURPOSE.
'
' IN NO EVENT SHALL THE SPIDER'S PARLOR AND/OR ITS RESPECTIVE SUPPLIERS
' BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
' DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
' WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
' ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
' OF THIS CODE OR INFORMATION.
'
'==========================================================================
On Error Resume Next
strReportPath = "ComputersWithUSB.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WSHShell = CreateObject("Wscript.Shell")
Set objFile = objFSO.OpenTextFile(strReportPath, 8, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be created"
Set objFSO = Nothing
Wscript.Quit
End If
Set oRootDSE = GetObject("LDAP://rootDSE")
strDom = oRootDSE.Get("DefaultNamingContext")
' available categories = computer, user, printqueue, group
qQuery = "<LDAP://" & strDom & ">;" & _
"(objectCategory=computer)" & _
";name;subtree"
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Open "Provider=ADsDSOObject;"
objCommand.ActiveConnection = objConnection
objCommand.CommandText = qQuery
Set objRecordSet = objCommand.Execute
Do until objRecordSet.EOF
strPingStatus = PingStatus(objRecordSet.Fields("name"))
If strPingStatus = "Success" Then
Report = CheckUSB(objRecordSet.Fields("name"))
Else
Report = Report & vbCrLf & "********************************"
Report = Report & vbCrLf & objRecordSet.Fields("name") & " is offline"
Report = Report & vbCrLf & "********************************"
objRecordSet.Fields("name")
End If
objFile.Write Report
objrecordset.MoveNext
loop
adoRecordset.Close
WSHShell.Run "ComputersWithUSB.txt"
Function CheckUSB(strcomputer)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err.Number = 0 Then
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='USB'",,48)
For Each objItem in colItems
If Int(objItem.Size) > 0 Then
Report = Report & vbCrLf & "********************************"
Report =Report & vbCrLf & "SystemName: " & objItem.SystemName
Report = Report & vbCrLf & "Caption: " & objItem.Caption
Report =Report & vbCrLf & "InterfaceType: " & objItem.InterfaceType
Report =Report & vbCrLf & "Size: " & objItem.Size
Report = Report & vbCrLf & "********************************"
End If
Next
End If
If Len(Report) = 0 Then
Report = Report & vbCrLf & "********************************"
Report = Report & vbCrLf & strComputer & " does not have USB drives."
Report = Report & vbCrLf & "********************************"
End If
CheckUSB = Report
End Function
Function PingStatus(strComputer)
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
Select Case objPing.StatusCode
Case 0 PingStatus = "Success"
Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
Case 11004 PingStatus = _
"Status code 11004 - Destination Protocol Unreachable"
Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
Case 11006 PingStatus = "Status code 11006 - No Resources"
Case 11007 PingStatus = "Status code 11007 - Bad Option"
Case 11008 PingStatus = "Status code 11008 - Hardware Error"
Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
Case 11011 PingStatus = "Status code 11011 - Bad Request"
Case 11012 PingStatus = "Status code 11012 - Bad Route"
Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
Case 11014 PingStatus = _
"Status code 11014 - TimeToLive Expired Reassembly"
Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
Case 11016 PingStatus = "Status code 11016 - Source Quench"
Case 11017 PingStatus = "Status code 11017 - Option Too Big"
Case 11018 PingStatus = "Status code 11018 - Bad Destination"
Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
Case 11050 PingStatus = "Status code 11050 - General Failure"
Case Else PingStatus = "Status code " & objPing.StatusCode & _
" - Unable to determine cause of failure."
End Select
Next
End Function