summaryrefslogtreecommitdiffstats
path: root/wizards/source/access2base/Utils.xba
blob: 7242c605bc196c38896e36382124b8ab434ff6b2 (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
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
<?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="Utils" 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 Explicit

Global _A2B_			As Variant

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

Public Function _AddArray(ByVal pvArray As Variant, pvItem As Variant) As Variant
&apos;Add the item at the end of the array

Dim vArray() As Variant
	If IsArray(pvArray) Then vArray = pvArray Else vArray = Array()
	ReDim Preserve vArray(LBound(vArray) To UBound(vArray) + 1)
	vArray(UBound(vArray)) = pvItem
	_AddArray() = vArray()

End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _AddNumeric(ByVal Optional pvTypes As Variant) As Variant
&apos;Return on top of argument the list of all numeric types
&apos;Facilitates the entry of the list of allowed types in _CheckArgument calls

Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer
	If IsMissing(pvTypes) Then
		vNewList = Array()
	ElseIf IsArray(pvTypes) Then
		vNewList = pvTypes
	Else
		vNewList = Array(pvTypes)
	End If

	vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal, vbBoolean)

	iSize = UBound(vNewlist)
	ReDim Preserve vNewList(iSize + UBound(vNumeric) + 1)
	For i = 0 To UBound(vNumeric)
		vNewList(iSize + i + 1) = vNumeric(i)
	Next i

	_AddNumeric = vNewList

End Function		&apos;	_AddNumeric	V0.8.0

REM -----------------------------------------------------------------------------------------------------------------------

Public Function _BitShift(piValue As Integer, piConstant As Integer) As Boolean

	_BitShift = False
	If piValue = 0 Then Exit Function
	Select Case piConstant
		Case 1
			Select Case piValue
				Case 1, 3, 5, 7, 9, 11, 13, 15:				_BitShift = True
				Case Else
			End Select
		Case 2
			Select Case piValue
				Case 2, 3, 6, 7, 10, 11, 14, 15:			_BitShift = True
				Case Else
			End Select
		Case 4
			Select Case piValue
				Case 4, 5, 6, 7, 12, 13, 14, 15:			_BitShift = True
				Case Else
			End Select
		Case 8
			Select Case piValue
				Case 8, 9, 10, 11, 12, 13, 14, 15:			_BitShift = True
				Case Else
			End Select
	End Select

End Function		&apos;	BitShift

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _CalledSub() As String
	_CalledSub = Iif(_A2B_.CalledSub = &quot;&quot;, &quot;&quot;, _GetLabel(&quot;CALLTO&quot;) &amp; &quot; &apos;&quot; &amp; _A2B_.CalledSub &amp; &quot;&apos;&quot;)
End Function	&apos;	CalledSub	V0.8.9


REM -----------------------------------------------------------------------------------------------------------------------
Public Function _CheckArgument(pvItem As Variant _
			, ByVal piArgNr As Integer _
			, ByVal pvType As Variant _
			, ByVal Optional pvValid As Variant _
			, ByVal Optional pvError As Boolean _
			) As Variant
&apos;	Called by public functions to check the validity of their arguments
&apos;		pvItem 				Argument to be checked
&apos;		piArgNr				Argument sequence number
&apos;		pvType				Single value or array of allowed variable types
&apos;							If of string type must contain one or more valid pseudo-object types
&apos;		pvValid				Single value or array of allowed values - comparison for strings is case-insensitive
&apos;		pvError				If True (default), error handling in this routine. False in _setProperty methods in class modules.

	_CheckArgument = False

Dim iVarType As Integer, bValidIsMissing As Boolean
	If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType)
	If iVarType = vbString Then					&apos;	pvType is a pseudo-type string
		_CheckArgument = Utils._IsPseudo(pvItem, pvType)
	Else
		bValidIsMissing = ( VarType(pvValid) = vbError )
		If Not bValidIsMissing Then bValidIsMissing = IsMissing(pvValid)
		If bValidIsMissing Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid)
	End If

	If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)

Exit_Function:
	If Not _CheckArgument Then
		If IsMissing(pvError) Then pvError = True
		If pvError Then
			TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(piArgNr, pvItem))
		End If
	End If
	Exit Function
End Function	&apos;	CheckArgument	V0.9.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _CStr(ByVal pvArg As Variant, ByVal Optional pbShort As Boolean) As String
&apos;	Convert pvArg into a readable string (truncated if too long and pbShort = True or missing)
&apos;	pvArg may be a byte-array. Other arrays are processed recursively into a semicolon separated string

