1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
'BEGIN DESCRIPTION
'This script executes the DOS command (that could also be a batch file) given as parameter 
'in the SCRIPT command, and waits until the DOS command finishes its execution: the script 
'ends when the launched DOS command terminates.
'The path where the DOS command will be executed is the active path.

'ASSUMPTIONS
	'The script must be invoked from syntax with the SCRIPT command, giving for parameter 
	'the DOS command to execute:
	'	SCRIPT "DOS.Sbs" ("<DosCommand>").
	'replacing <DosCommand> with the DOS command to execute.

'EFFECTS
	'Run a DOS command waiting for the end of its execution. 
	'The DOS command could be also a batch file.
	
'SPSS 8

'Author: Fabrizio Arosio (spss-scripts@go.to)
'        http://go.to/spss-scripts

Option Explicit

Private Const SYNCRONIZE=&H100000, INFINITE=-1&

'Declare Win32 API functions
Declare Function OpenProcess Lib "kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long

Sub WaitExecution(ByVal ProgramName As String)
'Run the application specified by ProgramName and wait until the end of its
'execution.
Dim PID	As Long, hProcess As Long
	On Error GoTo ShellErr
	PID=Shell(ProgramName,vbNormalFocus)
	On Error GoTo 0
	hProcess=OpenProcess(SYNCRONIZE,0,PID)
	If hProcess<>0 Then
		WaitForSingleObject hProcess, INFINITE
		CloseHandle hProcess
	End If
	Exit Sub
ShellErr:
	MsgBox "Error starting task "+ProgramName + vbCrLf + Err.Description
	Exit All
End Sub

Sub DOS(ByVal Path As String, ByVal DOSCommand As String)
'Launch the DOS command specified by the parameter DOSCommand and wait until its execution
'ends.
'Path parameter specifies the path to set before running the DOSCommand, If Path="", then
'the active path will be used.
	If Trim(Path)<>"" Then
		ChDir Path
	End If
	WaitExecution "COMMAND.COM /c "+DOSCommand
End Sub

Sub Main()
Dim Cmd As String
	Cmd=objSpssApp.ScriptParameter(0)	
	If Cmd<>"" Then
		DOS "",Cmd
	End If
End Sub