'version 0.101 30/10/2007 
'added support for HP Cameras
'version 0.101 16/01/2008
'added computer name when reporting problems while logging

bEnableLogging = True
bIncludeDateStamp = True
bPrependDateStampInLogFileName = True
sLogFileLocation = "C:temp\"
'sLogFileLocation = "relative"
'Specify the log file name here.
sLogFileName = "digicamlog.txt"
'Specify to overite or append 
sOverWriteORAppend = "append"

On Error Resume Next

Logtofile ("Version 0.101 started")

strComputer = "."

foundpics = False

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\" & strComputer & "rootcimv2")
Set colMonitoredProcesses = objWMIService.ExecNotificationQuery("select * from __InstanceOperationEvent within 5 where TargetInstance isa 'Win32_PnPEntity'")
i = 0
Do While i = 0
    Set objLatestProcess = colMonitoredProcesses.NextEvent
    if instr(1,objLatestProcess.TargetInstance.Name,"USB Mass Storage Device" ,1) > 0 then
     call ISCamera (strComputer)
    elseif instr(1,objLatestProcess.TargetInstance.Name,"Hewlett-Packard Digital Camera" ,1) > 0 then
     call ISCamera (strComputer)
    end if
Loop

function ISCamera(strComputer)
    Set objWMIService = GetObject("winmgmts:\" & strComputer & "rootcimv2")
    Set colDevices = objWMIService.ExecQuery("Select * From Win32_USBControllerDevice")
    
    For Each objDevice In colDevices
        strDeviceName = objDevice.Dependent
        strQuotes = Chr(34)
        strDeviceName = Replace(strDeviceName, strQuotes, "")
        arrDeviceNames = Split(strDeviceName, "=")
        strDeviceName = arrDeviceNames(1)
        Set colUSBDevices = objWMIService.ExecQuery("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
        For Each objUSBDevice In colUSBDevices
            	If LCase(objUSBDevice.Description) = LCase("USB Mass Storage Device") Then
                	LogToFile objUSBDevice.Description
			call StartCopyDigiCam()
                	Exit function
		elseif LCase(objUSBDevice.Description) = LCase("Hewlett-Packard Digital Camera") Then
                	LogToFile objUSBDevice.Description
			call StartCopyDigiCam()
                	Exit function           
	 	End If
        Next
    Next
end function


function StartCopyDigiCam()
	
	On Error Resume Next
	
	LogToFile "StartCopyDigiCam()"

	strComputer = "."

	strDrive = ComputerHasCDROM(strComputer)
	
	LogToFile "Step 1 strDrive=" & strDrive
	
	If strDrive <> False Then
		folderspec = AddSlash(strDrive)
		LogToFile "Step 2 strDrive=" & strDrive
	Else
		LogToFile "Step 3 strDrive=" & strDrive
	End If

	if strDrive = False Then
		LogToFile "Camera has been unplugged"
		Exit Function
	End if
		

	Const MY_PICTURES = &H27&
	
	LogToFile "Step 4"

	strCopyTo = CreateCopyPath(MY_PICTURES) ' Find path to all folders

	MoveFolderTree folderspec, AddSlash(strCopyTo), "JPG" ' Move pictures from Camera and put them on the local drive (resume on next) (returns True if found at lease one JPG)
	
	LogToFile "Step 6 " & foundpics
	
	if foundpics <> False Then
		LogToFile "send email that pictures were found and continue"
	else
		LogToFile "send email that there is no pictures on the camera and exit"
		DeleteFolder AddSlash(strCopyTo)
		Exit Function
	end if
	
	foundpics = False ' so it can be set in the next run

	LogToFile "Step 7"

	EmailNotify "External device detected", "The system started transfering pictures, please wait for the next email before continuing", GetUsername


	strCopyToNetwork = CreateCopyToNetworkPath(GetUsername)
	
	LogToFile "Step 8 " & strCopyToNetwork
	
	strCopyToNetwork = CopyToNetWork(AddSlash(strCopyTo), AddSlash(strCopyToNetwork))  ' Copy Pictures form local drive to F drive
	
	LogToFile "Step 9 " & strCopyToNetwork
	
	SendNotificationEmail AddSlash(strCopyToNetwork), GetUsername, strCopyToNetwork

	If Err.number <> 0 Then
		LogToFile "Step 10 Error! Details: " & Err.Description
		EmailNotify GetUsername & " Had had a problem with Digital Camera Script" , "Details of problem" & Err.Description, "ksekula"
		Err.Clear
		Exit Function
	End If
	
	LogToFile "Step 11"
	
	DeleteFolder AddSlash(strCopyTo)
	
	LogToFile "Ended StartCopyDigiCam()"

End Function 

Function AddEmailAttachments(objmail, strAttachments)

    Dim fso
    Dim f
    Dim f1
    Set fso = CreateObject("Scripting.FileSystemObject")    
    Set f = fso.GetFolder(strAttachments)
    For Each f1 In f.Files
        objmail.AddAttachment (f1.Path)
    Next
End Function

Function SendNotificationEmail(strMsg, strUser, strAttachmentfolder)
    On Error Resume Next
    Dim objEmail
    Set objEmail = CreateObject("CDO.Message")
    objEmail.From = strUser & "@sports-soccer.co.uk"
    objEmail.To = strUser & "@sports-soccer.co.uk"
    objEmail.Subject = "Your Digital Camera Picture(s) have been processed"
    objEmail.HTMLBody = "Your pictures have been copied from the digital camera and have been delivered to retail support. You may now unplug your digital camera."
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "stella-exchange"
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    objEmail.Send
    Set objEmail = Nothing
End Function

Function EmailNotify (strSubject, strText, strUser)
    Dim objEmail
    Set objEmail = CreateObject("CDO.Message")
    objEmail.From = strUser & "@sports-soccer.co.uk"
    objEmail.To = strUser & "@sports-soccer.co.uk"
    objEmail.Subject = strSubject
    objEmail.HTMLBody = strText
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "stella-exchange"
    objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objEmail.Configuration.Fields.Update
    objEmail.Send
    Set objEmail = Nothing
End Function

Function CreateCopyToNetworkPath(strUser)
    CreateCopyToNetworkPath = "youngsdata1GroupPrivateGroup ResourcesCameraImages\" & strUser
    'CreateCopyToNetworkPath = "c:temp\" & strUser
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(CreateCopyToNetworkPath) Then
         fso.CreateFolder (CreateCopyToNetworkPath)
    End If
End Function

Function DeleteFolder(strPath)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.DeleteFolder RemoveSlash(strPath), True
End Function

Function CopyToNetWork(CopyPathFrom, CopyPathTo)
	On Error Resume Next
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateFolder CopyPathTo & GetLastFolder(CopyPathFrom)
    fso.CopyFile CopyPathFrom & "*", CopyPathTo & GetLastFolder(CopyPathFrom), True
    CopyToNetWork = CopyPathTo & GetLastFolder(CopyPathFrom)
End Function

Function GetUsername()
    Set objNetwork = CreateObject("Wscript.Network")
    GetUsername = objNetwork.UserName
End Function

Function GetLastFolder(strPath)
    Dim strStart
    Dim strEnd
    strEnd = Len(strPath)
    strStart = InStrRev(strPath, "\", strEnd - 1)
    GetLastFolder = Replace(Mid(strPath, strStart + 1, strEnd - strStart), "\", "")
End Function

Function AddSlash(strPath)
    If Not Right(strPath, 1) = "\" Then
        strPath = strPath & "\"
    End If
    AddSlash = strPath
End Function

Function RemoveSlash(strPath)
    If Right(strPath, 1) = "\" Then
        strPath = Left(strPath, Len(strPath) - 1)
    End If
    RemoveSlash = strPath
End Function

Function CreateCopyPath(MY_PICTURES)
	LogToFile "Step 12 MY_Pictures = "
    Dim fso, f
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(MY_PICTURES)
    strNewFolderName = Replace(Replace(Date & " " & Time, "/", " "), ":", " ")
    LogToFile "Step 13 strNewFolderName = " & strNewFolderName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.CreateFolder(objFolder.Self.Path & "\" & "Pictures copied at " & strNewFolderName)
    CreateCopyPath = f.Path
    LogToFile "Step 14 CreateCopyPath = " & CreateCopyPath
End Function

Function MoveFolderTree(folderspec, CopyPath, CopyExtension)
	On Error Resume Next ' If the camera was unplugged try to send at least some of the pictures
    Dim fso
    Dim f
    Dim f1
    Dim subf
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(folderspec)
     For Each f1 In f.Files
		If LCase(GetFileExtension(f1)) = LCase(CopyExtension) Then
           fso.MoveFile f1.Path, CopyPath
           Foundpics = True
        End If
	 Next
    For Each subf In f.SubFolders
        MoveFolderTree subf, CopyPath, CopyExtension
    Next
    LogToFile "Path: " & f
End Function

Function GetFileExtension(FileSpec)
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   GetFileExtension = fso.GetExtensionName(FileSpec)
End Function

Function ComputerHasCDROM(strComputer)
On Error Resume Next
    Dim objWMIService
    Dim colDisks
    Dim objDisk
    
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "rootcimv2")
    Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk")


    For Each objDisk In colDisks
        If (objDisk.DeviceID <> "A:") And (objDisk.DriveType = "2") Then '5=Compact disc
            ComputerHasCDROM = objDisk.DeviceID ' has got one...
             Exit Function
         End If
    Next
    ComputerHasCDROM = False
End Function


Sub LogToFile(Message)

    set wshnetwork=createobject("wscript.network")
    pcname=wshnetwork.computername
    set wshnetwork=nothing

    on Error resume next
    'Wscript.Echo "Message() " & Message

    If bEnableLogging = False Then Exit Sub

    Const ForWriting = 2
    Const ForAppending = 8
   
    Set oLogFSO = CreateObject("Scripting.FileSystemObject")
    
    If sLogFileLocation = "relative" Then
        Set oLogShell = CreateObject("Wscript.Shell")
        sLogFileLocation = oLogShell.CurrentDirectory & "\"
        Set oLogShell = Nothing
    End If
    
    If bPrependDateStampInLogFileName Then
        sNow = Replace(Replace(Now(),"/","-"),":",".")
        sLogFileName = GetUsername & " - " & sLogFileName
        'sLogFileName = sNow & " - " & sLogFileName
        bPrependDateStampInLogFileName = False        
    End If
    
    sLogFile = sLogFileLocation & sLogFileName
    
    If sOverWriteORAppend = "overwrite" Then
        Set oLogFile = oLogFSO.OpenTextFile(sLogFile, ForWriting, True)
        sOverWriteORAppend = "append"
    Else
        Set oLogFile = oLogFSO.OpenTextFile(sLogFile, ForAppending, True)
    End If

    If bIncludeDateStamp Then
        Message = Now & "   " & Message
    End If

    oLogFile.WriteLine(Message)
    
    oLogFile.Close
    oLogFSO = Null
    
    If Err.number <> 0 Then
		EmailNotify "Camera Script on " & pcname & " had problems writing to log folder c:temp for User: " & GetUsername, "Details of problem " & Err.Description & " Error no = " & Err.number, "ksekula"
		Err.Clear
	End if
    
End Sub