Dim sArg As String, sObject As String, oArg As Object, sLength As String, i As Long, iMax As Long
Const cstLength = 50
Const cstByteLength = 25

	If IsMissing(pbShort) Then pbShort = True
	If IsArray(pvArg) Then
		sArg = &quot;&quot;
		If VarType(pvArg) = vbByte Or VarType(pvArg) = vbArray + vbByte Then
			If pbShort And UBound(pvArg) &gt; cstByteLength Then iMax = cstByteLength Else iMax = UBound(pvArg)
			For i = 0 To iMax
				sArg = sArg &amp; Right(&quot;00&quot; &amp; Hex(pvArg(i)), 2)
			Next i
		Else
			If pbShort Then
				sArg = &quot;[ARRAY]&quot;
			Else	&apos;	One-dimension arrays only
				For i = LBound(pvArg) To UBound(pvArg)
					sArg = sArg &amp; Utils._CStr(pvArg(i), pbShort) &amp; &quot;;&quot;	&apos;	Recursive call
				Next i
				If Len(sArg) &gt; 1 Then sArg = Left(sArg, Len(sArg) - 1)
			End If
		End If
	Else
		Select Case VarType(pvArg)
			Case vbEmpty			:		sArg = &quot;[EMPTY]&quot;
			Case vbNull				:		sArg = &quot;[NULL]&quot;
			Case vbObject
				If IsNull(pvArg) Then
					sArg = &quot;[NULL]&quot;
				Else
					sObject = Utils._ImplementationName(pvArg)
					If Utils._IsPseudo(pvArg, Array(OBJDATABASE, OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _
								, OBJEVENT, OBJFIELD, OBJTABLEDEF, OBJQUERYDEF, OBJRECORDSET, OBJTEMPVAR, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL _
								, OBJDIALOG _
								)) Then
						Set oArg = pvArg		&apos;	To avoid &quot;Object variable not set&quot; error message
						sArg = &quot;[&quot; &amp; oArg._Type &amp; &quot;] &quot; &amp; oArg._Name
					ElseIf sObject &lt;&gt; &quot;&quot; Then
						sArg = &quot;[&quot; &amp; sObject &amp; &quot;]&quot;
					Else
						sArg = &quot;[OBJECT]&quot;
					End If
				End If
			Case vbVariant			:		sArg = &quot;[VARIANT]&quot;
			Case vbString
				&apos;	Replace CR + LF by \n and HT by \t
				&apos;	Replace semicolon by \; to allow semicolon separated rows
				sArg = Replace( _
							Replace( _
								Replace( _
									Replace( _
										Replace(pvArg, &quot;\&quot;, &quot;\\&quot;) _
									, Chr(13), &quot;&quot;) _
								, Chr(10), &quot;\n&quot;) _
							, Chr(9), &quot;\t&quot;) _
						, &quot;;&quot;, &quot;\;&quot;)
			Case vbBoolean			:		sArg = Iif(pvArg, &quot;[TRUE]&quot;, &quot;[FALSE]&quot;)
			Case vbByte				:		sArg = Right(&quot;00&quot; &amp; Hex(pvArg), 2)
			Case vbSingle, vbDouble, vbCurrency
				sArg = Format(pvArg)
				If InStr(UCase(sArg), &quot;E&quot;) = 0 Then sArg = Format(pvArg, &quot;##0.0##&quot;)
				sArg = Replace(sArg, &quot;,&quot;, &quot;.&quot;)
			Case vbBigint			:		sArg = CStr(CLng(pvArg))
			Case vbDate				:		sArg = Year(pvArg) &amp; &quot;-&quot; &amp; Right(&quot;0&quot; &amp; Month(pvArg), 2) &amp; &quot;-&quot; &amp; Right(&quot;0&quot; &amp; Day(pvArg), 2) _
													&amp; &quot; &quot; &amp; Right(&quot;0&quot; &amp; Hour(pvArg), 2) &amp; &quot;:&quot; &amp; Right(&quot;0&quot; &amp; Minute(pvArg), 2) _
													&amp; &quot;:&quot; &amp; Right(&quot;0&quot; &amp; Second(pvArg), 2)
			Case Else				:		sArg = CStr(pvArg)
		End Select
	End If
	If pbShort And Len(sArg) &gt; cstLength Then
		sLength = &quot;(&quot; &amp; Len(sArg) &amp; &quot;)&quot;
		sArg = Left(sArg, cstLength - 5 - Len(slength)) &amp; &quot; ... &quot; &amp; sLength
	End If
	_CStr = sArg

End Function	&apos;	CStr			V0.9.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _CVar(ByRef psArg As String, ByVal Optional pbStrDate As Boolean) As Variant
&apos;	psArg is presumed an output of _CStr (stored in the meantime in a text file f.i.)
&apos;	_CVar returns the corresponding original Variant variable or Null/Nothing if not possible
&apos;	Return values may of types Array, Long, Double, Date, Boolean, String, Null or Empty
&apos;	pbStrDate = True keeps dates as strings

Dim cstEscape1 As String, cstEscape2 As String
	cstEscape1 = Chr(14)			&apos;	Form feed used as temporary escape character for \\
	cstEscape2 = Chr(27)			&apos;	ESC used as temporary escape character for \;

	_CVar = &quot;&quot;
	If Len(psArg) = 0 Then Exit Function

Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer
	If IsMissing(pbStrDate) Then pbStrDate = False
	sArg = Replace( _
				Replace( _
					Replace( _
						Replace(psArg, &quot;\\&quot;, cstEscape1) _
					, &quot;\;&quot;, cstEscape2) _
				, &quot;\n&quot;, Chr(10)) _
			, &quot;\t&quot;, Chr(9))

	&apos;	Semicolon separated string
	vArgs = Split(sArg, &quot;;&quot;)
	If UBound(vArgs) &gt; LBound(vArgs) Then		&apos;	Process each item recursively
		vVars = Array()
		Redim vVars(LBound(vArgs) To UBound(vArgs))
		For i = LBound(vVars) To UBound(vVars)
			vVars(i) = _CVar(vArgs(i), pbStrDate)
		Next i
		_CVar = vVars
		Exit Function
	End If

	&apos;	Usual case
	Select Case True
		Case sArg = &quot;[EMPTY]&quot;						:	_CVar = EMPTY
		Case sArg = &quot;[NULL]&quot; Or sArg = &quot;[VARIANT]&quot;	:	_CVar = Null
		Case sArg = &quot;[OBJECT]&quot;						:	_CVar = Nothing
		Case sArg = &quot;[TRUE]&quot;						:	_CVar = True
		Case sArg = &quot;[FALSE]&quot;						:	_CVar = False
		Case IsDate(sArg)
			If pbStrDate Then _CVar = sArg Else _CVar = CDate(sArg)
		Case IsNumeric(sArg)
			If InStr(sArg, &quot;.&quot;) &gt; 0 Then
				_CVar = Val(sArg)
			Else
				_CVar = CLng(Val(sArg))		&apos;	Val always returns a double
			End If
		Case _RegexSearch(sArg, &quot;^[-+]?[0-9]*\.?[0-9]+(e[-+]?[0-9]+)?$&quot;) &lt;&gt; &quot;&quot;
			_CVar = Val(sArg)					&apos;	Scientific notation
		Case Else									:	_CVar = Replace(Replace(sArg, cstEscape1, &quot;\&quot;), cstEscape2, &quot;;&quot;)
	End Select

End Function	&apos;	CVar			V1.7.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _DecimalPoint() As String
&apos;Return locale decimal point
	_DecimalPoint = Mid(Format(0, &quot;0.0&quot;), 2, 1)
End Function

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _ExtensionLocation() As String
&apos;	Return the URL pointing to the location where OO installed the Access2Base extension
&apos;	Adapted from https://wiki.documentfoundation.org/Documentation/DevGuide/Extensions#Location_of_Installed_Extensions

Dim oPip As Object, sLocation As String
	Set oPip = GetDefaultContext.getByName(&quot;/singletons/com.sun.star.deployment.PackageInformationProvider&quot;)
	_ExtensionLocation = oPip.getPackageLocation(&quot;Access2Base&quot;)

End Function	&apos;	ExtensionLocation

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _GetDialogLib() As Object
&apos;	Return actual Access2Base dialogs library

Dim oDialogLib As Object

	Set oDialogLib = DialogLibraries
	If oDialogLib.hasByName(&quot;Access2BaseDev&quot;) Then
		If Not oDialogLib.IsLibraryLoaded(&quot;Access2BaseDev&quot;) Then oDialogLib.loadLibrary(&quot;Access2BaseDev&quot;)
		Set _GetDialogLib = DialogLibraries.Access2BaseDev
	ElseIf oDialogLib.hasByName(&quot;Access2Base&quot;) Then
		If Not oDialogLib.IsLibraryLoaded(&quot;Access2Base&quot;) Then oDialogLib.loadLibrary(&quot;Access2Base&quot;)
		Set _GetDialogLib = DialogLibraries.Access2Base
	Else
		Set _GetDialogLib = Nothing
	EndIf

End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetEventName(ByVal psProperty As String) As String
&apos;	Return the LO internal event name
&apos;	Corrects the typo on ErrorOccur(r?)ed

	_GetEventName = Replace(LCase(Mid(psProperty, 3, 1)) &amp; Right(psProperty, Len(psProperty) - 3), &quot;errorOccurred&quot;, &quot;errorOccured&quot;)

End Function	&apos;	_GetEventName	V1.7.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetEventScriptCode(poObject As Object _
					, ByVal psEvent As String _
					, ByVal psName As String _
					, Optional ByVal pbExtendName As Boolean _
					) As String
&apos;	Extract from the parent of poObject the macro linked to psEvent.
&apos;	psName is the name of the object

Dim i As Integer, vEvents As Variant, sEvent As String, oParent As Object, iIndex As Integer, sName As String

	_GetEventScriptCode = &quot;&quot;
	If Not Utils._hasUNOMethod(poObject, &quot;getParent&quot;) Then Exit Function

	&apos;	Find form index i.e. find control via getByIndex()
	If IsMissing(pbExtendName) Then pbExtendName = False
	Set oParent = poObject.getParent()
	iIndex = -1
	For i = 0 To oParent.getCount() - 1
		sName = oParent.getByIndex(i).Name
		If (sName = psName) Or (pbExtendName And (sName = &quot;MainForm&quot; Or sName = &quot;Form&quot;)) Then
			iIndex = i
			Exit For
		End If
	Next i
	If iIndex &lt; 0 Then Exit Function

	&apos;	Find script event
	vEvents = oParent.getScriptEvents(iIndex)			&apos;	Returns an array
	sEvent = Utils._GetEventName(psEvent)			&apos;	Targeted event method
	For i = 0 To UBound(vEvents)
		If vEvents(i).EventMethod = sEvent Then
			_GetEventScriptCode = vEvents(i).ScriptCode
			Exit For
		End If
	Next i

End Function	&apos;	_GetEventScriptCode	V1.7.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _GetResultSetColumnValue(poResultSet As Object _
											, ByVal piColIndex As Integer _
											, Optional ByVal pbReturnBinary As Boolean _
											) As Variant
REM Modified from Roberto Benitez&apos;s BaseTools
REM get the data for the column specified by ColIndex
REM If pbReturnBinary = False (default) then return length of binary field
REM get type name from metadata

Dim vValue As Variant, iType As Integer, vDateTime As Variant, oValue As Object
Dim bNullable As Boolean, lSize As Long
Const cstMaxTextLength = 65535
Const cstMaxBinlength = 2 * 65535

	On Local Error Goto 0			&apos;	Disable error handler
	vValue = Null					&apos;	Default value if error
	If IsMissing(pbReturnBinary) Then pbReturnBinary = False
	With com.sun.star.sdbc.DataType
		iType = poResultSet.MetaData.getColumnType(piColIndex)
		bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
		Select Case iType
			Case .ARRAY						:		vValue = poResultSet.getArray(piColIndex)
			Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
													Set oValue = poResultSet.getBinaryStream(piColIndex)
													If bNullable Then
														If Not poResultSet.wasNull() Then
															If Not _hasUNOMethod(oValue, &quot;getLength&quot;) Then	&apos;	When no recordset
																lSize = cstMaxBinLength
															Else
																lSize = CLng(oValue.getLength())
															End If
															If lSize &lt;= cstMaxBinLength And pbReturnBinary Then
																vValue = Array()
																oValue.readBytes(vValue, lSize)
															Else	&apos;	Return length of field, not content
																vValue = lSize
															End If
														End If
													End If
													oValue.closeInput()
			Case .BIT, .BOOLEAN				:		vValue = poResultSet.getBoolean(piColIndex)
			Case .DATE						:		vDateTime = poResultSet.getDate(piColIndex)
													If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
			Case .DISTINCT, .OBJECT, .OTHER, .STRUCT
													vValue = Null
			Case .DOUBLE, .REAL				:		vValue = poResultSet.getDouble(piColIndex)
			Case .FLOAT						:		vValue = poResultSet.getFloat(piColIndex)
			Case .INTEGER, .SMALLINT		:		vValue = poResultSet.getInt(piColIndex)
			Case .BIGINT					:		vValue = poResultSet.getLong(piColIndex)
			Case .DECIMAL, .NUMERIC			:		vValue = poResultSet.getDouble(piColIndex)
			Case .SQLNULL					:		vValue = poResultSet.getNull(piColIndex)
			Case .OBJECT, .OTHER, .STRUCT	:		vValue = Null
			Case .REF						:		vValue = poResultSet.getRef(piColIndex)
			Case .TINYINT					:		vValue = poResultSet.getShort(piColIndex)
			Case .CHAR, .VARCHAR			:		vValue = poResultSet.getString(piColIndex)
			Case .LONGVARCHAR, .CLOB
													Set oValue = poResultSet.getCharacterStream(piColIndex)
													If bNullable Then
														If Not poResultSet.wasNull() Then
															If Not _hasUNOMethod(oValue, &quot;getLength&quot;) Then	&apos;	When no recordset
																lSize = cstMaxTextLength
															Else
																lSize = CLng(oValue.getLength())
															End If
															oValue.closeInput()
															vValue = poResultSet.getString(piColIndex)
														End If
													Else
														oValue.closeInput()
													End If
			Case .TIME						:		vDateTime = poResultSet.getTime(piColIndex)
													If Not poResultSet.wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
			Case .TIMESTAMP					:		vDateTime = poResultSet.getTimeStamp(piColIndex)
													If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
																+ TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
			Case Else
				vValue = poResultSet.getString(piColIndex)						&apos;GIVE STRING A TRY
				If IsNumeric(vValue) Then vValue = Val(vValue)		&apos;Required when type = &quot;&quot;, sometimes numeric fields are returned as strings (query/MSAccess)
		End Select
		If bNullable Then
			If poResultSet.wasNull() Then vValue = Null
		End If
	End With

	_GetResultSetColumnValue = vValue

End Function	&apos;	GetResultSetColumnValue		V 1.5.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _FinalProperty(psShortcut As String) As String
&apos; Return the final property of a shortcut

Const cstEXCLAMATION = &quot;!&quot;
Const cstDOT = &quot;.&quot;

Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String
Dim sComponents() As String, sSubComponents() As String
	_FinalProperty = &quot;&quot;
	sComponents = Split(Trim(psShortcut), cstEXCLAMATION)
	If UBound(sComponents) = 0 Then Exit Function
	sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT)
	Select Case UBound(sSubComponents)
		Case 1
			_FinalProperty = sSubComponents(1)
		Case Else
			Exit Function
	End Select

