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
'ОПИСАНИЕ
'Скрпит вызывает на выполнение команду DOS (если их много, их можно поместить в .bat-файл), которая
'передаётся ему в качестве параметра при вызове скрипта из синтаксиса и ждёт конца её выполнения.
'Скрипт завершает свою работу когда вызванная команда DOS завершает свою работу.
'Активным (текущим) путём (папкой) является папка, в которой будет выполняться команда DOS

'ПРАВИЛА ВЫЗОВА
	'Скрипт должен быть вызван из синтаксиса командой SCRIPT с указанием в качестве параметра
	'нужной команды DOS:
	'	SCRIPT "DOS.Sbs" ("<КомандаDOS>").
	'т.е. вместо <КомандаDOS> надо подставить нужную команду.

'ДЕЙСТВИЯ
	'Запускает на выполнение команду DOS и ждёт конца её выполнения.
	'Команды DOS могут находиться в пакетном (batch) файле.
	
'Испытано на версии: SPSS 8

'Автор: Fabrizio Arosio (spss-scripts@go.to)
'        http://go.to/spss-scripts

'КОНЕЦ ОПИСАНИЯ

Option Explicit

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

'Объявим API-функции Win32
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)
'Запустим приложение, указанное в ProgramName и подождём завершения его работы.
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 "Ошибка запуска приложения "+ProgramName + vbCrLf + Err.Description
	Exit All
End Sub

Sub DOS(ByVal Path As String, ByVal DOSCommand As String)
'Запускаем команду DOS с параметром DOSCommand и ждём завершения её работы.
'Параметр Path указывает папку, которую нужно сделать текущей перед выполнением команды DOSCommand.
'Если Path="", выполняем команду в текущей папке, какой бы она ни была.
	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