• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 162
  • Last Modified:

Add functionality to existing .vbs to read stndout from a directory file?

In this existing code below:

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


I would like to use a tool named 'dcmdir' that is in the same location as 'storescu' which is:

c:\apps\dcm4che-3.3.3-bin\bin\

Open in new window


I need to call a file named 'DICOMDIR' that will be on the root of my 'E:' drive and dump the contents of this directory file with the '-l' switch like:

c:\apps\dcm4che-3.3.3-bin\bin\dcmdir -l e:\DICMDIR

Open in new window


in the output of that file, the only lines that are of any value begin with '(0004,1500)' each time, but it is what's within the brackets that is of most importance.  In this example it is:

[000\000\000\897\1229\5847\184483]

Open in new window


I don't need the brackets at all of course, but only what is between them.  The file in the path above, '184483' is what I need to inject into a command call in the script I posted above.  This will need to happen for each file that is found in the output from 'dcmdir'.

For example:  In the path for the file '184483' above I would call the 'storescu' command in the script above as:

c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost e:\000\000\000\897\1229\5847\184483 > c:\apps\logs\radtraumacd_send_log.txt

Open in new window


This would need to happen for each file found in the output of 'dcmdir' after it read the contents of the directory file 'DICOMDIR'.

Thank you
dcmdir-output.txt
0
doc_jay
Asked:
doc_jay
  • 13
  • 11
1 Solution
 
RobSampsonCommented:
Hi, I have a question.

When you run
c:\apps\dcm4che-3.3.3-bin\bin\dcmdir -l e:\DICMDIR

Where does the output file called dcmdir-output.txt get stored?  Is it automatically stored in the c:\apps\dcm4che-3.3.3-bin\bin\ folder?

Rob.
0
 
doc_jayAuthor Commented:
Rob,

   it can be run like:
c:\apps\dcm4che-3.3.3-bin\bin\dcmdir -l e:\DICOMDIR > output.txt

in the example above, the file 'output.txt' would end up in the 'c:\apps\dcm4che-3.3.3-bin\bin' folder.  It can be named whatever you would like to call it.

thanks
0
 
RobSampsonCommented:
Alright, so I've reworked this a fair bit again ;-)

What it now does is this:
 - Check if storescu.exe and dcmdir.exe exist
 - Then if <DRIVE>:\DCOMDIR exists *as a file* it exports the dcmdir output to the file specified by
       strDCMOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "dcomdir-output.txt"
 - If that file exists, all paths are output to a batch file to run consecutive storescu.exe commands
 - If that file doesn't exist, the original storescu.exe command is output to a batch file
 - The process that is monitored is now the batch file
 - Once that finishes, the program ejects the disc

I had to make it run a batch file now, because otherwise monitors multiple successive storescu.exe commands was going to be hit and miss.

Hopefully it all works, it's getting to a point that is hard to test, so you'll have to be my guinea pig ;-)

Regards,

Rob.