End Function	&apos;	FinalProperty

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetProductName(ByVal Optional psFlag As String) as String
&apos;Return OO product (&quot;PRODUCT&quot;) and version numbers (&quot;VERSION&quot;)
&apos;Derived from Tools library

Dim oProdNameAccess as Object
Dim sVersion as String
Dim sProdName as String
	If IsMissing(psFlag) Then psFlag = &quot;ALL&quot;
	oProdNameAccess = _GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
	sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
	sVersion = oProdNameAccess.getByName(&quot;ooSetupVersionAboutBox&quot;)
	Select Case psFlag
		Case &quot;ALL&quot;			:	_GetProductName = sProdName &amp; &quot; &quot; &amp; sVersion
		Case &quot;PRODUCT&quot;		:	_GetProductName = sProdName
		Case &quot;VERSION&quot;		:	_GetProductName = sVersion
	End Select
End Function	&apos;	GetProductName		V1.0.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetRandomFileName(ByVal psName As String) As String
&apos;	Return the full name of a random temporary file suffixed by psName

Dim sRandom As String
	sRandom = Right(&quot;000000&quot; &amp; Int(999999 * Rnd), 6)
	_GetRandomFileName = Utils._getTempDirectoryURL() &amp; &quot;/&quot; &amp; &quot;A2B_TEMP_&quot; &amp; psName &amp; &quot;_&quot; &amp; sRandom

