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
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
'Начало описания
' При вызове скриптов из синтаксиса в SPSS существует проблема синхронизации,
' заключающаяся в том, что скрипты выполняются после завершения выполнения ВСЕГО файла синтаксиса,
' в результате чего скрипты делают на то, что от них ожидается.
' Этот скрипт пытается решить проблему. Он читает синтаксис из активного окна
' синтаксиса и передаёт его SPSS на выполнение. В случае, если встречается вызов команды SCRIPT,
' она немедленно выполняется
' Организацией выполнения синтаксиса управляет скрипт, не SPSS. Поэтому
' синтаксис, содержащий вызов скриптов, должен быть запущен на выполнение этим скриптом.
' Команды INCLUDE, которые могут встречаться в синтаксисе, также поддерживаются.
' Как только завершается выполнение синтаксиса, подключаемого через INCLUDE, возобновляется
' выполнение текущего. Поддерживаются также вложенные вызовы INCLUDE. Количество уровней вызова
' ограничивается лишь располагаемым скриптом объёмом оперативной памяти.
' Таким же образом, команды SCRIPT, встречающиеся в синтаксисе, вызванном через INCLUDE,
' немедленно выполняются.
' Скрипт работает как интерпретатор. Он прочитывает каждую строку синтаксиса и, как только
' встречает вызов SCRIPT или INCLUDE, предпринимает соответствующие действия.
' Команды, не распознаваемые скриптом, оставляются для обработки процессору SPSS.
'Конец описания

'УСЛОВИЯ И ОГРАНИЧЕНИЯ
	'Требуется открытое окно редактора. Скрипт при запуске выполняет код из активного окна.
	'Параметры, передаваемые командой SCRIPT, передаются в вызываемый скрипт,
	'однако последний может обращаться к ним с помощью функции Command$ вместо обычного метода
	'objSpssApp.ScriptParameter().
	'Команды SCRIPT или INCLUDE, встречающиеся в теле макроса (т.е.
	'внутри структуры DEFINE - !ENDDEFINE), игнорируются и не обрабатываются. Прочие команды
	'внутри макросов обрабатываются как обычно.
	
'РЕЗУЛЬТАТ
	'Скрипт синхронизирует обработку вызываемого скрипта с вызывающим синтаксисом.
	'Теперь команды SCRIPT выполняются немедленно в том месте синтаксиса, где они встретились.

'SPSS 7.5 (проверено только в версии SPSS 10)
	
'Автор: Fabrizio Arosio  (spss-scripts@go.to)
'        http://go.to/spss-scripts
'См. также скрипт SyntaxScript2.sbs, который исправляет одну неточность данного скрипта.
Option Explicit

Const CMD_TERMINATOR="."
Const MIN_CHARS_ID=3
Const CMD_SCRIPT="SCR", CMD_INCLUDE="INC", CMD_DEF1="DEF", CMD_DEF2="!DEF", CMD_ENDDEFINE="!ENDDEFINE"

Function FileExists(ByVal FileName As String) As Boolean
'ОПИСАНИЕ
'  Проверяет наличие файла
'ПАРАМЕТРЫ
'  FileName (входной): имя файла для проверки его существования
'РЕЗУЛЬТАТ
'  Истина, если файл FileName существует; Иначе - Ложь
Dim d As Date
	On Error Resume Next
	d=FileDateTime(FileName)
	FileExists= (Err=0)
	On Error GoTo 0
End Function

Sub GetTokens(ByVal Txt As String, ByVal TokSep As String, ByRef Tokens() As String, _
			  ByRef TokensPos() As Integer)
'ОПИСАНИЕ
'  Делит строку Txt на маркеры и помещает их в массив Tokens().
'  Маркером считается элемент строки, заключённый между символами-разделителями маркеров (из строки TokSep).
'  Маркер сам по себе не содержит символов из строки TokSep.
'
'ПАРАМЕТРЫ
'  Txt         (входящий)  : текстовая строка из которой извлекаются маркеры.
'  TokSep      (входящий) 	: строка с символами-разделителями маркеров.
'  Tokens()    (исходящий) : массив с найденными маркерами.
'  TokensPos() (исходящий) : массив, содержащий номера символов, с которых начинается маркер в строке Txt.
Dim i As Integer, Ch As String*1
Dim NewToken As Boolean, NTokens As Integer
	Erase Tokens, TokensPos
	NewToken=True
	NTokens=-1
	For i=1 To Len(Txt)
		Ch=Mid(Txt,i,1)
		If InStr(TokSep,Ch)=0 Then
			If NewToken Then				
				NTokens=NTokens+1
				ReDim Preserve Tokens(0 To NTokens) As String
				ReDim Preserve TokensPos(0 To NTokens) As Integer
				NewToken=False
				TokensPos(NTokens)=i
			End If
			Tokens(NTokens)=Tokens(NTokens)+Ch
		Else
			NewToken=True
		End If
	Next i
