Solved

VBscript to run .bat file upon CD insertion?

Posted on 2014-09-08
27
383 Views
Last Modified: 2014-09-28
I'm needing some help creating a .vbs file that will call a .bat file with certain parameters. What the bat file will do is read a CD and send all 'compatible' files it finds via a DICOM transfer. When it finishes, I would need to eject the CD and then display a message box with some text and an 'OK' button.

Here is what I am currently using which isn't working out too well.

Dim objshell
Set objshell = WScript.CreateObject ("WScript.Shell")
objshell.Run "c:\apps\dcm4che-3.3.3-bin\bin\storescu -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt"
objshell.Run "c:\cdr.exe open E:"
x=msgbox("The import job is finished, please remove your CD/DVD." ,0, "CD Import")

Open in new window


The 'cdr.exe' is something I found to open the CDROM as I had originally been using this in a .bat file. I need to switch over to VBS so that I can get a msg box to display to the user, so the line that calls 'cdr.exe' can disappear if VBS can open the CDROM. The message box is displayed before the 'storescu' has had time to finish running. Also, there is no logic for it to detect if a CD has been inserted. My CDROM drive letter is 'E:'.

When the drawer is closed, it might or might not have a different CD inserted. I was hoping I could have this loop and 'wait' for a CD to be inserted and if so, then run the 'storescu' command.

thank you
0
Comment
Question by:doc_jay
  • 13
  • 13
27 Comments
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi, this VBS code does not require a batch file or external EXE, besides storescu.exe, and should loop until the user says they don't want to import any more CDs.

Regards,

Rob.

Set objShell = CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
strResponse = vbYes
While strResponse = vbYes
	Call RunTransfer
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")
Wend
MsgBox "Transfer(s) complete."