End Function	&apos;	GetRandomFileName

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant
&apos;Implement ConfigurationProvider service
&apos;Derived from Tools library

Dim oConfigProvider as Object
Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
	oConfigProvider = createUnoService(&quot;com.sun.star.configuration.ConfigurationProvider&quot;)
	aNodePath(0).Name = &quot;nodepath&quot;
	aNodePath(0).Value = sKeyName
	If IsMissing(bForUpdate) Then bForUpdate = False
	If bForUpdate Then
		_GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationUpdateAccess&quot;, aNodePath())
	Else
		_GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
	End If
End Function	&apos;	GetRegistryKeyContent	V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getTempDirectoryURL()	As String
&apos;	Return the temporary directory defined in the OO Options (Paths)
Dim sDirectory As String, oSettings As Object, oPathSettings As Object

	If _ErrorHandler() Then On Local Error Goto Error_Function

	_getTempDirectoryURL = &quot;&quot;
	oPathSettings = createUnoService( &quot;com.sun.star.util.PathSettings&quot; )
	sDirectory = oPathSettings.GetPropertyValue( &quot;Temp&quot; )

	_getTempDirectoryURL = sDirectory

Exit_Function:
	Exit Function
Error_Function:
	TraceError(&quot;ERROR&quot;, Err, &quot;_getTempDirectoryURL&quot;, Erl)
	_getTempDirectoryURL = &quot;&quot;
	Goto Exit_Function
End Function	&apos;	_getTempDirectoryURL		V0.8.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getUNOTypeName(pvObject As Variant) As String
&apos; Return the symbolic name of the pvObject (UNO-object) type
&apos; Code-snippet from XRAY

Dim oService As Object, vClass as Variant
	_getUNOTypeName = &quot;&quot;
	On Local Error Resume Next
	oService = CreateUnoService(&quot;com.sun.star.reflection.CoreReflection&quot;)
	vClass = oService.getType(pvObject)
	If vClass.TypeClass = com.sun.star.uno.TypeClass.STRUCT  Then
		_getUNOTypeName = vClass.Name
	End If
	oService.Dispose()

End Function	&apos;	getUNOTypeName

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _hasUNOMethod(pvObject As Variant, psMethod As String) As Boolean
&apos; Return true if pvObject has the (UNO) method psMethod
&apos; Code-snippet found in Bernard Marcelly&apos;s XRAY

Dim vInspect as Variant
	_hasUNOMethod = False
	If IsNull(pvObject) Then Exit Function
	On Local Error Resume Next
	vInspect = _A2B_.Introspection.Inspect(pvObject)
	_hasUNOMethod = vInspect.hasMethod(psMethod, com.sun.star.beans.MethodConcept.ALL)

End Function	&apos;	hasUNOMethod	V0.8.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _hasUNOProperty(pvObject As Variant, psProperty As String) As Boolean
&apos; Return true if pvObject has the (UNO) property psProperty
&apos; Code-snippet found in Bernard Marcelly&apos;s XRAY

Dim vInspect as Variant
	_hasUNOProperty = False
	If IsNull(pvObject) Then Exit Function
	On Local Error Resume Next
	vInspect = _A2B_.Introspection.Inspect(pvObject)
	_hasUNOProperty = vInspect.hasProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)

End Function	&apos;	hasUNOProperty	V0.8.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _ImplementationName(pvObject As Variant) As String
&apos;	Use getImplementationName method or _getUNOTypeName function

Dim sObjectType As String
	On Local Error Resume Next
	sObjectType = pvObject.getImplementationName()
	If sObjectType = &quot;&quot; Then sObjectType =  _getUNOTypeName(pvObject)

	_ImplementationName = sObjectType

End Function		&apos;	ImplementationName

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _InList(ByVal pvItem As Variant, pvList As Variant, ByVal Optional pvReturnValue As Variant, Optional ByVal pbBinarySearch As Boolean) As Variant
&apos;	Return True if pvItem is present in the pvList array (case insensitive comparison)
&apos;	Return the value in pvList if pvReturnValue = True

Dim i As Integer, bFound As Boolean, iListVarType As Integer, iItemVarType As Integer
Dim iTop As Integer, iBottom As Integer, iFound As Integer
	iItemVarType = VarType(pvItem)
	If IsMissing(pvReturnValue) Then pvReturnValue = False
	If iItemVarType = vbNull Or IsNull(pvList) Then
		_InList = False
	ElseIf Not IsArray(pvList) Then
		If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList) ) Else bFound = ( pvItem = pvList )
		If Not pvReturnValue Then
			_InList = bFound
		Else
			If bFound Then _InList = pvList Else _InList = False
		End If
	ElseIf UBound(pvList) &lt; LBound(pvList) Then		&apos;	Array not initialized
		_InList = False
	Else
		bFound = False
		_InList = False
		iListVarType = VarType(pvList(LBound(pvList)))
		If iListVarType = iItemVarType _
			Or ( (iListVarType = vbInteger Or iListVarType = vbLong Or iListVarType = vbSingle Or iListVarType = vbDouble _
					Or iListVarType = vbCurrency Or iListVarType = vbBigint Or iListVarType = vbDecimal) _
				And (iItemVarType = vbInteger Or iItemVarType = vbLong Or iItemVarType = vbSingle Or iItemVarType = vbDouble _
					Or iItemVarType = vbCurrency Or iItemVarType = vbBigint Or iItemVarType = vbDecimal) _
				) Then
			If IsMissing(pbBinarySearch) Then pbBinarySearch = False
			If Not pbBinarySearch Then			&apos;	Linear search
				For i = LBound(pvList) To UBound(pvList)
					If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) )
					If bFound Then
						iFound = i
						Exit For
					End If
				Next i
			Else								&apos;	Binary search =&gt; array must be sorted
				iTop = UBound(pvList)
				iBottom = lBound(pvList)
				Do
					iFound = (iTop + iBottom) / 2
					If ( iItemVarType = vbString And UCase(pvItem) &gt; UCase(pvList(iFound)) ) Or ( iItemVarType &lt;&gt; vbString And pvItem &gt; pvList(iFound) ) Then
						iBottom = iFound + 1
					Else
						iTop = iFound - 1
					End If
					If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) )
				Loop Until ( bFound ) Or ( iBottom &gt; iTop )
			End If
			If bFound Then
				If Not pvReturnValue Then _InList = True Else _InList = pvList(iFound)
			End If
		End If
	End If

	Exit Function