End Sub

Function GetUnquotedText(ByVal Txt As String) As String
'ОПИСАНИЕ
'  Возвращает текст из параметра Txt без кавычек слева и справа.
'  Если текст некорретно (несимметрично и т.д.) закавычен, возвращается пустая строка.
'ПАРАМЕТРЫ
'  Txt (входящий): строка, содержащая текст, заключённая в кавычки
'               Первый символ должен быть " или '.
'РЕЗУЛЬТАТ
'  Текст из параметра Txt без окружающих его кавычек.
'  Пустая строка, если Txt неправильно закавычен.
'  Если кавычки дублируются, текст возвращается без дублирующих кавычек.
'  Например:
'                Txt             |     возвращается          |        комментарий
'    "There's a "quoted"" test"  | There's a "quoted" test   |  "" -> "
'    'There's a "quoted"" test'  | There's a "quoted"" test  |  '' -> '
'    'There''s a "quoted"" test' | There's a "quoted"" test  |  '' -> '
Dim Quote As String*1
Dim i As Integer, Out As String
	Select Case Left(Txt,1)
	Case """"
		Quote=""""
	Case "'"
		Quote="'"
	Case Else
		GetUnquotedText=""
		Exit Function
	End Select
	If Right(Txt,1)=Quote Then
		Out=""
		i=2
		Do
			If Mid(Txt,i,2)=String(2,Quote) Then  'дублирующий символ кавычек
				Out=Out+Quote   'оставляем только одну кавычку
				i=i+2
			Else
				Out=Out+Mid(Txt,i,1)
				i=i+1
			End If
		Loop Until i>(Len(Txt)-1)
		GetUnquotedText=Out
	Else
		GetUnquotedText=""
		Exit Function		
	End If
End Function

Function GetUnquotedTextLines(Lines() As String)
'ОПИСАНИЕ
'  Возвращает текстовые строки из массива Lines() без кавычек.
'  Если строка из массива Lines() некорректно (несимметрично и т.д.) заключена в кавычки,
'  возвращается пустая строка. Обрабатываются обычные (") и одинардные (') кавычки.
'  Каждая строка, продолжающаяся на следующей строке (кроме последней), должны иметь символ "+"
'  на конце, чтобы обозначить это. Иначе возвращается пустая строка.
'  Пустиые строки игнорируются.
'ПАРАМЕТРЫ
'  Lines() (входящий): массив строк, элементы которого - строки, заключенные в кавычки.
'РЕЗУЛЬТАТ
'  Все текстовые строки из массива Lines() объединяются в одну строку без кавычек.
'  См. также функцию GetUnquotedText.
'  Возвращается пустая строка если элементы массива Lines() некорректно закавычены
'  или нет символа продолжения строки (+) в каждой из строк кроме последней.
Dim i As Integer, N As Integer
Dim Txt As String, Out As String
	N=UBound(Lines)
	Out=""
	For i=0 To N
		Txt=TabTrim(Lines(i))
		If Txt<>"" Then
			If i<N Then
				If Right(Txt,1)<>"+" Then
					GetUnquotedTextLines=""
					Exit Function
				End If
				'убираем символ +
				Txt=Trim(Left(Txt,Len(Txt)-1))
			End If
			Txt=GetUnquotedText(Txt)
			If Txt="" Then Exit Function
			Out=Out+Txt
		End If
	Next i
	GetUnquotedTextLines=Out
End Function

