'==========================================================================
' NAME: USBDriveFiles.vbs
'
' AUTHOR: Alan Kaplan, alan dot kaplan at VA dot gov
' DATE  : 8/22/2006
'
' COMMENT: Locates USB drives, maps hidden share, launches explorer to view
' v.1.1 changed launch and close routines to avoid security problems with opening with WMI launch
' 1/11/2008  v. 1.2 added error handling for RunAs 
'==========================================================================
Option Explicit
Dim strComputer

Dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")

dim message
'On Error Resume Next

If WScript.Arguments.Count = 1 Then
	strComputer = WScript.Arguments(0)	'drag and drop a MSG file from desktop
	Dim fso, strArg1, tArray
	set fso = CreateObject("Scripting.FileSystemObject")	
	strArg1 = WScript.Arguments(0)
	
	If fso.FileExists(strArg1) Then 
		tArray = split(fso.GetBaseName(strArg1))
		strComputer = tArray(UBound(tArray))
		fso.DeleteFile(strArg1)
	Else
		strComputer =strArg1
	End If 
	
Else
	strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
	message = "This will check files on USB Drive of a remote PC." & vbcrlf & vbcrlf & _
		"Enter a PC Name:"
	strComputer = InputBox(message,"Computer Name?",strComputer)
End If 

If strcomputer = "" Then WScript.Quit
strComputer = UCase(strComputer)

Dim strWQL, oWMI, colDiskDrives, oDiskDrive
Dim colPartitions, oPartition
Dim ColLDrives, oLDrive, strModel, i, iRetval
i = 0

On Error Resume Next
Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
If Err <> 0 Then 
	MsgBox Err.Description,vbCritical + vbOKOnly,"Error"
	WScript.Quit
End If 
On Error GoTo 0

'Getting the drive letter is complicated ...
Set colDiskDrives = oWMI.ExecQuery("SELECT * FROM Win32_DiskDrive where InterfaceType='USB' and size > 0",,48)

    For Each oDiskDrive In colDiskDrives 'Get USB Drives.  DeviceID looks like \\.\PHYSICALDRIVE1
      strModel = oDiskDrive.Caption
	   strWQL =  "ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & oDiskDrive.deviceID & _
		 "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
	   Set colPartitions = oWMI.ExecQuery(strWQL,,48)
	   For Each oPartition In colPartitions
	   	i = i + 1
	   	'WScript.Echo "Partition: " & oPartition.DeviceID 'Device ID looks like Disk #1, Partition #0
		 strWQL = "ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & oPartition.DeviceID & _
		 "'} WHERE AssocClass = Win32_LogicalDiskToPartition"
		 
		 Set colLDrives = oWMI.ExecQuery(strWQL,,48)
		 	For Each oLDrive In ColLDrives
		 		iRetval = MsgBox("Found " & strModel & ". View Files?",vbYesNoCancel + vbQuestion,"Drive found")
		 		If iRetval = vbCancel Then WScript.Quit 
		 		If iRetval = vbYes Then 
		 			Explore oLDrive.DeviceID	'Device ID looks like E:
		 		End If
		 	Next
	   Next	 
   Next
   
If i = 0 Then
	MsgBox "No USB drive found",vbInformation + vbOKOnly,strComputer
End If 

Sub Explore(strDrive)
	Dim strDescription
	dim strShare
	Dim oShare, oInParam, oRetVal
	Dim oStartup, oConfig, oProcess
	Dim iProcID, iRetval
	Dim colProcessStopTrace, oLatestEvent
	Dim strCommand
	dim quote
	quote=chr(34)

	strDescription = "Admin Created Audit Share"
	strShare = Replace(strDrive,":","$")
	strDrive = strDrive & "\"	
	
	wshshell.popup "Creating share " & strShare & " so files can be viewed, please wait...",2,strComputer
	
	Set oShare = oWMI.Get("Win32_Share")
	
	Set oInParam = oShare.Methods_("Create").inParameters.SpawnInstance_()
	' Add the input parameters.
	With oInParam.Properties_
		.Item("Description") =  strDescription
		.Item("Name") =  strShare
		.Item("Path") =  StrDrive
		.Item("Type") =  0 ' file share	
	End With 
		
	Set oRetVal = oWMI.ExecMethod("Win32_Share", "Create", oInParam)
	
	If  oRetVal.ReturnValue = 0 Or oRetVal.ReturnValue = 22 Then  ' 22 already created
		'WScript.Echo "Success"
	Else
		MsgBox  "Failed to create share",vbCritical + vbOKOnly,strComputer
		WScript.Quit
	End If 
	
	'Open the newly created share in explorer on local machine

	Dim oExec
	strCommand = "c:\program files\internet explorer\iexplore.exe -e \\" & strComputer & "\" & strShare
	Set oExec    = WshShell.Exec(strCommand)
	iProcID = oExec.ProcessID
	strComputer = LCase(strComputer)
	'Wait until Explorer is open...
	Wscript.sleep 20000
	

	'Wait until Explorer is closed...
	
	While WindowOpen
		WScript.Sleep 5000
	Wend
	
	'Then delete share
	message = "Press okay when ready to delete share " & strShare & VbCrLf & vbCrLf & _
	"(If you do not see a file list, please wait for the authentication dialog.  This may occur if RunAs was used to launch.)"
	wshShell.Popup message,0,ucase(strComputer)
	Set oShare = oWMI.Get("Win32_Share.Name='"& strShare &"'")
	Set oRetVal = oWMI.ExecMethod("Win32_Share.Name='"& strShare &"'", "Delete")
	 
	If  oRetVal.ReturnValue = 0 Then 
	 	'WScript.Echo "Success"
	Else
	 	MsgBox "Failed to delete share",vbCritical + vbOKOnly,strComputer
	 	WScript.Quit
	End If 
	
End Sub 


Function WindowOpen()
	On Error Resume Next
	Dim oShell, i, oWindows, w, strURL
	Set oShell = CreateObject("Shell.Application")', strComputer)
	WindowOpen = False
	Set oWindows = oShell.Windows
		
	For i = 1 To  oWindows.Count -1
	  	If IsObject(oWindows.Item(i))  Then 
	  		Set w = oWindows.Item(i)  
	  		strURL = lcase(w.LocationURL)
			'WScript.echo w.LocationName &  vbcrlf + w.LocationURL & VbCrLf 
			If  InStr(strURL,"file://" & strComputer) > 0 Then  WindowOpen = True
	  	End If 
	Next
	
End Function