End Function	&apos;	InList V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _InspectPropertyType(poObject As Object, psProperty As String) As String
&apos;Return type of property EVEN WHEN EMPTY ! (Used in date and time controls)

Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object
&apos;	On Local Error Resume Next
	_InspectPropertyType = &quot;&quot;
	Set oInspect1 = CreateUnoService(&quot;com.sun.star.script.Invocation&quot;)
	Set oInspect2 = oInspect1.createInstanceWithArguments(Array(poObject)).IntroSpection
	If Not IsNull(oInspect2) Then
		Set oInspect3 = oInspect2.getProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)
		If Not IsNull(oInspect3) Then _InspectPropertyType = oInspect3.Type.Name
	End If
	Set oInspect1 = Nothing	:	Set oInspect2 = Nothing	:	Set oInspect3 = Nothing

End Function	&apos;	InspectPropertyType	V1.0.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _IsLeft(psString As String, psLeft As String) As Boolean
&apos;	Return True if left part of psString = psLeft

Dim iLength As Integer
	iLength = Len(psLeft)
	_IsLeft = False
	If Len(psString) &gt;= iLength Then
		If Left(psString, iLength) = psLeft Then _IsLeft = True
	End If

End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _IsBinaryType(ByVal lType As Long) As Boolean

	With com.sun.star.sdbc.DataType
		Select Case lType
			Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
				_IsBinaryType = True
			Case Else
				_IsBinaryType = False
		End Select
	End With

End Function	&apos;	IsBinaryType	V1.6.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
&apos;	Test pvObject:	does it exist ?
&apos;					is the _Type item = one of the proposed pvTypes ?
&apos;					does the pseudo-object refer to an existing object (e.g. does the form really exist in the db) ?

Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant

	If _ErrorHandler() Then On Local Error Goto Exit_False

	_IsPseudo = False
	bIsPseudo = False
	vObject = pvObject					&apos;	To avoid &quot;Object variable not set&quot; error message
	Select Case True
		Case IsEmpty(vObject)
		Case IsNull(vObject)
		Case VarType(vObject) &lt;&gt; vbObject
		Case Else
			With vObject
				Select Case True
					Case IsEmpty(._Type)
					Case IsNull(._Type)
					Case ._Type = &quot;&quot;
					Case Else
						bIsPseudo = _InList(._Type, pvType)
						If Not bIsPseudo Then		&apos;	If primary type did not succeed, give the subtype a chance
							If ._Type = OBJCONTROL Then bIsPseudo = _InList(._SubType, pvType)
						End If
				End Select
			End With
	End Select

	If Not bIsPseudo Then Goto Exit_Function

Dim oDoc As Object, oForms As Variant
Const cstSeparator = &quot;\;&quot;

	bPseudoExists = False
	With vObject
		Select Case ._Type
			Case OBJFORM
				If ._Name &lt;&gt; &quot;&quot; Then		&apos;	Check validity of form name
					Set oDoc = _A2B_.CurrentDocument()
					If oDoc.DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = _InList(._Name, Application._GetAllHierarchicalNames())
				End If
			Case OBJDATABASE
				If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = Not IsNull(.Connection)
			Case OBJDIALOG
				If ._Name &lt;&gt; &quot;&quot; Then		&apos;	Check validity of dialog name
					bPseudoExists = ( _A2B_.hasItem(COLLALLDIALOGS, ._Name) )
				End If
			Case OBJCOLLECTION
				bPseudoExists = True
			Case OBJCONTROL
				If Not IsNull(.ControlModel) And ._Name &lt;&gt; &quot;&quot; Then		&apos;	Check validity of control
					Set oForms = .ControlModel.Parent
					bPseudoExists = ( oForms.hasByName(._Name) )
				End If
			Case OBJSUBFORM
				If Not IsNull(.DatabaseForm) And ._Name &lt;&gt; &quot;&quot; Then		&apos;	Check validity of subform
					If .DatabaseForm.ImplementationName = &quot;com.sun.star.comp.forms.ODatabaseForm&quot; Then
						Set oForms = .DatabaseForm.Parent
						bPseudoExists = ( oForms.hasByName(._Name) )
					End If
				End If
			Case OBJOPTIONGROUP
				bPseudoExists = ( .Count &gt; 0 )
			Case OBJCOMMANDBAR
				bPseudoExists = ( Not IsNull(._Window) )
			Case OBJCOMMANDBARCONTROL
				bPseudoExists = ( Not IsNull(._ParentCommandBar) )
			Case OBJEVENT
				bPseudoExists = ( Not IsNull(._EventSource) )
			Case OBJPROPERTY
				bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; )
			Case OBJTABLEDEF
				bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Table) )
			Case OBJQUERYDEF
				bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Query) )
			Case OBJRECORDSET
				bPseudoExists = ( Not IsNull(.RowSet) )
			Case OBJFIELD
				bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Column) )
			Case OBJTEMPVAR
				If ._Name &lt;&gt; &quot;&quot; Then		&apos;	Check validity of tempvar name
					bPseudoExists = ( _A2B_.hasItem(COLLTEMPVARS, ._Name) )
				End If
			Case Else
		End Select
	End With

	_IsPseudo = ( bIsPseudo And bPseudoExists )

Exit_Function:
	Exit Function
Exit_False:
	_IsPseudo = False
	Goto Exit_Function
End Function	&apos;	IsPseudo		V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _IsScalar(ByVal pvArg As Variant, ByVal pvType As Variant, ByVal Optional pvValid As Variant) As Boolean
&apos;	Check type of pvArg and value in allowed pvValid list

	_IsScalar = False

	If IsArray(pvType) Then
		If Not _InList(VarType(pvArg), pvType) Then Exit Function
	ElseIf VarType(pvArg) &lt;&gt; pvType Then
		If pvType = vbBoolean And VarType(pvArg) = vbLong Then
			If pvArg &lt; -1 And pvArg &gt; 0 Then Exit Function	&apos;	Special boolean processing because the Not function returns a Long
		Else
			Exit Function
		End If
	End If
	If Not IsMissing(pvValid) Then
		If Not _InList(pvArg, pvValid) Then Exit Function
	End If

	_IsScalar = True

Exit_Function:
	Exit Function
End Function	&apos;	IsScalar	V0.7.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _PCase(ByVal psString As String) As String
&apos;	Return the proper case representation of argument

Dim vSubStrings() As Variant, i As Integer, iLen As Integer
	vSubStrings = Split(psString, &quot; &quot;)
	For i = 0 To UBound(vSubStrings)
		iLen = Len(vSubStrings(i))
		If iLen &gt; 1 Then
			vSubStrings(i) = UCase(Left(vSubStrings(i), 1)) &amp; LCase(Right(vSubStrings(i), iLen - 1))
		ElseIf iLen = 1 Then
			vSubStrings(i) = UCase(vSubStrings(i))
		End If
	Next i
	_PCase = Join(vSubStrings, &quot; &quot;)