Function TrimEx(ByVal Txt As String, ByVal CharsToRemove As String) As String
'ОПИСАНИЕ
'  Возвращает строку Txt с удалёнными справа и слева символами, содержащимися в
'  списке удаляемых символов (строке CharsToRemoved).
'  Расширяет стандартную функцию Trim возможностью удаления символов из строки CharsToRemove.
'
'ПАРАМЕТРЫ
'  Txt           (входящий): строка, в которой нужно избавиться от лишних символов справа и слева
'  CharsToRemove (входящий): строка, содержащая список удаляемых символов
'РЕЗУЛЬТАТ
'  Строка Txt без символов из строки CharsToRemove справа и слева.
Dim i As Integer, CharToTrash As String*1
Dim Out As String, AnyRemoved As Boolean, Removed As Boolean

	Out=Txt
	
	Do
		AnyRemoved=False
		For i=1 To Len(CharsToRemove)
			CharToTrash=Mid(CharsToRemove,i,1)
			If CharToTrash<>" " Then
				'удаляем все начальные и конечные символы, которые присутствуют в CharToTrash
				Do
					Removed=False
				
					'удаляем первый/последний символы, которые имеются в CharToTrash, если таковые наличествуют в Txt
					If Left(Out,1)=CharToTrash Then
						Removed=True
						Out=Mid(Out,2)
					End If
					If Right(Out,1)=CharToTrash Then
						Removed=True
						Out=Left(Out,Len(Out)-1)
					End If
					AnyRemoved=AnyRemoved Or Removed
				Loop While Removed 'повторяем пока не останется символов для удаления справа и слева
			Else
				'удаляем пробелы справа и слева
				Txt=Trim(Out)
				AnyRemoved=AnyRemoved Or Txt<>Out
				Out=Txt
			End If
		Next i
	Loop While AnyRemoved 'повторяем пока в очередном цикле из строки ничего не удаляется
	TrimEx=Out
End Function

Function TabTrim (ByVal Txt As String) As String
'ОПИСАНИЕ
'  Возвращает строку Txt без пробелов и символов табуляции справа и слева.
'  Расширяет стандартную функцию Trim, справляясь также с табуляцией.
'ПАРАМЕТРЫ
'  Txt (входящий): строка, из которой нужно удалить пробелы и табуляцию справа и слева
'РЕЗУЛЬТАТ
'  Строка Txt без пробелов и табуляции справа и слева
	TabTrim=TrimEx(Txt," "+vbTab)
End Function

Function ExtractLine(ByRef Txt As String) As String
'ОПИСАНИЕ
'  Извлекает строку кода из строки Txt.
'ПАРАМЕТРЫ
'  Txt (входной/выходной): строка, из которой извлекается отдельная строка кода.
'                      Результатирующая строка не имеет лишних пробелов и табуляций.
'РЕЗУЛЬТАТ
'  Извлечённая строка без пробелов слева и справа
Dim Pos As Long, TxtLen As Long
	TxtLen=Len(Txt)
	Pos=InStr(Txt,vbCr) 'поиск первого символа CR (возврата каретки)
	If Pos=0 Then 'если не найдено CR
		ExtractLine=TabTrim(Txt)
		Txt=""
	Else		
		If Pos<TxtLen Then
			ExtractLine=TabTrim(Left(Txt,Pos-1))  'возвращает строку без символовCR и (или) LF - перевода строки
			If Mid(Txt,Pos+1,1)=vbLf Then 'проверяем последовательность CR+LF
				If TxtLen=Pos+1 Then
					Txt=""   'нет LF: извлекаем только CR
				Else				
					Txt=LTrim(Mid(Txt,Pos+2)) 'извлекаем CR и LF
				End If
			Else
				Txt=LTrim(Mid(Txt,Pos+1)) 'нет LF: извлекаем только CR
			End If			
		End If
	End If
End Function

Sub ExtractCmdCode(ByRef Txt As String, ByRef CmdCode() As String)
'ОПИСАНИЕ
'  Извлекает из указанной строки Txt строки, относящиеся к первой команде.
'  Возвращает эти строки в массиве CmdCode, где каждый элемент представляет строку кода.
'  Окончание команды определяется как одна или более пустых строк после текста
'  (строка считается пустой даже если содержит символы табуляции или пробелы), или
'  по присутствию символа конца команды (указан в константе CMD_TERMINATOR, обычно - точка).
'  Символ-терминатор удаляется.
'
'ПАРАМЕТРЫ
'  Txt        (входной/выходной): строка, из которой извлекаются строки первой команды.
'  CmdCode() (выходной)       : массив со строками команды.
Dim TxtLine As String, NLines As Integer
Dim Terminated As Boolean
	Erase CmdCode
	'пропускаем возможные пустые строки перед первой командой
	Do 
		TxtLine=ExtractLine(Txt)
	Loop While TxtLine=""
	
	Txt=TxtLine+vbCrLf+Txt
	
	'извлекаем строки
	NLines=-1
	Do
		TxtLine=ExtractLine(Txt)
		Terminated=Right(TxtLine,Len(CMD_TERMINATOR))=CMD_TERMINATOR Or TxtLine=""
		If TxtLine<>"" Then
			NLines=NLines+1
			ReDim Preserve CmdCode(0 To NLines) As String
			CmdCode(NLines)=TxtLine
		End If
	Loop Until Terminated
	If TxtLine<>"" Then 'если закончили символом окончания команды
		'убираем его
		CmdCode(NLines)=Left(CmdCode(NLines),Len(CmdCode(NLines))-Len(CMD_TERMINATOR))
	End If
