Capturing Files Names While data being copied to USB Devices and shooting an email with filenames

• Friday, March 02, 2012 7:33 AM

   

   
  

  0

  Hi 

  I am looking for help to capture filenames which are copied to/from USB drive and the similar files to be included in Email

  Was able to finish the email part with the script below can capturing file names is possibel?

  ' 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.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
  

  • Reply
  • Quote