End Function	&apos;	PCase		V0.9.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PercentEncode(ByVal psChar As String) As String
&apos;	Percent encoding of single psChar character
&apos;	https://en.wikipedia.org/wiki/UTF-8

Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String
	lChar = Asc(psChar)

	Select Case lChar
		Case 48 To 57, 65 To 90, 97 To 122		&apos;	0-9, A-Z, a-z
			_PercentEncode = psChar
		Case Asc(&quot;-&quot;), Asc(&quot;.&quot;), Asc(&quot;_&quot;), Asc(&quot;~&quot;)
			_PercentEncode = psChar
		Case Asc(&quot;!&quot;), Asc(&quot;$&quot;), Asc(&quot;&amp;&quot;), Asc(&quot;&apos;&quot;), Asc(&quot;(&quot;), Asc(&quot;)&quot;), Asc(&quot;*&quot;), Asc(&quot;+&quot;), Asc(&quot;,&quot;), Asc(&quot;;&quot;), Asc(&quot;=&quot;)	&apos;	Reserved characters used as delimiters in query strings
			_PercentEncode = psChar
		Case Asc(&quot; &quot;), Asc(&quot;%&quot;)
			_PercentEncode = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(lChar), 2)
		Case 0 To 127
			_PercentEncode = psChar
		Case 128 To 2047
			sByte1 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(Int(lChar / 64) + 192), 2)
			sByte2 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex((lChar Mod 64) + 128), 2)
			_PercentEncode = sByte1 &amp; sByte2
		Case 2048 To 65535
			sByte1 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(Int(lChar / 4096) + 224), 2)
			sByte2 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(Int(lChar - (4096 * Int(lChar / 4096))) /64 + 128), 2)
			sByte3 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex((lChar Mod 64) + 128), 2)
			_PercentEncode = sByte1 &amp; sByte2 &amp; sByte3
		Case Else				&apos;	Not supported
			_PercentEncode = psChar
	End Select

	Exit Function

End Function	&apos;	_PercentEncode V1.4.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _ReadFileIntoArray(ByVal psFileName) As Variant
&apos;	Loads all lines of a text file into a Variant array
&apos;	Any error reduces output to an empty array
&apos;	Input file name presumed in URL form

Dim vLines() As Variant, iFile As Integer, sLine As String, iCount1 As Integer, iCount2 As Integer
Const cstMaxLines = 16000		&apos;	+/- the limit of array sizes in Basic
	On Local Error GoTo Error_Function
	vLines = Array()
	_ReadFileIntoArray = Array()
	If psFileName = &quot;&quot; Then Exit Function

	iFile = FreeFile()
	Open psFileName For Input Access Read Shared As #iFile
	iCount1 = 0
	Do While Not Eof(iFile) And iCount1 &lt; cstMaxLines
		Line Input #iFile, sLine
		iCount1 = iCount1 + 1
	Loop
	Close #iFile

	ReDim vLines(0 To iCount1 - 1)		&apos;	Reading file twice preferred to ReDim Preserve for performance reasons
	iFile = FreeFile()
	Open psFileName For Input Access Read Shared As #iFile
	iCount2 = 0
	Do While Not Eof(iFile) And iCount2 &lt; iCount1
		Line Input #iFile, vLines(iCount2)
		iCount2 = iCount2 + 1
	Loop
	Close #iFile

Exit_Function:
	_ReadFileIntoArray() = vLines()
	Exit Function
Error_Function:
	vLines = Array()
	Resume Exit_Function
End Function	&apos;	_ReadFileIntoArray	V1.4.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _RegexSearch(ByRef psString As String _
						, ByVal psRegex As String _
						, Optional ByRef plStart As Long _
						, Optional ByVal bForward As Boolean _
						) As String
&apos;	Search is not case-sensitive
&apos;	Return &quot;&quot; if regex not found, otherwise returns the matching string
&apos;	plStart = start position of psString to search (starts at 1)
&apos;	In output plStart contains the first position of the matching string
&apos;	To search again the same or another pattern =&gt; plStart = plStart + Len(matching string)

Dim oTextSearch As Object
Dim vOptions As Variant	&apos;com.sun.star.util.SearchOptions
Dim lEnd As Long, vResult As Object

	_RegexSearch = &quot;&quot;
	Set oTextSearch = _A2B_.TextSearch		&apos;	UNO XTextSearch service
	vOptions = _A2B_.SearchOptions
	vOptions.searchString = psRegex				&apos;	Pattern to be searched
	oTextSearch.setOptions(vOptions)
	If IsMissing(plStart) Then plStart = 1
	If plStart &lt;= 0 Or plStart &gt; Len(psString) Then Exit Function
	If IsMissing(bForWard) Then bForward = True
	If bForward Then
		lEnd = Len(psString)
		vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd)
	Else
		lEnd = 1
		vResult = oTextSearch.searchForward(psString, plStart, lEnd - 1)
	End If
	With vResult
		If .subRegExpressions &gt;= 1 Then
			&apos;	http://www.openoffice.org/api/docs/common/ref/com/sun/star/util/SearchResult.html
			Select Case bForward
				Case True
					plStart = .startOffset(0) + 1
					lEnd = .endOffset(0) + 1
				Case False
					plStart = .endOffset(0) + 1
					lEnd = .startOffset(0)
			End Select
			_RegexSearch = Mid(psString, plStart, lEnd - plStart)
		Else
			plStart = 0
		End If
	End With

End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _RegisterDialogEventScript(poObject As Object _
								, ByVal psEvent As String _
								, ByVal psListener As String _
								, ByVal psScriptCode As String _
								) As Boolean
&apos;	Register a script event (psEvent) to poObject (Dialog or dialog Control)

Dim oEvents As Object, sEvent As String, sEventName As String, oEvent As Object

	_RegisterDialogEventScript = False
	If Not _hasUNOMethod(poObject, &quot;getEvents&quot;) Then Exit Function

&apos;	Remove existing event, if any, then store new script code
	Set oEvents = poObject.getEvents()
	sEvent = Utils._GetEventName(psEvent)
	sEventName = &quot;com.sun.star.awt.&quot; &amp; psListener &amp; &quot;::&quot; &amp; sEvent
	If oEvents.hasByName(sEventName) Then oEvents.removeByName(sEventName)
	Set oEvent = CreateUnoStruct(&quot;com.sun.star.script.ScriptEventDescriptor&quot;)
	With oEvent
		.ListenerType = psListener
		.EventMethod = sEvent
		.ScriptType = &quot;Script&quot;			&apos;	Better than &quot;Basic&quot;
		.ScriptCode = psScriptCode
	End With
	oEvents.insertByName(sEventName, oEvent)

	_RegisterDialogEventScript = True