End Sub

Sub CodeLinesToTokens(CmdCode() As String, ByVal TokSep As String, _
					  Tokens() As String, Indexes() As Integer, TokensPos() As Integer)
'ОПИСАНИЕ
'  Преобразует строки команды из массива CmdCode в массив маркеров (элементов команд).
'  Например, команда "FREQ x." преобразуется в маркеры "FREQ" и "x". Это нужно для того, чтобы
'  отличать команды вызова скриптов и Include от других команд, распознавать параметры скриптов и т.д.
'  Маркер (token) - текстовый блок, который возможно окружён символами из строки TokSep.
'
'ПАРАМЕТРЫ
'  CmdCode()   (входящий) : массив строк с кодом синтаксиса.
'  TokSep      (входящий) : строка с символами-раделителями маркеров (пробелы, табуляция и проч.).
'  Tokens()    (исходящий): массив с маркерами.
'  Indexes()   (исходящий): массив с номерами строк кода из массива CmdCode, которой принадлежат маркеры.
'  TokensPos() (Output): массив со порядковыми номерами символов из строк массива CmdCode(),
'						 с которых начинаются маркеры из массива Tokens()
Dim NToks As Integer, TotToks As Integer
Dim t As Integer, i As Integer
Dim Toks() As String, ToksPos() As Integer
	Erase Tokens
	TotToks=-1
	For i=0 To UBound(CmdCode)
		GetTokens CmdCode(i),TokSep,Toks,ToksPos
		NToks=UBound(Toks)
		ReDim Preserve Tokens(0 To TotToks+NToks+1) As String
		ReDim Preserve Indexes(0 To TotToks+NToks+1) As Integer
		ReDim Preserve TokensPos(0 To TotToks+NToks+1) As Integer
		For t=0 To NToks
			Tokens(TotToks+t+1)=Toks(t)
			Indexes(TotToks+t+1)=i
		TokensPos(TotToks+t+1)=ToksPos(t)
		Next t
		TotToks=TotToks+NToks+1
	Next i
End Sub

Sub SendCommand(Cmd() As String)
'ОПИСАНИЕ
'  Посылает команду синтаксиса на исполнение процессору SPSS.
'  Не ждёт окончания выполнения команды или процедуры.
'ПАРАМЕТРЫ
'  Cmd()   (входной): массив строк с командой на выполнение процессором SPSS.
Dim i As Integer, Txt As String, N As Integer
	Txt=""
	N=UBound(Cmd)
	For i=0 To N
		Txt=Txt+Cmd(i)
		If i<>n Then
			Txt=Txt+vbCrLf
		End If
	Next i
	objSpssApp.ExecuteCommands Txt,False
End Sub

Sub ProcessScript(Cmd() As String, Tokens() As String, _
				  LIndexes() As Integer, TokensPos() As Integer)
