Solved

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

Posted on 2014-09-28
24
138 Views
Last Modified: 2014-10-03
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
Comment
Question by:doc_jay
  • 13
  • 11
24 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 40349151
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
 

Author Comment

by:doc_jay
ID: 40349166
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40349304
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
 

Author Comment

by:doc_jay
ID: 40349951
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40351190
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
 

Author Comment

by:doc_jay
ID: 40351973
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40351987
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
 

Author Comment

by:doc_jay
ID: 40352142
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
 

Author Comment

by:doc_jay
ID: 40352983
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40353684
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
 

Author Comment

by:doc_jay
ID: 40353751
Rob,
   
    Error on line 67.  

'For Each objProcess In colProcess'

FWIW - I've never seen it yet create the "dcomdir-output.txt" file.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 40353765
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:doc_jay
ID: 40353773
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40353786
Is the command it shows exactly what works at a manual command prompt (without the cmd /c)?
0
 

Author Comment

by:doc_jay
ID: 40353802
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40353820
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
 

Author Comment

by:doc_jay
ID: 40353829
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
 

Author Comment

by:doc_jay
ID: 40353840
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
 

Author Comment

by:doc_jay
ID: 40353861
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40353881
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 40356191
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
 

Author Comment

by:doc_jay
ID: 40356218
it is a file
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 40356259
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
 

Author Comment

by:doc_jay
ID: 40360811
Working great, thanks!
0

Featured Post

What Security Threats Are You Missing?

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

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…
When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

757 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

21 Experts available now in Live!

Get 1:1 Help Now