End Function	&apos;	_RegisterDialogEventScript	V1.8.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _RegisterEventScript(poObject As Object _
								, ByVal psEvent As String _
								, ByVal psListener As String _
								, ByVal psScriptCode As String _
								, ByVal psName As String _
								, Optional ByVal pbExtendName As Boolean _
								) As Boolean
&apos;	Register a script event (psEvent) to poObject (Form, SubForm or Control)

Dim i As Integer, oEvent As Object, sEvent As String, oParent As Object, iIndex As Integer, sName As String

	_RegisterEventScript = False
	If Not _hasUNOMethod(poObject, &quot;getParent&quot;) Then Exit Function

	&apos;	Find object internal index i.e. how to reach it via getByIndex()
	If IsMissing(pbExtendName) Then pbExtendName = False
	Set oParent = poObject.getParent()
	iIndex = -1
	For i = 0 To oParent.getCount() - 1
		sName = oParent.getByIndex(i).Name
		If (sName = psName) Or (pbExtendName And (sName = &quot;MainForm&quot; Or sName = &quot;Form&quot;)) Then
			iIndex = i
			Exit For
		End If
	Next i
	If iIndex &lt; 0 Then Exit Function

	sEvent = Utils._GetEventName(psEvent)			&apos;	Targeted event method
	If psScriptCode = &quot;&quot; Then
		oParent.revokeScriptEvent(iIndex, psListener, sEvent, &quot;&quot;)
	Else
		Set oEvent = CreateUnoStruct(&quot;com.sun.star.script.ScriptEventDescriptor&quot;)
		With oEvent
			.ListenerType = psListener
			.EventMethod = sEvent
			.ScriptType = &quot;Script&quot;			&apos;	Better than &quot;Basic&quot;
			.ScriptCode = psScriptCode
		End With
		oParent.registerScriptEvent(iIndex, oEvent)
	End If
	_RegisterEventScript = True

End Function	&apos;	_RegisterEventScript	V1.7.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _ResetCalledSub(ByVal psSub As String)
&apos;	Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
&apos;	Used to trace routine in/outs and to clarify error messages
		If IsEmpty(_A2B_) Then Call Application._RootInit()	&apos;	Only when Utils module recompiled
		With _A2B_
			If .CalledSub = psSub Then .CalledSub = &quot;&quot;
			If .MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Exiting&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
		End With
End Sub			&apos;	ResetCalledSub

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _RunScript(ByVal psScript As String, Optional pvArgs() As Variant) As Boolean
&apos;	Execute a given script with pvArgs() array of arguments

	On Local Error Goto Error_Function
	_RunScript = False
	If IsNull(ThisComponent) Then Goto Exit_Function

Dim oSCriptProvider As Object, oScript As Object, vResult As Variant

	Set oScriptProvider = ThisComponent.ScriptProvider()
	Set oScript = oScriptProvider.getScript(psScript)
	If IsMissing(pvArgs()) Then pvArgs() = Array()
	vResult = oScript.Invoke(pvArgs(), Array(), Array())
	_RunScript = True

Exit_Function:
	Exit Function
Error_Function:
	_RunScript = False
	Goto Exit_Function
End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _SetCalledSub(ByVal psSub As String)
&apos;	Called in top of each public function.
&apos;	Used to trace routine in/outs and to clarify error messages
		If IsEmpty(_A2B_) Then Call Application._RootInit()	&apos;	First use of Access2Base in current LibO/AOO session
		With _A2B_
			If .CalledSub = &quot;&quot; Then
				.CalledSub = psSub
				.LastErrorCode = 0
				.LastErrorLevel = &quot;&quot;
				.ErrorText = &quot;&quot;
				.ErrorLongText = &quot;&quot;
			End If
			If .MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Entering&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
		End With
End Sub			&apos;	SetCalledSub

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _Surround(ByVal psName As String) As String
&apos; Return [Name] if Name contains spaces
&apos; Return [Name1].[Name2].[Name3] if Name1.Name2.Name3 contains dots

Const cstSquareOpen = &quot;[&quot;
Const cstSquareClose = &quot;]&quot;
Const cstDot = &quot;.&quot;
Dim sName As String

	If InStr(psName, &quot;.&quot;) &gt; 0 Then
		sName = Join(Split(psName, cstDot), cstSquareClose &amp; cstDot &amp; cstSquareOpen)
		_Surround = cstSquareOpen &amp; sName &amp; cstSquareClose
	ElseIf InStr(psName, &quot; &quot;) &gt; 0 Then
		_Surround = cstSquareOpen &amp; psName &amp; cstSquareClose
	Else
		_Surround = psName
	End If

End Function	&apos;	Surround

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _Trim(ByVal psString As String) As String
&apos;	Remove leading and trailing spaces, remove surrounding square brackets, replace tabs by spaces
Const cstSquareOpen = &quot;[&quot;
Const cstSquareClose = &quot;]&quot;
Dim sTrim As String

	sTrim = Trim(Replace(psString, vbTab, &quot; &quot;))
	_Trim = sTrim
	If Len(sTrim) &lt;= 2 Then Exit Function

	If Left(sTrim, 1) = cstSquareOpen Then
		If Right(sTrim, 1) = cstSquareClose Then
			_Trim = Mid(sTrim, 2, Len(sTrim) - 2)
		End If
	End If
End Function	&apos;	Trim	V0.9.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _TrimArray(pvArray As Variant) As Variant
&apos;	Remove empty strings from strings array

Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As Integer
	vTrim = Null
	If Not IsArray(pvArray) Then
		If Len(Trim(pvArray)) &gt; 0 Then vTrim = Array(pvArray) Else vTrim = Array()
	ElseIf UBound(pvArray) &lt; LBound(pvArray) Then				&apos;	Array empty
		vTrim = Array()
	Else
		iCount = 0
		For i = LBound(pvArray) To UBound(pvArray)
			If Len(Trim(pvArray(i))) = 0 Then iCount = iCount + 1
		Next i
		If iCount = 0 Then
			vTrim() = pvArray()
		ElseIf iCount = UBound(pvArray) - LBound(pvArray) + 1 Then	&apos;	Array empty or all blanks
			vTrim() = Array()
		Else
			ReDim vTrim(LBound(pvArray) To UBound(pvArray) - iCount)
			j = 0
			For i = LBound(pvArray) To UBound(pvArray)
				If Len(Trim(pvArray(i))) &gt; 0 Then
					vTrim(j) = pvArray(i)
					j = j + 1
				End If
			Next i
		End If
	End If

	_TrimArray() = vTrim()

End Function	&apos;	TrimArray	V0.9.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _UpdateResultSetColumnValue(piRDBMS As Integer _
											, poResultSet As Object _
											, ByVal piColIndex As Integer _
											, ByVal pvValue As Variant _
											) As Boolean
REM store the pvValue for the column specified by ColIndex
REM get type name from metadata