Sub RunTransfer
	For Each objDrive In objFSO.Drives
		WScript.sleep 60
		If objDrive.DriveType = 4 Then
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			If objFSO.FileExists("c:\apps\dcm4che-3.3.3-bin\bin\storescu") = True Then
				objShell.Run "c:\apps\dcm4che-3.3.3-bin\bin\storescu -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt", 1, True
			Else
				MsgBox "Could not find storescu", vbOKOnly, "File not found"
			End If
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			objShellApp.Namespace(17).ParseName(objDrive.DriveLetter & ":\").InvokeVerb("Eject")
		End If
	Next
End Sub

Open in new window

0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   Thank you very much for the code.  I'll try it out tomorrow 1st thing.  I like your code and I could definitely use it.  For this particular group of users I had in mind (our ER Dept) I was hoping I could have it run continuously and not give the user the option to stop the script.  The situation is that our hospital ER will get a CD in with a trauma patient and they need to view the images right away instead of re-imaging the patient again and exposing them again to x-ray.  The 'storescu' tool will read the images and send them to our DICOM server to be viewed with our image viewer.  Usually these other outside sites include a 'viewer' on the CD for a user to view the images, but we have found that either there is no viewer or the viewer doesn't correctly autorun.  Normal users won't be able to figure out how to browse the CD and start the viewer if one is included.  You never know what users are going to do.

Your script might work out just fine for me, I'll post back and give an update.

thanks
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Sure, if that's the case you could just change
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")

Open in new window


to
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD. ", vbOKOnly, "CD Import")
	strResponse = vbYes

Open in new window


and comment out as many prompts as you don't want to see.  It may be a good idea to test for the existence of a specific type of file before running storescu as well, just in case it's not an imaging CD that is inserted.  There's no point in storescu running if there aren't any images.

Regards,

Rob.
0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

    I think we are just going to run it as is, and the user can double click the script to run again if needed.  We are going to instruct them that this PC will only be for imaging, so if they do insert a non imaging CD, then that is their fault.  Once again, users are unpredictable.

One other request, where could I insert a message box (with no 'ok' button) just to give the user some glimmer of hope that their CD is being imported by the 'storescu' tool.  I just want to splash up a  message that reads 'Your CD is now being imported' once the 'storescu' tool starts, and then would disappear once the tool finishes its work?

Thanks again for the code, excellent answer!
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, not exactly the most intuitive thing to do with VBScript, but you can build a small HTA file and load that to show a message.  This script will do that.

Regards,

Rob.

Set objShell = CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
strResponse = vbYes
While strResponse = vbYes
	Call RunTransfer
	'strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD. ", vbOKOnly, "CD Import")
	strResponse = vbYes
Wend
MsgBox "Transfer(s) complete."

Sub RunTransfer
	For Each objDrive In objFSO.Drives
		WScript.sleep 60
		If objDrive.DriveType = 4 Then
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			If objFSO.FileExists("c:\apps\dcm4che-3.3.3-bin\bin\storescu") = True Then
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec = objShell.Exec("mshta.exe """ & strHTAFile & """")
				objShell.Run "c:\apps\dcm4che-3.3.3-bin\bin\storescu -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt", 1, True
				objExec.Terminate
				objFSO.DeleteFile strHTAFile, True
			Else
				MsgBox "Could not find storescu", vbOKOnly, "File not found"
			End If
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			objShellApp.Namespace(17).ParseName(objDrive.DriveLetter & ":\").InvokeVerb("Eject")
		End If
	Next
End Sub

Sub CreateHTAFile(strFileName)
	strHTML = "<html>" & vbCrLf & _
    "<HTA:APPLICATION" & vbCrLf & _
    "    Caption=""no""" & vbCrLf & _
    ">" & vbCrLf & _
    "<script language = ""VBScript"">" & vbCrLf & _
	"Sub Window_onLoad" & vbCrLf & _
	"    Me.ResizeTo 300,100" & vbCrLf & _
	"    Me.MoveTo ((Screen.Width / 2) - 200),((Screen.Height / 2) - 150)" & vbCrLf & _
	"End Sub" & vbCrLf & _
    "</script>" & vbCrLf & _
    "<body bgcolor='lightblue'>" & vbCrLf & _
    "    <p align='center'><BR>Your CD is now being imported</p>" & vbCrLf & _
    "</body>" & vbCrLf & _
	"</html>" & vbCrLf
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.CreateTextFile(strFileName, True)
	objFile.Write strHTML
	objFile.Close
End Sub

Open in new window

0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

  I was doing some testing with this script, basically trying to make it misbehave.  While the HTA file is up and gives the user the message 'Your CD is now being imported', if the user removes the CD/DVD then it doesn't disappear and the 'cmd' is still running.  I had to go kill 'cmd.exe' and also close the message box.  

Do you think there is anyway for it to check if there is still a CD/DVD in the drive and if so, then kill or close the running process if its removed half way through or too early?  Users will do some crazy stuff sometimes that just doesn't make any sense.  The 'storescu' command can be killed with a 'ctrl-c'.

If this isn't possible then I appreciate you looking at this for me.

thanks
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi, the only way to do that would be to put a timeout on the storescu process.  I have included a 5 minute timeout here (300 seconds) after which the storescu process will be terminated, and the user will get the message "The import did not complete. Please try again."

Regards,

Rob.

Set objShell = CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
strResponse = vbYes
While strResponse = vbYes
	Call RunTransfer
	'strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD. ", vbOKOnly, "CD Import")
	strResponse = vbYes
Wend
MsgBox "Transfer(s) complete."

Sub RunTransfer
	For Each objDrive In objFSO.Drives
		WScript.sleep 60
		If objDrive.DriveType = 4 Then
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			If objFSO.FileExists("c:\apps\dcm4che-3.3.3-bin\bin\storescu") = True Then
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				Set objExec2 = objShell.Exec("c:\apps\dcm4che-3.3.3-bin\bin\storescu -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt")
				' Timeout in seconds
				intTimeOut = 300
				' Initialise current timer
				intSeconds = 0
				Do While objExec2.Status = 0 And intSeconds <= intTimeOut
				     WScript.Sleep 1000
				     intSeconds = intSeconds + 1
				Loop
				objExec1.Terminate
				objFSO.DeleteFile strHTAFile, True
				If objExec2.Status = 0 Then
					objExec2.Terminate
					MsgBox "The import did not complete. Please try again.", vbOKOnly, "CD Import"
				End If
			Else
				MsgBox "Could not find storescu", vbOKOnly, "File not found"
			End If
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			objShellApp.Namespace(17).ParseName(objDrive.DriveLetter & ":\").InvokeVerb("Eject")
		End If
	Next
End Sub

Sub CreateHTAFile(strFileName)
	strHTML = "<html>" & vbCrLf & _
    "<HTA:APPLICATION" & vbCrLf & _
    "    Caption=""no""" & vbCrLf & _
    ">" & vbCrLf & _
    "<script language = ""VBScript"">" & vbCrLf & _
	"Sub Window_onLoad" & vbCrLf & _
	"    Me.ResizeTo 300,100" & vbCrLf & _
	"    Me.MoveTo ((Screen.Width / 2) - 200),((Screen.Height / 2) - 150)" & vbCrLf & _
	"End Sub" & vbCrLf & _
    "</script>" & vbCrLf & _
    "<body bgcolor='lightblue'>" & vbCrLf & _
    "    <p align='center'><BR>Your CD is now being imported</p>" & vbCrLf & _
    "</body>" & vbCrLf & _
	"</html>" & vbCrLf
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.CreateTextFile(strFileName, True)
	objFile.Write strHTML
	objFile.Close
End Sub

Open in new window

0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   Thanks, this should work out.  Just to be clear, even if 'storescu' is working and reading a CD it will be terminated after 300 seconds?  If so, I could just increase this to 10min maybe.  Storescu has to read every file on the CD to figure out if it is a dicom file or not.   Some outside hospital systems create CDs that have dicom files with .dcm extensions and others with no file extension, and yet others in some other formats.  There is no control, it would be very nice to just tell it to only look for '.xyz' but its not going to happen unfortunately as something might get missed in a trauma situation.

thanks
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Yes, even if it is working correctly, it would terminate.  You can increase the timeout to 600 for 10 minutes.
Doesn't the storescu program die if the CD cannot be read (when it's ejected) though?  I would have thought it would, and the HTA would then disappear because the process has terminated.  If it doesn't though, and it sits there waiting forever, you will need to use this timeout.

One thing I haven't tested....I'm not sure whether .IsReady returns false if the CD is currently being read, or only if a CD isn't present.  You could try changing the Do While loop to this
				Do While objExec2.Status = 0 And intSeconds <= intTimeOut
				     WScript.Sleep 1000
				     If Not objDrive.IsReady Then intSeconds = intTimeOut + 1
				     intSeconds = intSeconds + 1
				Loop

Open in new window


which adds one extra line that says if the drives becomes not ready, quit.  But this may think the drive is not ready just because files are being copied from it, I'm not sure.

Regards,

Rob.
0
 

Author Comment

by:doc_jay
Comment Utility
I can't remember what storescu does when a CD is removed that is working on, I'll have to test.  I do know that I pulled a CD out while the script was running and the only way I could get it to work on a 2nd CD was to kill 'cmd.exe'.

I'll add your '.IsReady' line tomorrow and test it out.

thanks!
0
 

Author Comment

by:doc_jay
Comment Utility
I now get an error when running your latest code.  I have attached a SS of the error.
wcript-error.JPG
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, I can't test with your command, but try changing
				Set objExec2 = objShell.Exec("c:\apps\dcm4che-3.3.3-bin\bin\storescu -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt")

Open in new window


to
				Set objExec2 = objShell.Exec("cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt")

Open in new window


Rob.
0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   That change worked and it now runs.  I tested it again for when a user might eject a CD while the 'storescu' is running.  Then the CD is ejected by the user, the script returns a message, 'The import job did not finish, please try again'.  This part is great, but when a CD is reinserted, it immediately comes back with a message 'Transfer Complete' instead of starting over.

Is there a way to make the script start over after the import job didn't finish because the user ejected the CD early?

Here is the code I'm currently using.

Set objShell = CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
strResponse = vbYes
While strResponse = vbYes
	Call RunTransfer
	'strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD. ", vbOKOnly, "CD Import")
	strResponse = vbYes
Wend
MsgBox "Transfer(s) complete."

Sub RunTransfer
	For Each objDrive In objFSO.Drives
		WScript.sleep 60
		If objDrive.DriveType = 4 Then
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			If objFSO.FileExists("c:\apps\dcm4che-3.3.3-bin\bin\storescu") = True Then
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				Set objExec2 = objShell.Exec("cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt")
				' Timeout in seconds
				intTimeOut = 600
				' Initialise current timer
				intSeconds = 0
				Do While objExec2.Status = 0 And intSeconds <= intTimeOut
				     WScript.Sleep 1000
					 If Not objDrive.IsReady Then intSeconds = intTimeOut + 1
				     intSeconds = intSeconds + 1
				Loop
				objExec1.Terminate
				objFSO.DeleteFile strHTAFile, True
				If objExec2.Status = 0 Then
					objExec2.Terminate
					MsgBox "The import did not complete. Please try again.", vbOKOnly, "CD Import"
				End If
			Else
				MsgBox "Could not find storescu", vbOKOnly, "File not found"
			End If
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			objShellApp.Namespace(17).ParseName(objDrive.DriveLetter & ":\").InvokeVerb("Eject")
		End If
	Next
End Sub

Sub CreateHTAFile(strFileName)
	strHTML = "<html>" & vbCrLf & _
    "<HTA:APPLICATION" & vbCrLf & _
    "    Caption=""no""" & vbCrLf & _
    ">" & vbCrLf & _
    "<script language = ""VBScript"">" & vbCrLf & _
	"Sub Window_onLoad" & vbCrLf & _
	"    Me.ResizeTo 300,100" & vbCrLf & _
	"    Me.MoveTo ((Screen.Width / 2) - 200),((Screen.Height / 2) - 160)" & vbCrLf & _
	"End Sub" & vbCrLf & _
    "</script>" & vbCrLf & _
    "<body bgcolor='lightblue'>" & vbCrLf & _
    "    <p align='center'><BR>Your CD is now being imported.  The CD will eject when finished.</p>" & vbCrLf & _
    "</body>" & vbCrLf & _
	"</html>" & vbCrLf
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.CreateTextFile(strFileName, True)
	objFile.Write strHTML
	objFile.Close
End Sub

Open in new window


Also, on some different code above, I was able to hide the 'cmd' window that windows starts up, but if I now put '), 0, TRUE' after the 'Set objExec2' line the script doesn't run.  I was just wanting to hide the cmd window that 'storescu' is run from.
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
It is very odd that the Transfer Complete message comes up at all.  The logic in the script says that when RunTransfer routine completes, it should say "The import job is finished, please remove your CD/DVD. " and then start RunTransfer again, waiting for the next CD.

In terms of the black box, unfortunately, because we now use the Exec method instead of the Run method, it cannot be hidden, but we need to use Exec to monitor the status, and allow for the timeout.

Do you need the
c:\apps\logs\radtraumacd_send_log.txt

log file?  If not, we could try changing
				Set objExec2 = objShell.Exec("cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt")

Open in new window


to
				Set objExec2 = objShell.Exec("""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e:")

Open in new window


and see whether that shows the black box.

If that still doesn't work, maybe we could go back to the Run method, but obtain the process ID for the new cmd.exe instance, monitor it, and kill that after the timeout.

Regards,

Rob.
0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   I have a feeling that even if we remove the method of writing the output to a log file, it will still show.  If it isn't too much trouble, could we go back to the run method to monitor the process ID?

thank you very much for all of your help!
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, so I spent some time recoding this a bit to check the processes.  See how this goes.

Regards,

Rob.

strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShell = CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
Set dctProcesses = CreateObject("Scripting.Dictionary")
dctProcesses.CompareMode = vbTextCompare
strResponse = vbYes
While strResponse = vbYes
	Call RunTransfer
	'strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")
	strResponse = MsgBox("The import job is finished, please remove your CD/DVD. ", vbOKOnly, "CD Import")
	strResponse = vbYes
Wend
MsgBox "Transfer(s) complete."

Sub RunTransfer
	For Each objDrive In objFSO.Drives
		WScript.sleep 60
		If objDrive.DriveType = 4 Then
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			If objFSO.FileExists("c:\apps\dcm4che-3.3.3-bin\bin\storescu") = True Then
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				' First obtain a list of existing storescu.exe processes so that we can identify the newest one
				dctProcesses.RemoveAll
				Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='storescu.exe'")
				For Each objProcess In colProcess
					'WScript.Echo "Initial: " & objProcess.ProcessId & ": " & objProcess.CommandLine
					dctProcesses.Add objProcess.ProcessId, objProcess.CommandLine
				Next
				objShell.Run "cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt", 0, False
				WScript.Sleep 1000
				' Identify the new process
				Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='storescu.exe'")
				For Each objProcess In colProcess
					'WScript.Echo "New: " & objProcess.ProcessId & ": " & objProcess.CommandLine
					If dctProcesses.Exists(objProcess.ProcessId) = False Then
						intProcessID = objProcess.ProcessId
					End If
				Next
				' Timeout in seconds
				intTimeOut = 600
				' Initialise current timer
				intSeconds = 0
				blnProcessRunning = True
				Do While blnProcessRunning = True And intSeconds <= intTimeOut
					WScript.Sleep 1000
					blnProcessRunning = False
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where ProcessId=" & intProcessID)
					For Each objProcess In colProcess
						blnProcessRunning = True
					Next				     
					If Not objDrive.IsReady Then intSeconds = intTimeOut + 1
					intSeconds = intSeconds + 1
				Loop
				objExec1.Terminate
				objFSO.DeleteFile strHTAFile, True
				If intSeconds > intTimeOut Then
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where ProcessId=" & intProcessID)
					For Each objProcess In colProcess
						objProcess.Terminate()
					Next
					MsgBox "The import did not complete. Please try again.", vbOKOnly, "CD Import"
				End If
			Else
				MsgBox "Could not find storescu", vbOKOnly, "File not found"
			End If
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			objShellApp.Namespace(17).ParseName(objDrive.DriveLetter & ":\").InvokeVerb("Eject")
		End If
	Next
End Sub

Sub CreateHTAFile(strFileName)
	strHTML = "<html>" & vbCrLf & _
    "<HTA:APPLICATION" & vbCrLf & _
    "    Caption=""no""" & vbCrLf & _
    ">" & vbCrLf & _
    "<script language = ""VBScript"">" & vbCrLf & _
	"Sub Window_onLoad" & vbCrLf & _
	"    Me.ResizeTo 300,100" & vbCrLf & _
	"    Me.MoveTo ((Screen.Width / 2) - 200),((Screen.Height / 2) - 160)" & vbCrLf & _
	"End Sub" & vbCrLf & _
    "</script>" & vbCrLf & _
    "<body bgcolor='lightblue'>" & vbCrLf & _
    "    <p align='center'><BR>Your CD is now being imported.  The CD will eject when finished.</p>" & vbCrLf & _
    "</body>" & vbCrLf & _
	"</html>" & vbCrLf
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.CreateTextFile(strFileName, True)
	objFile.Write strHTML
	objFile.Close
End Sub

Open in new window

0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   Very sorry I haven't had time to look at this.  I saw in your code your looking for 'storescu.exe'.  'storescu' is actually just a .bat file that is called (that turns around and calls .jar file) so windows is running a 'cmd.exe'.  There might not be a good way to identify the PID if there are multiple 'cmd.exe' processes running.  I changed it to look for 'cmd.exe' but the results were that it kept crashing on line 54.

thanks for your help on this
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi, sorry I haven't had time to look at this again.  I can test it early next week and see if I can replicate it using cmd.exe.

Did you change both storescu.exe instances to cmd.exe though?  Lines 30 and 38 need to be changed.

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Actually, I did a very quick test using
				objShell.Run "cmd /c notepad", 0, False

Open in new window


instead of storescu, and it seemed to work.

Can you try it again?

Rob.
0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   Thanks for finding my mistake with lines 30 & 38.  The script now runs and it kills 'cmd.exe' as expected!  If I interrupt the job after the .hta file has popped up, it displays a message with 'The import did not complete. Please try again.'  This part is what I would expect.  I then reinsert the CD and click 'okay' and after a very short time, a 2nd message is displayed, 'The import job is finished, please remove your CD/DVD.', but it actually did not read the CD at all again after it was reinserted.  It only popped up the 'finished' message.

I was hoping that the script could start over at after the CD was ejected and reinserted.

thanks for looking at this again!
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
Comment Utility
Hi, so I've now made the RunTransfer a function instead of a sub, so we can tell whether the timeout was reached, and can display the appropriate message, and start again.  I haven't tested it, but see how it goes.

FYI, I have also add strProcessToMonitor so you only need to change that one to change process names.

Regards,

Rob.

strComputer = "."
strProcessToMonitor = "cmd.exe"

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShell = CreateObject ("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
Set dctProcesses = CreateObject("Scripting.Dictionary")
dctProcesses.CompareMode = vbTextCompare
strResponse = vbYes
While strResponse = vbYes
	blnReturnCode = RunTransfer
	If blnReturnCode = True Then
		'strResponse = MsgBox("The import job is finished, please remove your CD/DVD.  Do you want to transfer from another CD?", vbYesNo, "CD Import")
		strResponse = MsgBox("The import job is finished, please remove your CD/DVD. ", vbOKOnly, "CD Import")
	Else
		strResponse = MsgBox("The import did not complete. Please try again.", vbOKOnly, "CD Import")
	End If
	strResponse = vbYes
Wend
MsgBox "Transfer(s) complete."

Function RunTransfer
	Dim blnSuccess
	blnSuccess = False
	For Each objDrive In objFSO.Drives
		WScript.sleep 60
		If objDrive.DriveType = 4 Then
			While Not objDrive.IsReady
				WScript.Sleep 1000
			Wend
			If objFSO.FileExists("c:\apps\dcm4che-3.3.3-bin\bin\storescu") = True Then
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				' First obtain a list of existing storescu.exe processes so that we can identify the newest one
				dctProcesses.RemoveAll
				Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='" & strProcessToMonitor & "'")
				For Each objProcess In colProcess
					'WScript.Echo "Initial: " & objProcess.ProcessId & ": " & objProcess.CommandLine
					dctProcesses.Add objProcess.ProcessId, objProcess.CommandLine
				Next
				objShell.Run "cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e: > c:\apps\logs\radtraumacd_send_log.txt", 0, False
				WScript.Sleep 1000
				' Identify the new process
				Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='" & strProcessToMonitor & "'")
				For Each objProcess In colProcess
					'WScript.Echo "New: " & objProcess.ProcessId & ": " & objProcess.CommandLine
					If dctProcesses.Exists(objProcess.ProcessId) = False Then
						intProcessID = objProcess.ProcessId
					End If
				Next
				' Timeout in seconds
				intTimeOut = 600
				' Initialise current timer
				intSeconds = 0
				blnProcessRunning = True
				Do While blnProcessRunning = True And intSeconds <= intTimeOut
					WScript.Sleep 1000
					blnProcessRunning = False
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where ProcessId=" & intProcessID)
					For Each objProcess In colProcess
						blnProcessRunning = True
					Next				     
					If Not objDrive.IsReady Then intSeconds = intTimeOut + 1
					intSeconds = intSeconds + 1
				Loop
				objExec1.Terminate
				objFSO.DeleteFile strHTAFile, True
				If intSeconds > intTimeOut Then
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where ProcessId=" & intProcessID)
					For Each objProcess In colProcess
						objProcess.Terminate()
					Next
					'MsgBox "The import did not complete. Please try again.", vbOKOnly, "CD Import"
				Else
					blnSuccess = True
				End If
			Else
				MsgBox "Could not find storescu", vbOKOnly, "File not found"
			End If
			If blnSuccess = True Then
				While Not objDrive.IsReady
					WScript.Sleep 1000
				Wend
				objShellApp.Namespace(17).ParseName(objDrive.DriveLetter & ":\").InvokeVerb("Eject")
			End If
		End If
	Next
	RunTransfer = blnSuccess
End Function

Sub CreateHTAFile(strFileName)
	strHTML = "<html>" & vbCrLf & _
    "<HTA:APPLICATION" & vbCrLf & _
    "    Caption=""no""" & vbCrLf & _
    ">" & vbCrLf & _
    "<script language = ""VBScript"">" & vbCrLf & _
	"Sub Window_onLoad" & vbCrLf & _
	"    Me.ResizeTo 300,100" & vbCrLf & _
	"    Me.MoveTo ((Screen.Width / 2) - 200),((Screen.Height / 2) - 160)" & vbCrLf & _
	"End Sub" & vbCrLf & _
    "</script>" & vbCrLf & _
    "<body bgcolor='lightblue'>" & vbCrLf & _
    "    <p align='center'><BR>Your CD is now being imported.  The CD will eject when finished.</p>" & vbCrLf & _
    "</body>" & vbCrLf & _
	"</html>" & vbCrLf
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.CreateTextFile(strFileName, True)
	objFile.Write strHTML
	objFile.Close
End Sub

Open in new window

0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

    I just tried out this new code.  It can rip a CD perfectly from beginning to end.  The only problem is when its interrupted.  

1.   I can start the script, insert the CD and the .hta file is splashed up in front of me.  If I then wait a few seconds and eject the CD with button on my drive, the .hta file disappears at this point and there is no message displayed, only the CD was ejected by pressing the button.

2.   At this point I was hoping to present the user with the message 'The import did not complete.  Please try again.'.

3.   I then reinserted the CD and it gave me the message, 'The import did not complete.  Please try again.' and it ejects the CD on its own.  AT this point it did not read the CD after it was reinserted.

4.    Next, I inserted the CD for the 2nd time, the script starts from the beginning as if its a new CD and will finish the job.

  Its almost there, I just want the users to know that the import didn't finish because they ejected the CD early.  Also, they will not want to insert the CD twice if they ejected it early on accident the first time.

thanks
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Oh I see the problem.  After a failure (ie the CD was ejected early), it was waiting for the CD drive to become ready again before ejecting it at the end.  I have skipped that eject if the import failed.

I have amended the code in comment ID 40348442, so you can copy that code again and give it a shot.

Rob.
0
 

Author Comment

by:doc_jay
Comment Utility
Rob,

   Just tested it out and it worked out great!  thank you!
0
 

Author Closing Comment

by:doc_jay
Comment Utility
Excellent expert here @ EE.  He is very helpful and follows through until the end!  Very easy to work with as well.

thanks!
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Good to hear!  Thanks for the grade.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now