summaryrefslogtreecommitdiff
path: root/wizards/source/access2base/Module.xba
blob: d3095d6459f54e42961dd4f2b1bdea98c9288db6 (plain)
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
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module" script:language="StarBasic">
REM =======================================================================================================================
REM ===					The Access2Base library is a part of the LibreOffice project.									===
REM ===					Full documentation is available on http://www.access2base.com									===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS ROOT FIELDS 								        														---
REM -----------------------------------------------------------------------------------------------------------------------

Private	_Type					As String				&apos;	Must be MODULE
Private _This					As Object				&apos;	Workaround for absence of This builtin function
Private _Parent					As Object
Private	_Name					As String
Private _Library				As Object				&apos;	com.sun.star.container.XNameAccess
Private _LibraryName			As String
Private _Storage				As String				&apos;	GLOBAL or DOCUMENT
Private _Script					As String				&apos;	Full script (string with vbLf&apos;s)
Private _Lines					As Variant				&apos;	Array of script lines
Private _CountOfLines			As Long
Private _ProcsParsed			As Boolean				&apos;	To test before use of proc arrays
Private _ProcNames()			As Variant				&apos;	All procedure names
Private _ProcDecPositions()		As Variant				&apos;	All procedure declarations
Private _ProcEndPositions()		As Variant				&apos;	All end procedure statements
Private _ProcTypes()			As Variant				&apos;	One of the vbext_pk_* constants

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS						        														---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
	_Type = OBJMODULE
	Set _This = Nothing
	Set _Parent = Nothing
	_Name = &quot;&quot;
	Set _Library = Nothing
	_LibraryName = &quot;&quot;
	_Storage = &quot;&quot;
	_Script = &quot;&quot;
	_Lines = Array()
	_CountOfLines = 0
	_ProcsParsed = False
	_ProcNames = Array()
	_ProcDecPositions = Array()
	_ProcEndPositions = Array()
End Sub		&apos;	Constructor

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
	On Local Error Resume Next
	Call Class_Initialize()
End Sub		&apos;	Destructor

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub Dispose()
	Call Class_Terminate()
End Sub		&apos;	Explicit destructor

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES					        														---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Property Get CountOfDeclarationLines() As Long
	CountOfDeclarationLines = _PropertyGet(&quot;CountOfDeclarationLines&quot;)