'ОПИСАНИЕ
'  Выполняет команду SCRIPT, переданную сюда в качестве параметра.
'ПАРАМЕТРЫ
'  Cmd()       (входной): массив со строками кода.
'  Tokens()    (входной): строковый массив с элементами команд (маркерами).
'  LIndexes()  (входной): массив с номерами строк, к которым относится маркер, храняшийся
'                       в предыдущем массиве той же размерности.
'  TokensPos() (входной): массив, хранящий начальную позицию маркера в строке из массива Cmd
'					    имеет ту же размерность, что и Tokens()
Dim MacroName As String, Param As String, FullTxt As String
Dim tok As Integer, NTokens As Integer, i As Integer, pidx As Integer
Dim ParamLines() As String, Txt As String
	'ждём пока SPSS закончит выполнение предыдущих команд. На всякий случай принудительно запустим вычисления
	objSpssApp.ExecuteCommands "Execute.",False
	Do While objSpssApp.IsBusy
	Loop
	
	NTokens=UBound(Tokens)
	If NTokens<1 Then
		CmdErr Cmd,"SCRIPT file name missing"
	End If
	'получим имя файла со скриптом
	FullTxt=""
	'для этого начнём с 1-го (т.е. 2-го, поскольку нумерация элементов массива начинается с
	'0) маркера: пропустим маркер "SCRIPT"
	For tok=1 To NTokens
		FullTxt=FullTxt+Tokens(tok)
		MacroName=GetUnquotedText(FullTxt)
		If MacroName<>"" Then
			Exit For
		End If
	Next tok

	If tok>NTokens Then  'имя файла со скриптом некорректно заключено в кавычки
		CmdErr Cmd,"Имя файла со скриптом некорректно заключено в кавычки"
	End If
	If LIndexes(tok)<>LIndexes(1) Then 'если имя файла со скриптом занимает более 1 строки
		CmdErr Cmd,"Имя файла со скриптом занимает более 1 строки"
	End If
	MacroName=GetUnquotedText(Mid(Cmd(LIndexes(1)),TokensPos(1),TokensPos(tok)+Len(Tokens(tok))-TokensPos(1)))		
	If MacroName="" Then  'Не задано имя файла скрипта
		CmdErr Cmd,"Имя файла скрипта не задано или некорректно заключено в кавычки"
	End If
	
	'получим параметр скрипта, который, возможно, указан
	FullTxt=""
	If tok<NTokens Then  'параметр указан
		If Right(Tokens(NTokens),1)<>")" Then
			CmdErr Cmd,""")"" пропущена при задании параметра"
		End If
		If Left(Tokens(tok+1),1)<>"(" Then
			CmdErr Cmd,"""("" пропущена при задании параметра"
		End If
		tok=tok+1  'увеличиваем счётчик маркеров
		ReDim ParamLines(0 To LIndexes(NTokens)-LIndexes(tok)) As String
		For i=LIndexes(tok) To LIndexes(NTokens)
			pidx=i-LIndexes(tok)
			Txt=TabTrim(Cmd(i))
			If pidx=0 Then 'первая строка параметров
				ParamLines(pidx)=Mid(Txt,TokensPos(tok)+1)  'убираем символ '('
			Else
				ParamLines(pidx)=Txt
			End If
			If i=LIndexes(NTokens) Then 'последняя строка параметров
				'убираем символ ')'
				ParamLines(pidx)= Left(ParamLines(pidx),Len(ParamLines(pidx))-1)
			End If
		Next i
		Param=GetUnquotedTextLines(ParamLines)
		If Param="" Then
			CmdErr Cmd,"Пустой параметр ""()"" или параметр некорректно заключен в кавычки"
		End If
	End If
	If Not FileExists(MacroName) Then
		CmdErr Cmd,"Файл скрипта '"+MacroName+"' не найден"
	End If
	On Error Resume Next
	MacroRun MacroName,Param
	If Err<>0 Then
		MsgBox "Скрипт """+MacroName+""" содержит ошибки."+vbCr+ _
			   "Переданы параметры... "+IIf(Param=""," нет",": "+Param)+vbCr+ _
			   "Проверьте скрипт. Выполнение синтаксиса остановлено.",vbOkOnly Or vbCritical,"SyntaxScript: ошибка выполнения скрипта"
		Exit All
	End If
	On Error GoTo 0
End Sub

Function ProcessInclude(Cmd() As String, Tokens() As String, _
				  LIndexes() As Integer, TokensPos() As Integer) As String
'ОПИСАНИЕ
'  Возвращает синтаксис, вызываемый командой INCLUDE.
'ПАРАМЕТРЫ
'  Cmd()       (входящий): массив строк синтаксиса.
'  Tokens()    (входящий): массив строк с маркерами (элементами) команд.
'  LIndexes()  (входящий): массив номеров строк, в которых встречаются маркеры из предыдущего массива
'  TokensPos() (входящий): массив, содержащий начальные позиции в командах из массива Cmd()
'					    для всех маркеров из массива Tokens()
'РЕЗУЛЬТАТ
'  Строка, содержащая весь синтаксис, подключаемый через команду INCLUDe.
Const CMD_FILE="FIL"
Dim NTokens As Integer, tok As Integer, i As Integer, Pos As Integer
Dim FileName As String, FullTxt As String, Lines() As String
	NTokens=UBound(Tokens)
	If NTokens<1 Then
		CmdErr Cmd,"пропущено имя файла в INCLUDE"
	End If
	'вызов имеет следующую структуру: INCLUDE [FILE][=] имя файла
	If UCase(Left(Tokens(1),3))=CMD_FILE Then	'пропускаем первый маркер ("INCLUDE"), его индекс=0
		'INCLUDE FILE [=] filename
		Pos=InStr(Tokens(1),"=")
		If Pos>0 And Pos<Len(Tokens(1)) Then  'INCLUDE FILE=filename
			tok=1
			Pos=Pos+1
		Else
			If NTokens<2 Then
				CmdErr Cmd,"пропущено имя файла в INCLUDE"
			End If
			If Right(Tokens(1),1)="=" Then  'INCLUDE FILE= filename
				tok=2
				Pos=1
			Else
				If Tokens(2)="=" Then  'INCLUDE FILE = filename
					If NTokens<3 Then
						CmdErr Cmd,"пропущено имя файла в INCLUDE"
					End If
					tok=3
					Pos=1			
				Else
					If Left(Tokens(2),1)="=" Then  'INCLUDE FILE =filename
						tok=2
						Pos=2
					Else   'INCLUDE FILE filename
						tok=2
						Pos=1
					End If
				End If
			End If
		End If
	Else 'INCLUDE filename
		tok=1
		Pos=1 
	End If
	
	'получаем имя файла с синтаксисом
	ReDim Lines(0 To LIndexes(NTokens)-LIndexes(tok)) As String
	Lines(0)=Mid(Tokens(tok),Pos)
	FullTxt=FullTxt+Lines(0)
	For i=1 To LIndexes(NTokens)-LIndexes(tok)
		Lines(i)=Cmd(LIndexes(tok)+i)
		FullTxt=FullTxt+Lines(i)
	Next i
	FileName=GetUnquotedTextLines(Lines)
	If FileName="" Then
		If InStr("""'",Left(FullTxt,1))>0 Then
			CmdErr Cmd,"Имя файла, вызываемого через Include, некорректно заключено в кавычки"
		Else  'имя файла не закавычено
			FileName=FullTxt
		End If
	End If
	If Not FileExists(FileName) Then
		CmdErr Cmd,"Файл, вызываемый через Include ( '"+FileName+"'), не найден"
	End If
	'считываем содержимое файла include
	FullTxt=""
	i=FreeFile
	Open FileName For Input As #i
	Do While Not EOF(i)
		Line Input #i, FileName
		If FullTxt<>"" Then
			FullTxt=FullTxt+vbCrLf
		End If
		FullTxt=FullTxt+FileName
	Loop
	Close #i
	ProcessInclude=FullTxt
End Function

Sub CmdErr (Cmd() As String, ByVal ErrDescr As String)
'ОПИСАНИЕ
'  Прерывает выполнение синтаксиса при переданном описании ошибки ErrDescr,
'  вызванной выполнением команды, содержащейся в массиве Cmd.
'  Пишет сообщение об ошибке в текущее окно результатов (output) и форматирует его как стандартный лог SPSS
'ПАРАМЕТР
'  Cmd()    (входящий): массив строк, со строками синтаксиса (индекс начинается с 0).
'  ErrDescr (входящий): строка с описанием ошибки
Const ERR_STR="SyntaxScript ERROR."
Dim i As Integer, n As Integer, e As String, RTF As String, LogStr As String
Dim OutDoc As ISpssOutputDoc, objItem As ISpssItem
	With objSpssApp
		If .Documents.OutputDocCount=0 Then
			Set OutDoc = objSpssApp.NewOutputDoc
			OutDoc.Visible=True
		Else
			Set OutDoc=.GetDesignatedOutputDoc
		End If
	End With
	e="> SyntaxScript ERROR:"+vbCr+"> "+ErrDescr+vbCr
	e=e+"> in command:"+vbCr+"> """
	For i=0 To UBound(Cmd)
		e=e+Cmd(i)
		If i<UBound(Cmd) Then
			e=e+vbCr+"> "
		End If
	Next i
	e=e+""""
	
	With OutDoc
		.ClearSelection
		.Items.GetItem(.Items.Count-1).Current=True 'устанавливаем последний объект в окне результатов как текущий
		.InsertTitle "SyntaxScript ERROR", e        'и вставляем после него сообщение об ошибке
		
		'поиск текстового объекта с логом
		i=.Items.Count-1
		Do
			Set objItem=.Items.GetItem(i)
			If objItem.SPSSType=SPSSLog Then
				Exit Do
			Else
				i=i-1
			End If
		Loop Until i<0
		
		If i<0 Then 'если объект с логом не был найден
			'генерируем ошибку чтобы создать элемент лога
			objSpssApp.ExecuteCommands ERR_STR,True
			'обращаемся к объекту с логом
			i=.Items.Count-1
			Do
				Set objItem=.Items.GetItem(i)
				If objItem.SPSSType=SPSSLog Then
					Exit Do
				Else
					i=i-1
				End If
			Loop Until i<0		
		End If
		
		With objItem  'текстовый объект, содержащий лог
			With .ActivateText
				LogStr=.Text  'сохраняем существующий текст в логе
				.Text=""      'очищаем строку
				RTF=.RTFText  'помещаем код в формате RTF в пустую строку
				.Text=LogStr  'восстанавливаем лог
			End With
			.Deactivate
			If i=(OutDoc.Items.Count-1) Then  'удаляем искусственно сгенерированный лог, который нужен был лишь для того, чтобы взять из него образец форматирования
				OutDoc.ClearSelection
				.Selected=True
				OutDoc.Delete
			End If			
		End With	
		Set objItem=.Items.GetItem(.Items.Count-1)  'выделяем заголовок лога
		With objItem
			With .ActivateText
				.RTFText=RTF  'применяем то же форматирование к элементу лога
				.Text=e       'вставляем сообщение об ошибке
			End With
			.Deactivate
			'подсчитываем количество строк (n) в сообщении об ошибке
			i=1
			n=1
			Do
				i=InStr(i,e,vbCr)
				If i>0 Then
					n=n+1
					i=i+1
				End If
			Loop Until i=0
			
			'устанавливаем нужную высоту сообщения об ошибке
			.Height=.Height*n
		End With
	End With
	Exit All
End Sub

Sub RunSyntax(ByVal Syntax As String)
'ОПИСАНИЕ
'  Выполняет синтаксис, содержащийся в переданном параметре Syntax.
'  Определяет команду на вызов скрипта SCRIPT чтобы вовремя выполнить её.
'ПАРАМЕТРЫ
'  Syntax (входящий): строка, содержащая команды синтаксиса на выполнение.
Dim Cmd() As String, Tokens() As String, LineIndexes() As Integer, TokensPos() As Integer
Dim InDefine As Boolean
	InDefine=False
	Do While Syntax<>""
		'Выбирает очередную команду с помощью функции.
		ExtractCmdCode Syntax,Cmd
		'и делим её на смысловые части (имя команды и параметры, например)
		CodeLinesToTokens Cmd," "+vbTab,Tokens,LineIndexes,TokensPos
		
		'выбираем тип команды, которую сейчас будем выполнять
		Select Case UCase(Left(Tokens(0),MIN_CHARS_ID))
		Case CMD_DEF1,CMD_DEF2
			InDefine=True
			SendCommand Cmd
		Case IIf(UCase(Left(Tokens(0),Len(CMD_ENDDEFINE)))=CMD_ENDDEFINE,Left(CMD_ENDDEFINE,MIN_CHARS_ID),"")
			InDefine=False
			SendCommand Cmd
		Case CMD_SCRIPT
			If Not InDefine Then  'Вызовы скриптов из макросов игнорируются
				ProcessScript Cmd,Tokens,LineIndexes,TokensPos
			End If
		Case CMD_INCLUDE
			If Not InDefine Then  'команды include из макросов игнорируются
				'рекурсивные вызов этой процедуры RunSyntax
				RunSyntax ProcessInclude(Cmd,Tokens,LineIndexes,TokensPos)
			End If
		Case Else
			SendCommand Cmd
		End Select
	Loop
End Sub

Sub Main
'Проверяет, есть ли открытое окно синтаксиса. Если оно открыто,
'вызывает процедуру RunSyntax, передавая ей в качестве параметра содержание окна синтаксиса.
	With objSpssApp
		If .Documents.SyntaxDocCount>0 Then
			RunSyntax .GetDesignatedSyntaxDoc.Text
		Else
			MsgBox "Нет открытого окна синтаксиса.",vbOkOnly Or vbCritical,"SyntaxScript.Sbs"
		End If		
	End With
End Sub