Dim iType As Integer, vDateTime As Variant, oValue As Object
Dim bNullable As Boolean, lSize As Long, iValueType As Integer, sValueTypeName As String
Const cstMaxTextLength = 65535
Const cstMaxBinlength = 2 * 65535

	On Local Error Goto 0			&apos;	Disable error handler
	_UpdateResultSetColumnValue = False
	With com.sun.star.sdbc.DataType
		iType = poResultSet.MetaData.getColumnType(piColIndex)
		iValueType = VarType(pvValue)
		sValueTypeName = UCase(poResultSet.MetaData.getColumnTypeName(piColIndex))
		bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )

		If bNullable And IsNull(pvValue) Then
			poResultSet.updateNull(piColIndex)
		Else
			Select Case iType
				Case .ARRAY, .DISTINCT, .OBJECT, .OTHER, .REF, .SQLNULL, .STRUCT
														poResultSet.updateNull(piColIndex)
				Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
														poResultSet.updateBytes(piColIndex, pvValue)
				Case .BIT, .BOOLEAN				:		poResultSet.updateBoolean(piColIndex, pvValue)
				Case .DATE						:		vDateTime = CreateUnoStruct(&quot;com.sun.star.util.Date&quot;)
														vDateTime.Year = Year(pvValue)
														vDateTime.Month = Month(pvValue)
														vDateTime.Day = Day(pvValue)
														poResultSet.updateDate(piColIndex, vDateTime)
				Case .DECIMAL, .NUMERIC			:		poResultSet.updateDouble(piColIndex, pvValue)
				Case .DOUBLE, .REAL				:		poResultSet.updateDouble(piColIndex, pvValue)
				Case .FLOAT						:		poResultSet.updateFloat(piColIndex, pvValue)
				Case .INTEGER, .SMALLINT		:		poResultSet.updateInt(piColIndex, pvValue)
				Case .BIGINT					:		poResultSet.updateLong(piColIndex, pvValue)
				Case .DECIMAL, .NUMERIC			:		poResultSet.updateDouble(piColIndex, pvValue)
				Case .TINYINT					:		poResultSet.updateShort(piColIndex, pvValue)
				Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
														If piRDBMS = DBMS_SQLITE And InStr(sValueTypeName, &quot;BINARY&quot;) &gt; 0 Then		&apos;	Sqlite exception ... !
															poResultSet.updateBytes(piColIndex, pvValue)
														Else
															poResultSet.updateString(piColIndex, pvValue)
														End If
				Case .TIME						:		vDateTime = CreateUnoStruct(&quot;com.sun.star.util.Time&quot;)
														vDateTime.Hours = Hour(pvValue)
														vDateTime.Minutes = Minute(pvValue)
														vDateTime.Seconds = Second(pvValue)
														&apos;vDateTime.HundredthSeconds = 0
														poResultSet.updateTime(piColIndex, vDateTime)
				Case .TIMESTAMP					:		vDateTime = CreateUnoStruct(&quot;com.sun.star.util.DateTime&quot;)
														vDateTime.Year = Year(pvValue)
														vDateTime.Month = Month(pvValue)
														vDateTime.Day = Day(pvValue)
														vDateTime.Hours = Hour(pvValue)
														vDateTime.Minutes = Minute(pvValue)
														vDateTime.Seconds = Second(pvValue)
														&apos;vDateTime.HundredthSeconds = 0
														poResultSet.updateTimestamp(piColIndex, vDateTime)
				Case Else
					If bNullable Then poResultSet.updateNull(piColIndex)
			End Select
		End If

	End With

	_UpdateResultSetColumnValue = True

End Function	&apos;	UpdateResultSetColumnValue		V 1.6.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _URLEncode(ByVal psToEncode As String) As String
&apos;	http://www.w3schools.com/tags/ref_urlencode.asp
&apos;	http://xkr.us/articles/javascript/encode-compare/
&apos;	http://tools.ietf.org/html/rfc3986

Dim sEncoded As String, sChar As String
Dim lCurrentChar As Long, bQuestionMark As Boolean

	sEncoded = &quot;&quot;
	bQuestionMark = False
	For lCurrentChar = 1 To Len(psToEncode)
		sChar = Mid(psToEncode, lCurrentChar, 1)
		Select Case sChar
			Case &quot; &quot;, &quot;%&quot;
				sEncoded = sEncoded &amp; _PercentEncode(sChar)
			Case &quot;?&quot;					&apos;	Is it the first &quot;?&quot; ?
				If bQuestionMark Then			&apos;	&quot;?&quot; introduces in a URL the arguments part
					sEncoded = sEncoded &amp; _PercentEncode(sChar)
				Else
					sEncoded = sEncoded &amp; sChar
					bQuestionMark = True
				End If
			Case &quot;\&quot;
				If bQuestionMark Then
					sEncoded = sEncoded &amp; _PercentEncode(sChar)
				Else
					sEncoded = sEncoded &amp; &quot;/&quot;	&apos;	If Windows file naming ...
				End If
			Case Else
				If bQuestionMark Then
					sEncoded = sEncoded &amp; _PercentEncode(sChar)
				Else
					sEncoded = sEncoded &amp; _UTF8Encode(sChar)	&apos;	Because IE does not support %encoding in first part of URL
				End If
		End Select
	Next lCurrentChar

	_URLEncode = sEncoded

End Function	&apos;	_URLEncode V1.4.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _UTF8Encode(ByVal psChar As String) As String
&apos;	&amp;-encoding of single psChar character (e.g. &quot;é&quot; becomes &quot;&amp;eacute;&quot; or numeric equivalent
&apos;	http://www.w3schools.com/charsets/ref_html_utf8.asp

	Select Case psChar
		Case &quot;&quot;&quot;&quot;			:	_UTF8Encode = &quot;&amp;quot;&quot;
		Case &quot;&amp;&quot;			:	_UTF8Encode = &quot;&amp;amp;&quot;
		Case &quot;&lt;&quot;			:	_UTF8Encode = &quot;&amp;lt;&quot;
		Case &quot;&gt;&quot;			:	_UTF8Encode = &quot;&amp;gt;&quot;
		Case &quot;&apos;&quot;			:	_UTF8Encode = &quot;&amp;apos;&quot;
		Case &quot;:&quot;, &quot;/&quot;, &quot;?&quot;, &quot;#&quot;, &quot;[&quot;, &quot;]&quot;, &quot;@&quot;				&apos;	Reserved characters
			_UTF8Encode = psChar
		Case Chr(13)		:	_UTF8Encode = &quot;&quot;			&apos;	Carriage return
		Case Chr(10)		:	_UTF8Encode = &quot;&lt;br&gt;&quot;		&apos;	Line Feed
		Case &lt; Chr(126)		:	_UTF8Encode = psChar
		Case &quot;€&quot;			:	_UTF8Encode = &quot;&amp;euro;&quot;
		Case Else			:	_UTF8Encode = &quot;&amp;#&quot; &amp; Asc(psChar) &amp; &quot;;&quot;
	End Select

	Exit Function

End Function	&apos;	_UTF8Encode V1.4.0

</script:module>