strComputer = "."
strProcessToMonitor = "cmd.exe"
strStorescuExe = "c:\apps\dcm4che-3.3.3-bin\bin\storescu"
strDcmdirExe = "c:\apps\dcm4che-3.3.3-bin\bin\dcmdir"
strCDDICOMDIRFile = "<DRIVE>:\DICOMDIR"
strDCMOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "dcomdir-output.txt"
strTempBatchFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "RunStorescu.bat"

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(strStorescuExe) = True And objFSO.FileExists(strDcmdirExe) = True Then
				' Show the HTA and wait for the process to finish
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				' If the DICOMDIR file exists and write the temp batch file for storescu
				Set objBatch = objFSO.CreateTextFile(strTempBatchFile, True)
				If objFSO.FileExists(Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter)) = True Then
					strCommand = "cmd /c """ & strDcmdirExe & """ -l " & Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & " > """ & strDCMOutputFile & """"
					objShell.Run strCommand, 0, True
					Set objDCMOutput = objFSO.OpenTextFile(strDCMOutputFile, 1, False)
					While Not objDCMOutput.AtEndOfStream
						strLine = objFile.ReadLine
						If InStr(strLine, "ReferencedFileID") > 0 Then
							If InStr(strLine, "[") > 0 And InStr(strLine, "]") > 0 Then
								strFilePath = Mid(strLine, InStr(strLine, "[") + 1)
								strFilePath = Left(strFilePath, InStr(strFilePath, "]") - 1)
								strCommand = "cmd /c """ & strStorescuExe & """ -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ":\" & strFilePath & " >> c:\apps\logs\radtraumacd_send_log.txt"
								objBatch.WriteLine strCommand
							End If
						End If
					Wend
					objDCMOutput.Close
				Else
					strCommand = "cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ": >> c:\apps\logs\radtraumacd_send_log.txt"
					objBatch.WriteLine strCommand
				End If
				objBatch.Close
				' 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
				' Run the command
				strCommand = "cmd /c " & strTempBatchFile
				objShell.Run strCommand, 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 or dcmdir", 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
	If objFSO.FileExists(strDCMOutputFile) = True Then objFSO.DeleteFile strDCMOutputFile, True
	If objFSO.FileExists(strTempBatchFile) = True Then objFSO.DeleteFile strTempBatchFile, True
	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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
doc_jayAuthor Commented:
Rob,
 
    I just tried out the code and it errors on

Line:  47
Char: 6
Error:  File not found
Code:  800A0035

I looked in the folder where the .hta file and 'RunStorescu.bat' file are created.  The .hta file has code inside of it while the .bat file was empty.  There also was no 'dcomdir-output.txt'.  I'm guessing that maybe since the 'dcomdir-output.txt' didn't exist, that is why it came back with 'file not found'?
0
 
RobSampsonCommented:
OK, it must not be running the dcmdir command properly.

Under this line (line 45 above):
					strCommand = "cmd /c """ & strDcmdirExe & """ -l " & Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & " > """ & strDCMOutputFile & """"

Open in new window


can you put this
WScript.Echo strCommand

Open in new window


and see if that command looks fine, and work manually for you?

Rob.
0
 
doc_jayAuthor Commented:
Rob,

I've attached the output that was displayed to me.  I needed to change the paths slightly so that I could test it.  Looks like the '-l' switch and the path to the dicomdir 'e:\DICOMDIR' need to be in the quotes as well possibly?

thanks
script.jpg
0
 
RobSampsonCommented:
Ok, so try
                              strCommand = "cmd /c """ & strDcmdirExe & """ -l """ & Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & """ > """ & strDCMOutputFile & """"

But also, you can copy that command when you see it, remove the cmd /c and then paste that directly into a command prompt to test it manually. It should work though, it's not a complex command.

Rob.
0
 
doc_jayAuthor Commented:
Rob,

 --Guinea Pig reporting in --

   I went into error again on line 47.  I copied the command that was displayed to me after I inserted 'WScript.Echo strCommand' after line 47 into a cmd prompt.  It generated the output file correctly.  

It looks as if its failing the check on line 44.  I changed it to 'False' like

If objFSO.FileExists(Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter)) = False Then

Open in new window


 and it read the CD the old fashioned way that is under your 'ELSE' line and finished.

thanks
0
 
doc_jayAuthor Commented:
Rob,

    I manually created a 'dcomdir-output.txt' file with the 'dcmdir' command and placed it in the same location as where the script is being run from.  It gets down to line 50 with the error 'Object required:  'objFile'.

I've attached a screen shot of the error for you.

I also still have the echo command in place from earlier.

Maybe I'm getting somewhere or I could just be causing it to error in different ways.  :-P
error-line50.JPG
0
 
RobSampsonCommented:
OK, I think what may be happening, if it worked when you copied it manually, is that the dcmdir.exe command is firing off another process instead of the cmd.exe waiting for it to finish, just like storescu.exe does.  In this revision, I have tried monitoring that process again to make sure it finishes before checking for the output file.

Rob.

strComputer = "."
strProcessToMonitor = "cmd.exe"
strStorescuExe = "c:\apps\dcm4che-3.3.3-bin\bin\storescu"
strDcmdirExe = "c:\apps\dcm4che-3.3.3-bin\bin\dcmdir"
strCDDICOMDIRFile = "<DRIVE>:\DICOMDIR"
strDCMOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "dcomdir-output.txt"
strTempBatchFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "RunStorescu.bat"

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(strStorescuExe) = True And objFSO.FileExists(strDcmdirExe) = True Then
				' Show the HTA and wait for the process to finish
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				' If the DICOMDIR file exists and write the temp batch file for storescu
				Set objBatch = objFSO.CreateTextFile(strTempBatchFile, True)
				If objFSO.FileExists(Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter)) = True Then
					' 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
					strCommand = "cmd /c """ & strDcmdirExe & """ -l """ & Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & """ > """ & strDCMOutputFile & """"
					objShell.Run strCommand, 0, True
					' 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
					blnProcessRunning = True
					Do While blnProcessRunning = True
						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				     
					Loop
					' Now read the output file
					If objFSO.FileExists(strDCMOutputFile) = True Then
						Set objDCMOutput = objFSO.OpenTextFile(strDCMOutputFile, 1, False)
						While Not objDCMOutput.AtEndOfStream
							strLine = objDCMOutput.ReadLine
							If InStr(strLine, "ReferencedFileID") > 0 Then
								If InStr(strLine, "[") > 0 And InStr(strLine, "]") > 0 Then
									strFilePath = Mid(strLine, InStr(strLine, "[") + 1)
									strFilePath = Left(strFilePath, InStr(strFilePath, "]") - 1)
									strCommand = "cmd /c """ & strStorescuExe & """ -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ":\" & strFilePath & " >> c:\apps\logs\radtraumacd_send_log.txt"
									objBatch.WriteLine strCommand
								End If
							End If
						Wend
						objDCMOutput.Close
					Else
						WScript.Echo "Unable to find output file " & vbCrLf & "generated by" & strCommand
					End If
				Else
					strCommand = "cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ": >> c:\apps\logs\radtraumacd_send_log.txt"
					objBatch.WriteLine strCommand
				End If
				objBatch.Close
				' 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
				' Run the command
				strCommand = "cmd /c " & strTempBatchFile
				objShell.Run strCommand, 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 or dcmdir", 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
	If objFSO.FileExists(strDCMOutputFile) = True Then objFSO.DeleteFile strDCMOutputFile, True
	If objFSO.FileExists(strTempBatchFile) = True Then objFSO.DeleteFile strTempBatchFile, True
	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
 
doc_jayAuthor Commented:
Rob,
   
    Error on line 67.  

'For Each objProcess In colProcess'

FWIW - I've never seen it yet create the "dcomdir-output.txt" file.
0
 
RobSampsonCommented:
Hmmm, if you delete the output file from the script folder, then run this, does the output file exist?
strComputer = "."
strProcessToMonitor = "cmd.exe"
strStorescuExe = "c:\apps\dcm4che-3.3.3-bin\bin\storescu"
strDcmdirExe = "c:\apps\dcm4che-3.3.3-bin\bin\dcmdir"
strCDDICOMDIRFile = "<DRIVE>:\DICOMDIR"
strDCMOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "dcomdir-output.txt"
strTempBatchFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "RunStorescu.bat"

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(strStorescuExe) = True And objFSO.FileExists(strDcmdirExe) = True Then
				' Show the HTA and wait for the process to finish
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				' If the DICOMDIR file exists and write the temp batch file for storescu
				Set objBatch = objFSO.CreateTextFile(strTempBatchFile, True)
				If objFSO.FileExists(Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter)) = True Then
					' 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
					strCommand = "cmd /c """ & strDcmdirExe & """ -l """ & Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & """ > """ & strDCMOutputFile & """"
					objShell.Run strCommand, 0, True
					' Identify the new process
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='" & strProcessToMonitor & "'")
					intProcessID = Null
					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
					If Not IsNull(intProcessID) Then
						blnProcessRunning = True
						Do While blnProcessRunning = True
							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				     
						Loop
					End If
					' Now read the output file
					If objFSO.FileExists(strDCMOutputFile) = True Then
						Set objDCMOutput = objFSO.OpenTextFile(strDCMOutputFile, 1, False)
						While Not objDCMOutput.AtEndOfStream
							strLine = objDCMOutput.ReadLine
							If InStr(strLine, "ReferencedFileID") > 0 Then
								If InStr(strLine, "[") > 0 And InStr(strLine, "]") > 0 Then
									strFilePath = Mid(strLine, InStr(strLine, "[") + 1)
									strFilePath = Left(strFilePath, InStr(strFilePath, "]") - 1)
									strCommand = "cmd /c """ & strStorescuExe & """ -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ":\" & strFilePath & " >> c:\apps\logs\radtraumacd_send_log.txt"
									objBatch.WriteLine strCommand
								End If
							End If
						Wend
						objDCMOutput.Close
					Else
						WScript.Echo "Unable to find output file " & vbCrLf & "generated by" & strCommand
					End If
				Else
					strCommand = "cmd /c ""c:\apps\dcm4che-3.3.3-bin\bin\storescu"" -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ": >> c:\apps\logs\radtraumacd_send_log.txt"
					objBatch.WriteLine strCommand
				End If
				objBatch.Close
				' 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
				' Run the command
				strCommand = "cmd /c " & strTempBatchFile
				objShell.Run strCommand, 0, False
				WScript.Sleep 1000
				' Identify the new process
				Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='" & strProcessToMonitor & "'")
				intProcessID = Null
				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 or dcmdir", 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
	If objFSO.FileExists(strDCMOutputFile) = True Then objFSO.DeleteFile strDCMOutputFile, True
	If objFSO.FileExists(strTempBatchFile) = True Then objFSO.DeleteFile strTempBatchFile, True
	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
 
doc_jayAuthor Commented:
Rob,

   It came back with 'unable to find output file generated by cmd' & then it displayed the 'dcmdir' command that it is supposed to use to read the 'E:\DICOMDIR' file.
0
 
RobSampsonCommented:
Is the command it shows exactly what works at a manual command prompt (without the cmd /c)?
0
 
doc_jayAuthor Commented:
Rob,
 
   Yes, the command displayed should work fine.  I've attached another SS.   I had to change some of the paths around for testing purposes.

EDIT:  just tested the cmd from the error prompt displayed and it generated the 'dcomdir-output.txt' file correctly.
unable-to-find-output.JPG
0
 
RobSampsonCommented:
That doesn't seem to make sense.  If you need to change the file paths when pasting the command into the command prompt, I recommend you change the paths at
strStorescuExe = "c:\apps\dcm4che-3.3.3-bin\bin\storescu"
strDcmdirExe = "c:\apps\dcm4che-3.3.3-bin\bin\dcmdir"

instead, and make sure that works exactly as it is shown.  I'm not sure what I'm missing here....I will try to test with some other commands...

Rob.
0
 
doc_jayAuthor Commented:
Okay- I'll change my side so that the tools live in 'c:\apps\dcm4che-3.3.3-bin\bin\'

-sorry for the confusion
0
 
doc_jayAuthor Commented:
Rob,

   Just testing out the code from ID: 40353765.  I have changed the paths on my side so that the tools live in 'C:\apps\dcm4che-3.3.3-bin\bin\'

It still came back with the same error as before - 'Unable to find the output file generated by'

To be clear earlier, I was changing the paths at the top of the code for the 'str' variables.   I just want you to know that I'll be using the same paths as you from now on so you can be sure that the script can find the tools needed to run properly.

thanks
unable-to-find-output2.JPG
0
 
doc_jayAuthor Commented:
Rob,

   Just doing some more testing on this end before I lay down for the night.  
I manually created the 'dcomdir-output.txt' again and placed it in the folder I am running the script from.  I then ran your code from message ID: 40353765 and it completed successfully!  It actually only did inject ONE file path into the 'storescu' cmd where the 'dcomdir-output.txt' actually had over 1700 paths for the script to find.  This would be one for every image on the CD, and this CD that I am testing has 5 exams on it with a total of 1770 images.

  One step closer  :)

Jamie
0
 
RobSampsonCommented:
Alright.  I think the only thing I can do now is replicate what dcmdir and storescu do using some custom scripts, and test it with those in their place.  I will work on building those test scripts later this evening, or tomorrow morning.

Rob.
0
 
RobSampsonCommented:
OK, one question I have while I'm writing the test scripts.....is the
E:\DICOMDIR
that we're passing to dcmdir a file or a folder?
0
 
doc_jayAuthor Commented:
it is a file
0
 
RobSampsonCommented:
OK, just making sure, so I know how to write my test scripts.

So, after a lot of testing, and trying to replicate things, I'm hoping I have it right.  Give this a try.  There will be a few outputs, so to run it, open a command prompt, and run
cscript C:\<Path>\ImportFile.vbs

strComputer = "."
strProcessToMonitor = "cmd.exe"
strStorescuExe = "c:\apps\dcm4che-3.3.3-bin\bin\storescu"
strDcmdirExe = "c:\apps\dcm4che-3.3.3-bin\bin\dcmdir"
strCDDICOMDIRFile = "<DRIVE>:\DICOMDIR"
strDCMOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "dcomdir-output.txt"
strSendLog = "c:\apps\logs\radtraumacd_send_log.txt"

Set dctBatch = CreateObject("Scripting.Dictionary")
dctBatch.CompareMode = vbTextCompare
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
	dctBatch.RemoveAll
	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(strStorescuExe) = True And objFSO.FileExists(strDcmdirExe) = True Then
				' Show the HTA and wait for the process to finish
				strHTAFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "TempHTA.hta"
				CreateHTAFile strHTAFile
				Set objExec1 = objShell.Exec("mshta.exe """ & strHTAFile & """")
				' If the DICOMDIR file exists then store the batch commands for storescu
				If objFSO.FileExists(Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter)) = True Then
					' 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
					strCommand = "cmd /c """ & strDcmdirExe & """ -l """ & Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & """ > """ & strDCMOutputFile & """"
					WScript.Echo "Running command 1:" & strCommand
					objShell.Run strCommand, 0, True
					' Identify the new process
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='" & strProcessToMonitor & "'")
					intProcessID = Null
					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
					If Not IsNull(intProcessID) Then
						blnProcessRunning = True
						Do While blnProcessRunning = True
							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				     
						Loop
					End If
					' Now read the output file
					If objFSO.FileExists(strDCMOutputFile) = True Then
						Set objDCMOutput = objFSO.OpenTextFile(strDCMOutputFile, 1, False)
						While Not objDCMOutput.AtEndOfStream
							strLine = objDCMOutput.ReadLine
							If InStr(strLine, "ReferencedFileID") > 0 Then
								intRefPos = InStr(strLine, "[") > 0 And InStr(strLine, "]")
								If intRefPos > 0 Then
									intStartPos = InStrRev(strLine, "[", intRefPos, vbTextCompare)
									strFilePath = Mid(strLine, intStartPos + 1)
									strFilePath = Left(strFilePath, InStr(strFilePath, "]") - 1)
									strCommand = "cmd /c """ & strStorescuExe & """ -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ":\" & strFilePath & " >> " & strSendLog
									WScript.Echo "Storing command to run: " & strCommand
									dctBatch.Add strCommand, 0
								End If
							End If
						Wend
						objDCMOutput.Close
					Else
						WScript.Echo "Unable to find output file generated by" & vbCrLf & strCommand
					End If
				Else
					WScript.Echo Replace(strCDDICOMDIRFile, "<DRIVE>", objDrive.DriveLetter) & " does not exist."
					strCommand = "cmd /c """ & strStorescuExe & """ -c RADTRAUMACD@LOCALHOST:104 -s 00080050=OUT 00100021=HOSP -b ERCD@localhost " & objDrive.DriveLetter & ": >> " & strSendLog
					WScript.Echo "Storing command to run: " & strCommand
					dctBatch.Add strCommand, 0
				End If
				' 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
				' Run each of the commands
				For Each strCommand In dctBatch
					WScript.Echo "Running batch command: " & strCommand
					objShell.Run strCommand, 0, True
					WScript.Sleep 1000
					' Identify the new process
					Set colProcess = objWMIService.ExecQuery ("Select ProcessId, CommandLine from Win32_Process Where Name='" & strProcessToMonitor & "'")
					intProcessID = Null
					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
					If intProcessID <> "" Then
						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
						If intTimeOut > intSeconds Then Exit For
					End If
				Next
				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 or dcmdir", 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
	If objFSO.FileExists(strDCMOutputFile) = True Then objFSO.DeleteFile strDCMOutputFile, True
	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
 
doc_jayAuthor Commented:
Working great, thanks!
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 13
  • 11
Tackle projects and never again get stuck behind a technical roadblock.
Join Now