End Property		&apos;	CountOfDeclarationLines (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get CountOfLines() As Long
	CountOfLines = _PropertyGet(&quot;CountOfLines&quot;)
End Property		&apos;	CountOfLines (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Name() As String
	Name = _PropertyGet(&quot;Name&quot;)
End Property		&apos;	Name (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
	ObjectType = _PropertyGet(&quot;ObjectType&quot;)
End Property		&apos;	ObjectType (get)

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Lines(Optional ByVal pvLine As Variant, Optional ByVal pvNumLines As Variant) As String
&apos;	Returns a string containing the contents of a specified line or lines in a standard module or a class module

Const cstThisSub = &quot;Module.Lines&quot;
	Utils._SetCalledSub(cstThisSub)

Dim sLines As String, lLine As Long
	sLines = &quot;&quot;

	If IsMissing(pvLine) Or IsMissing(pvNumLines) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvLine, 1, _AddNumeric()) Then GoTo Exit_Function
	If Not Utils._CheckArgument(pvNumLines, 1, _AddNumeric()) Then GoTo Exit_Function
	
	lLine = pvLine
	Do While lLine &lt; _CountOfLines And lLine &lt; pvLine + pvNumLines
		sLines = sLines &amp; _Lines(lLine - 1) &amp; vbLf
		lLine = lLine + 1
	Loop
	If Len(sLines) &gt; 0 Then sLines = Left(sLines, Len(sLines) - 1)

Exit_Function:
	Lines = sLines
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
End Function	&apos;	Lines

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ProcBodyLine(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
&apos;	Return the number of the line at which the body of a specified procedure begins

Const cstThisSub = &quot;Module.ProcBodyLine&quot;
	Utils._SetCalledSub(cstThisSub)

Dim iIndex As Integer

	If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function
	If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function

	iIndex = _FindProcIndex(pvProc, pvProcType)
	If iIndex &gt;= 0 Then ProcBodyLine = _LineOfPosition(_ProcDecPositions(iIndex)) Else ProcBodyLine = iIndex

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
End Function	&apos;	ProcBodyline

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ProcCountLines(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
&apos;	Return the number of lines in the specified procedure

Const cstThisSub = &quot;Module.ProcCountLines&quot;
	Utils._SetCalledSub(cstThisSub)

Dim iIndex As Integer, lStart As Long, lEnd As Long

	If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function
	If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function

	iIndex = _FindProcIndex(pvProc, pvProcType)
	lStart = ProcStartLine(pvProc, pvProcType)
	lEnd = _LineOfPosition(_ProcEndPositions(iIndex))
	ProcCountLines = lEnd - lStart + 1
	
Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
End Function	&apos;	ProcCountLines

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ProcOfLine(Optional ByVal pvLine As Variant, Optional ByRef pvProcType As Variant) As String
&apos;	Return the name and type of the procedure containing line pvLine

Const cstThisSub = &quot;Module.ProcOfLine&quot;
	Utils._SetCalledSub(cstThisSub)

Dim sProcedure As String, iProc As Integer, lLineDec As Long, lLineEnd As Long

	If IsMissing(pvLine) Or IsMissing(pvProcType) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvLine, 1, _AddNumeric()) Then GoTo Exit_Function
	If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function

	If Not _ProcsParsed Then _ParseProcs()

	sProcedure = &quot;&quot;
	For iProc = 0 To UBound(_ProcNames)
		lLineEnd = _LineOfPosition(_ProcEndPositions(iProc))
		If pvLine &lt;= lLineEnd Then
			lLineDec = _LineOfPosition(_ProcDecPositions(iProc))
			If pvLine &lt; lLineDec Then		&apos;	Line between 2 procedures
				sProcedure = &quot;&quot;
			Else
		 		sProcedure = _ProcNames(iProc)
				pvProcType = _ProcTypes(iProc)
			End If
			Exit For
		End If
	Next iProc

Exit_Function:
	ProcOfLine = sProcedure
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
End Function	&apos;	ProcOfline

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ProcStartLine(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
&apos;	Return the number of the line at which the specified procedure begins

Const cstThisSub = &quot;Module.ProcStartLine&quot;
	Utils._SetCalledSub(cstThisSub)

Dim lLine As Long, lIndex As Long, sLine As String

	If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function
	If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function

	lLine = ProcBodyLine(pvProc, pvProcType)
	&apos;	Search baclIndexward for comment lines
	lIndex = lLine - 1
	Do While lIndex &gt; 0
		sLine = _Trim(_Lines(lIndex - 1))
		If UCase(Left(sLine, 4)) = &quot;REM &quot; Or Left(sLine, 1) = &quot;&apos;&quot; Then
			lLine = lIndex
		Else
			Exit Do
		End If
		lIndex = lIndex - 1
	Loop

	ProcStartLine = lLine

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
End Function	&apos;	ProcStartLine

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
&apos;	Return
&apos;		a Collection object if pvIndex absent
&apos;		a Property object otherwise

Const cstThisSub = &quot;Module.Properties&quot;
	Utils._SetCalledSub(cstThisSub)

Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String

	vPropertiesList = _PropertiesList()
	sObject = Utils._PCase(_Type)
	If IsMissing(pvIndex) Then
		vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
	Else
		vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
		vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
	End If
	
Exit_Function:
	Set Properties = vProperty
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
End Function	&apos;	Properties

REM -----------------------------------------------------------------------------------------------------------------------
Property Get pType() As String
	pType = _PropertyGet(&quot;Type&quot;)
End Property		&apos;	Type (get)

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS	 								        														---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Find(Optional ByVal pvTarget As Variant _
					, Optional ByRef pvStartLine As Variant _
					, Optional ByRef pvStartColumn As Variant _
					, Optional ByRef pvEndLine As Variant _
					, Optional ByRef pvEndColumn As Variant _
					, Optional ByVal pvWholeWord As Boolean _
					, Optional ByVal pvMatchCase As Boolean _
					, Optional ByVal pvPatternSearch As Boolean _
					) As Boolean
&apos;	Finds specified text in the module
&apos;	xxLine and xxColumn arguments are mainly to return the position of the found string
&apos;		If they are initialized but nonsense, the function returns False

Const cstThisSub = &quot;Module.Find&quot;
	Utils._SetCalledSub(cstThisSub)
	If _ErrorHandler() Then On Local Error Goto Error_Function

Dim bFound As Boolean, lPosition As Long, lStartLine As Long, lStartColumn As Long, lStartPosition As Long
Dim lEndLine As Long, lEndColumn As Long, lEndPosition As Long
Dim sMatch As String, vOptions As Variant, sPattern As String
Dim i As Integer, sSpecChar As String

Const cstSpecialCharacters = &quot;\[^$.|?*+()&quot;

	bFound = False

	If IsMissing(pvTarget) Or IsMissing(pvStartLine) Or IsMissing(pvStartColumn) Or IsMissing(pvEndLine) Or IsMissing(pvEndColumn) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvTarget, 1, vbString) Then GoTo Exit_Function
	If Len(pvTarget) = 0 Then GoTo Exit_Function
	If Not IsEmpty(pvStartLine) Then
		If Not Utils._CheckArgument(pvStartLine, 2, _AddNumeric()) Then GoTo Exit_Function
	End If
	If Not IsEmpty(pvStartColumn) Then
		If Not Utils._CheckArgument(pvStartColumn, 3, _AddNumeric()) Then GoTo Exit_Function
	End If
	If Not IsEmpty(pvEndLine) Then
		If Not Utils._CheckArgument(pvEndLine, 4, _AddNumeric()) Then GoTo Exit_Function
	End If
	If Not IsEmpty(pvEndColumn) Then
		If Not Utils._CheckArgument(pvEndColumn, 5, _AddNumeric()) Then GoTo Exit_Function
	End If
	If IsMissing(pvWholeWord) Then pvWholeWord = False
	If Not Utils._CheckArgument(pvWholeWord, 6, vbBoolean) Then GoTo Exit_Function
	If IsMissing(pvMatchCase) Then pvMatchCase = False
	If Not Utils._CheckArgument(pvMatchCase, 7, vbBoolean) Then GoTo Exit_Function
	If IsMissing(pvPatternSearch) Then pvPatternSearch = False
	If Not Utils._CheckArgument(pvPatternSearch, 8, vbBoolean) Then GoTo Exit_Function

	&apos;	Initialize starting values
	If IsEmpty(pvStartLine) Then lStartLine = 1 Else lStartLine = pvStartLine
	If lStartLine &lt;= 0 Or lStartLine &gt; UBound(_Lines) + 1 Then GoTo Exit_Function
	If IsEmpty(pvStartColumn) Then lStartColumn = 1 Else lStartColumn = pvStartColumn
	If lStartColumn &lt;= 0 Then GoTo Exit_Function
	If lStartColumn &gt; 1 And lStartColumn &gt; Len(_Lines(lStartLine + 1)) Then GoTo Exit_Function
	lStartPosition = _PositionOfLine(lStartline) + lStartColumn - 1
	If IsEmpty(pvEndLine) Then lEndLine = UBound(_Lines) + 1 Else lEndLine = pvEndLine
	If lEndLine &lt; lStartLine Or lEndLine &gt; UBound(_Lines) + 1 Then GoTo Exit_Function
	If IsEmpty(pvEndColumn) Then lEndColumn = Len(_Lines(lEndLine - 1)) Else lEndColumn = pvEndColumn
	If lEndColumn &lt; 0 Then GoTo Exit_Function
	If lEndColumn = 0 Then lEndColumn = 1
	If lEndColumn &gt; Len(_Lines(lEndLine - 1)) + 1 Then GoTo Exit_Function
	lEndPosition = _PositionOfLine(lEndline) + lEndColumn - 1

	If pvMatchCase Then
		Set vOptions = _A2B_.SearchOptions
		vOptions.transliterateFlags = 0
	End If

	&apos;	Define pattern to search for
	sPattern = pvTarget
	&apos;	Protect special characters in regular expressions
	For i = 1 To Len(cstSpecialCharacters)
		sSpecChar = Mid(cstSpecialCharacters, i, 1)
		sPattern = Replace(sPattern, sSpecChar, &quot;\&quot; &amp; sSpecChar)
	Next i
	If pvPatternSearch Then sPattern = Replace(Replace(sPattern, &quot;\*&quot;, &quot;.*&quot;), &quot;\?&quot;, &quot;.&quot;)
	If pvWholeWord Then sPattern = &quot;\b&quot; &amp; sPattern &amp; &quot;\b&quot;

	lPosition = lStartPosition
	sMatch = Utils._RegexSearch(_Script, sPattern, lPosition)
	&apos;	Re-establish default options for later searches
	If pvMatchCase Then vOptions.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE

	&apos;	Found within requested bounds ?
	If sMatch &lt;&gt; &quot;&quot; And lPosition &gt;= lStartPosition And lPosition &lt;= lEndPosition Then
		pvStartLine = _LineOfPosition(lPosition)
		pvStartColumn = lPosition - _PositionOfLine(pvStartLine) + 1
		pvEndLine = _LineOfPosition(lPosition + Len(sMatch) - 1)
		If pvEndLine &gt; pvStartLine Then
			pvEndColumn = lPosition + Len(sMatch) - 1 - _PositionOfLine(pvEndLine)
		Else
			pvEndColumn = pvStartColumn + Len(sMatch) - 1
		End If
		bFound = True
	End If

Exit_Function:
	Find = bFound
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Module.Find&quot;, Erl)
	bFound = False
	GoTo Exit_Function
End Function	&apos;	Find

REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
&apos;	Return property value of psProperty property name

Const cstThisSub = &quot;Module.Properties&quot;

	Utils._SetCalledSub(cstThisSub)
	If IsMissing(pvProperty) Then Call _TraceArguments()
	getProperty = _PropertyGet(pvProperty)
	Utils._ResetCalledSub(cstThisSub)
	
End Function		&apos;	getProperty

REM --------------------------------Mid(a._Script, iCtl, 25)---------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
&apos;	Return True if object has a valid property called pvProperty (case-insensitive comparison !)

Const cstThisSub = &quot;Module.hasProperty&quot;

	Utils._SetCalledSub(cstThisSub)
	If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
	
End Function	&apos;	hasProperty

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS 								        														---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _BeginStatement(ByVal plStart As Long) As Long
&apos;	Return the position in _Script of the beginning of the current statement as defined by plStart

Dim sProc As String, iProc As Integer, iType As Integer
Dim lPosition As Long, lPrevious As Long, sFind As String

	sProc = ProcOfLine(_LineOfPosition(plStart), iType)
	iProc = _FindProcIndex(sProc, iType)
	If iProc &lt; 0 Then lPosition = 1 Else lPosition = _ProcDecPositions(iProc)

	sFind = &quot;Any&quot;
	Do While lPosition &lt; plStart And sFind &lt;&gt; &quot;&quot;
		lPrevious = lPosition
		sFind = _FindPattern(&quot;%^\w&quot;, lPosition)
		If sFind = &quot;&quot; Then Exit Do
	Loop

	_BeginStatement = lPrevious

End Function	&apos;	_EndStatement

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _EndStatement(ByVal plStart As Long) As Long
&apos;	Return the position in _Script of the end of the current statement as defined by plStart
&apos;	plStart is assumed not to be in the middle of a comment or a string

Dim sMatch As String, lPosition As Long
	lPosition = plStart
	sMatch = _FindPattern(&quot;%$&quot;, lPosition)
	_EndStatement = lPosition

End Function	&apos;	_EndStatement

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _FindPattern(ByVal psPattern As Variant, Optional ByRef plStart As Long) As String
&apos;	Find first occurrence of any of the patterns in |-delimited string psPattern
&apos;	Special escapes
&apos;				- for word breaks: &quot;%B&quot; (f.i. for searching &quot;END%BFUNCTION&quot;)
&apos;				- for statement start: &quot;%^&quot; (f.i. for searching &quot;%^END%BFUNCTION&quot;). Necessarily first 2 characters of pattern
&apos;				- for statement end: &quot;%$&quot;. Pattern should not contain anything else
&apos;	If quoted string searched, pattern should start and end with a double quote
&apos;	Return &quot;&quot; if none found, otherwise returns the matching string
&apos;	plStart = start position of _Script to search (starts at 1)
&apos;	In output plStart contains the first position of the matching string or is left unchanged
&apos;	To search again the same or another pattern =&gt; plStart = plStart + Len(matching string)
&apos;	Comments and strings are skipped

&apos;	Common patterns
Const cstComment = &quot;(&apos;|\bREM\b)[^\n]*$&quot;
Const cstString = &quot;&quot;&quot;[^&quot;&quot;\n]*&quot;&quot;&quot;
Const cstBeginStatement = &quot;(^|:|\bthen\b|\belse\b|\n)[ \t]*&quot;
Const cstEndStatement = &quot;[ \t]*($|:|\bthen\b|\belse\b|\n)&quot;
Const cstContinuation = &quot;[ \t]_\n&quot;
Const cstWordBreak = &quot;\b[ \t]+(_\n[ \t]*)?\b&quot;
Const cstAlt = &quot;|&quot;

Dim sRegex As String, lStart As Long, bContinue As Boolean, sMatch As String
Dim bEndStatement As Boolean, bQuote As Boolean

	If psPattern = &quot;%$&quot; Then
		sRegex = cstEndStatement
	Else
		sRegex = psPattern
		If Left(psPattern, 2) = &quot;%^&quot; Then sRegex = cstBeginStatement &amp; Right(sRegex, Len(sregex) - 2)
		sregex = Replace(sregex, &quot;%B&quot;, cstWordBreak)
	End If
	&apos;	Add all to ignore patterns to regex. If pattern = quoted string do not add cstString
	If Len(psPattern) &gt; 2 And Left(psPattern, 1) = &quot;&quot;&quot;&quot; And Right(psPattern, 1) = &quot;&quot;&quot;&quot; Then
		bQuote = True
		sRegex = sRegex &amp; cstAlt &amp; cstComment &amp; cstAlt &amp; cstContinuation
	Else
		bQuote = False
		sRegex = sRegex &amp; cstAlt &amp; cstComment &amp; cstAlt &amp; cstString &amp; cstAlt &amp; cstContinuation
	End If

	If IsMissing(plStart) Then plStart = 1
	lStart = plStart

	bContinue = True
	Do While bContinue
		bEndStatement = False
		sMatch = Utils._RegexSearch(_Script, sRegex, lStart)
		Select Case True
			Case sMatch = &quot;&quot;
				bContinue = False
			Case Left(sMatch, 1) = &quot;&apos;&quot;
				bEndStatement = True
			Case Left(sMatch, 1) = &quot;&quot;&quot;&quot;
				If bQuote Then
					plStart = lStart
					bContinue = False
				End If
			Case Left(smatch, 1) = &quot;:&quot; Or Left(sMatch, 1) = vbLf
				If psPattern = &quot;%$&quot; Then
					bEndStatement = True
				Else
					bContinue = False
					plStart = lStart + 1
					sMatch = Right(sMatch, Len(sMatch) - 1)
				End If
			Case UCase(Left(sMatch, 4)) = &quot;REM &quot; Or UCase(Left(sMatch, 4)) = &quot;REM&quot; &amp; vbTab Or UCase(Left(sMatch, 4)) = &quot;REM&quot; &amp; vbNewLine
				bEndStatement = True
			Case UCase(Left(sMatch, 4)) = &quot;THEN&quot; Or UCase(Left(sMatch, 4)) = &quot;ELSE&quot;
				If psPattern = &quot;%$&quot; Then
					bEndStatement = True
				Else
					bContinue = False
					plStart = lStart + 4
					sMatch = Right(sMatch, Len(sMatch) - 4)
				End If
			Case sMatch = &quot; _&quot; &amp; vbLf
			Case Else		&apos;	Found
				plStart = lStart
				bContinue = False
		End Select
		If bEndStatement And psPattern = &quot;%$&quot; Then
			bContinue = False
			plStart = lStart - 1
			sMatch = &quot;&quot;
		End If
		lStart = lStart + Len(sMatch)
	Loop
	
	_FindPattern = sMatch

End Function	&apos;	_FindPattern

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _FindProcIndex(ByVal psProc As String, ByVal piType As Integer) As Integer
&apos;	Return index of entry in _Procnames corresponding with pvProc

Dim i As Integer, iIndex As Integer

	If Not _ProcsParsed Then _ParseProcs

	iIndex = -1
	For i = 0 To UBound(_ProcNames)
		If UCase(psProc) = UCase(_ProcNames(i)) And piType = _ProcTypes(i) Then
			iIndex = i
			Exit For
		End If
	Next i
	If iIndex &lt; 0 Then TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, Utils._CalledSub(), 0, , Array(psProc, _Name))

Exit_Function:
	_FindProcIndex = iIndex
	Exit Function
End Function	&apos;	_FindProcIndex

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _Initialize()

	_Script = Replace(_Script, vbCr, &quot;&quot;)
	_Lines = Split(_Script, vbLf)
	_CountOfLines = UBound(_Lines) + 1

End Sub		&apos;	_Initialize

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _LineOfPosition(ByVal plPosition) As Long
&apos;	Return the line number of a position in _Script

Dim lLine As Long, lLength As Long
	&apos;	Start counting from start or end depending on how close position is
	If plPosition &lt;= Len(_Script) / 2 Then
		lLength = 0
		For lLine = 0 To UBound(_Lines)
			lLength = lLength + Len(_Lines(lLine)) + 1		&apos;	+ 1 for line feed
			If lLength &gt;= plPosition Then
				_LineOfPosition = lLine + 1
				Exit Function
			End If
		Next lLine
	Else
		If Right(_Script, 1) = vbLf Then lLength = Len(_Script) + 1 Else lLength = Len(_Script)
		For lLine = UBound(_Lines) To 0 Step -1
			lLength = lLength - Len(_Lines(lLine)) - 1		&apos;	- 1 for line feed
			If lLength &lt;= plPosition Then
				_LineOfPosition = lLine + 1
				Exit Function
			End If
		Next lLine
	End If

End Function	&apos;	_LineOfPosition

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub _ParseProcs()
&apos;	Fills the Proc arrays: name, start and end position
&apos;	Executed at first request needing this processing

Dim lPosition As Long, iProc As Integer, sDecProc As String, sEndProc As String, sNameProc As String, sType As String
Const cstDeclaration = &quot;%^(private%B|public%B)?\b(property%Bget|property%Blet|property%Bset|function|sub)\b&quot;
Const cstEnd = &quot;%^end%B(property|function|sub)\b&quot;
Const cstName = &quot;\w*&quot;	&apos;&quot;[A-Za-z_][A-Za-z_0-9]*&quot;

	If _ProcsParsed Then Exit Sub		&apos;	Do not redo if already done
	_ProcNames = Array()
	_ProcDecPositions = Array()
	_ProcEndPositions = Array()
	_ProcTypes = Array()
	
	lPosition = 1
	iProc = -1
	sDecProc = &quot;???&quot;
	Do While sDecProc &lt;&gt; &quot;&quot;
		&apos;	Identify Function/Sub declaration string
		sDecProc = _FindPattern(cstDeclaration, lPosition)
		If sDecProc &lt;&gt; &quot;&quot; Then
			iProc = iProc + 1
			ReDim Preserve _ProcNames(0 To iProc)
			ReDim Preserve _ProcDecPositions(0 To iProc)
			ReDim Preserve _ProcEndPositions(0 To iProc)
			ReDim Preserve _ProcTypes(0 To iProc)
			_ProcDecPositions(iProc) = lPosition
			lPosition = lPosition + Len(sDecProc)
			&apos;	Identify procedure type
			Select Case True
				Case InStr(UCase(sDecProc), &quot;FUNCTION&quot;) &gt; 0			:		_ProcTypes(iProc) = vbext_pk_Proc
				Case InStr(UCase(sDecProc), &quot;SUB&quot;) &gt; 0				:		_ProcTypes(iProc) = vbext_pk_Proc
				Case InStr(UCase(sDecProc), &quot;GET&quot;) &gt; 0				:		_ProcTypes(iProc) = vbext_pk_Get
				Case InStr(UCase(sDecProc), &quot;LET&quot;) &gt; 0				:		_ProcTypes(iProc) = vbext_pk_Let
				Case InStr(UCase(sDecProc), &quot;SET&quot;) &gt; 0				:		_ProcTypes(iProc) = vbext_pk_Set
			End Select
			&apos;	Identify name of Function/Sub
			sNameProc = _FindPattern(cstName, lPosition)
			If sNameProc = &quot;&quot; Then Exit Do					&apos;	Should never happen
			_ProcNames(iProc) = sNameProc
			lPosition = lPosition + Len(sNameProc)
			&apos;	Identify End statement
			sEndProc = _FindPattern(cstEnd, lPosition)
			If sEndProc = &quot;&quot; Then Exit Do					&apos;	Should never happen
			_ProcEndPositions(iProc) = lPosition
			lPosition = lPosition + Len(sEndProc)
		End If
	Loop
	
	_ProcsParsed = True
	
End Sub

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PositionOfLine(ByVal plLine) As Long
&apos;	Return the position of the first character of the given line in _Script

Dim lLine As Long, lPosition As Long
	&apos;	Start counting from start or end depending on how close line is
	If plLine &lt;= (UBound(_Lines) + 1) / 2 Then
		lPosition = 0
		For lLine = 0 To plLine - 1
			lPosition = lPosition + 1							&apos;	+ 1 for line feed
			If lLine &lt; plLine - 1 Then lPosition = lPosition + Len(_Lines(lLine))
		Next lLine
	Else
		lPosition = Len(_Script) + 2	&apos;	Anticipate an ending null-string and a line feed
		For lLine = UBound(_Lines) To plLine - 1 Step -1
			lPosition = lPosition - Len(_Lines(lLine)) - 1		&apos;	- 1 for line feed
		Next lLine
	End If

	_PositionOfLine = lPosition

End Function	&apos;	_LineOfPosition

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant

	 _PropertiesList = Array(&quot;CountOfDeclarationLines&quot;, &quot;CountOfLines&quot;, &quot;Name&quot;, &quot;ObjectType&quot;, &quot;Type&quot;)

End Function	&apos;	_PropertiesList

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
&apos;	Return property value of the psProperty property name

Dim cstThisSub As String
Const cstDot = &quot;.&quot;

Dim sText As String

	If _ErrorHandler() Then On Local Error Goto Error_Function
	cstThisSub = &quot;Module.get&quot; &amp; psProperty
	Utils._SetCalledSub(cstThisSub)
	_PropertyGet = Null
	
	Select Case UCase(psProperty)
		Case UCase(&quot;CountOfDeclarationLines&quot;)
			If Not _ProcsParsed Then _ParseProcs()
			If UBound(_ProcNames) &gt;= 0 Then
					_PropertyGet = ProcStartLine(_ProcNames(0), _ProcTypes(0)) - 1
				Else
					_PropertyGet = _CountOfLines
				End If
		Case UCase(&quot;CountOfLines&quot;)
			_PropertyGet = _CountOfLines
		Case UCase(&quot;Name&quot;)
			_PropertyGet = _Storage &amp; cstDot &amp; _LibraryName &amp; cstDot &amp; _Name
		Case UCase(&quot;ObjectType&quot;)
			_PropertyGet = _Type
		Case UCase(&quot;Type&quot;)
			&apos;	Find option statement before any procedure declaration
			sText = _FindPattern(&quot;%^option%Bclassmodule\b|\bfunction\b|\bsub\b|\bproperty\b&quot;)
			If UCase(Left(sText, 6)) = &quot;OPTION&quot; Then _PropertyGet = acClassModule Else _PropertyGet = acStandardModule
		Case Else
			Goto Trace_Error
	End Select
	
Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Trace_Error:
	TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
	_PropertyGet = Nothing
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Module._PropertyGet&quot;, Erl)
	_PropertyGet = Null
	GoTo Exit_Function
End Function		&apos;	_PropertyGet

</script:module>