-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathclsSQLStatement.cls
914 lines (789 loc) · 28.8 KB
/
clsSQLStatement.cls
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
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsSmartSQL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Compare Text
Option Explicit
Public Enum JOIN_TYPE
INNER_JOIN = 1
LEFT_JOIN = 2
RIGHT_JOIN = 3
FULL_JOIN = 4 'SUPPORTED BY SQL SERVER ONLY
End Enum
Public Enum CLAUSE_OPERATOR
CLAUSE_EQUALS
CLAUSE_LIKE
CLAUSE_GREATERTHAN
CLAUSE_LESSTHAN
CLAUSE_GREATERTHANOREQUAL
CLAUSE_LESSTHANOREQUAL
CLAUSE_DOESNOTEQUAL
CLAUSE_STARTWITH
CLAUSE_ENDWITH
End Enum
Public Enum WHERE_CLAUSE_LOGIC
LOGIC_AND
LOGIC_OR
End Enum
Public Enum STATEMENT_TYPE
TYPE_SELECT
TYPE_INSERT
TYPE_UPDATE
TYPE_DELETE
TYPE_OTHER 'NOT CURRENTLY USED
End Enum
Public Enum SQL_TYPE
SQL_TYPE_ACCESS
SQL_TYPE_ANSI
End Enum
Private Enum ERR_NUMBERS
ERR_TABLE_REQUIRED = 25000
ERR_LIST_REQUIRED = 25010
ERR_INVALID_VALUE = 25020
ERR_INVALID_LISTITEM = 25030
End Enum
Const ERR_TABLE_REQUIRED_DESC = "Table Name property must be set"
Const ERR_LIST_REQUIRED_DESC = "Invalid argument; array or collection required."
Const ERR_INVALID_VALUE_DESC = "Invalid argument type"
Const ERR_INVALID_LISTITEM_DESC = "At least one element in the argument list is invalid"
Private pColOrderClause As Collection
Private pColFieldNames As Collection
Private pColValues As Collection 'for INSERT, UPDATE QUERIES
Private pColWhereClauses As Collection
Private psFromClause As String
Private psWhereClause As String
Private psTableNames() As String
Private psJoinTables As String
Private psJoinFields As String
Private piJoinOp As CLAUSE_OPERATOR
Private piJoinType As JOIN_TYPE
Private piWhereLogic() As WHERE_CLAUSE_LOGIC
Private pbOrderByDesc() As Boolean
Private piStatementType As STATEMENT_TYPE
Private piSQLType As SQL_TYPE
Private psSQL As String
Private psOrderClause As String
Private pbAutoQuote As Boolean
Private pbAutoLike As Boolean
Private pbAutoBracket As Boolean
Const Delimiter = "@*"
'
'#########################################################################################
' Public Subroutines
'#########################################################################################
Public Sub AddComplexWhereClause(ByVal Clause As String, Optional Logic As WHERE_CLAUSE_LOGIC = LOGIC_AND)
Dim i As Integer
i = UBound(piWhereLogic) + 1
ReDim Preserve piWhereLogic(i) As WHERE_CLAUSE_LOGIC
piWhereLogic(i) = Logic
pColWhereClauses.Add Clause
End Sub
Public Sub AddField(ByVal FieldName As String, Optional ByVal TableName As String)
Dim sTable As String
Dim sField As String
If Len(TableName) Then
sTable = DoAutoBracket(TableName) & "."
End If
sField = DoAutoBracket(FieldName)
sField = sTable & sField
pColFieldNames.Add sField
End Sub
Public Sub AddFields(ParamArray args() As Variant)
Dim sSplit() As String
Dim i As Integer
Dim sField As String
For i = 0 To UBound(args)
If ValidateValues(args(i)) = False Then
Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
End If
sField = DoAutoBracket(args(i))
pColFieldNames.Add sField
Next
End Sub
Public Sub AddOrderClause(ByVal FieldName As String, Optional OrderDesc = False, Optional ByVal TableName As String)
Dim iCount As Integer
Dim sField As String
iCount = UBound(pbOrderByDesc) + 1
ReDim Preserve pbOrderByDesc(iCount)
pbOrderByDesc(iCount) = OrderDesc
If Len(TableName) Then sField = DoAutoBracket(TableName) & "."
sField = sField & DoAutoBracket(FieldName)
pColOrderClause.Add sField
End Sub
Public Sub AddSimpleWhereClause(ByVal FieldName As String, ByVal Value As Variant, Optional ByVal TableName As String, Optional Op As CLAUSE_OPERATOR = CLAUSE_EQUALS, Optional Logic As WHERE_CLAUSE_LOGIC = LOGIC_AND)
Dim i As Integer
Dim sField As String
Dim sWhereStatement As String
Dim bString As Boolean
Dim sValueClause As String
If ValidateValues(Value) = False Then Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
i = UBound(piWhereLogic) + 1
ReDim Preserve piWhereLogic(i) As WHERE_CLAUSE_LOGIC
piWhereLogic(i) = Logic
bString = (VarType(Value) = vbString)
If Len(TableName) > 0 Then sWhereStatement = DoAutoBracket(TableName) & "."
sWhereStatement = sWhereStatement & DoAutoBracket(FieldName)
If Not bString And Op = CLAUSE_LIKE Then
Op = CLAUSE_EQUALS
End If
sWhereStatement = sWhereStatement & " " & TransformOp(Op)
sValueClause = CStr(Value)
If Op = CLAUSE_LIKE Then
If pbAutoLike Then
sValueClause = LikeCharacter & sValueClause & LikeCharacter
If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
Else
If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
End If
ElseIf Op = CLAUSE_STARTWITH Then
If pbAutoLike Then
sValueClause = sValueClause & LikeCharacter
If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
Else
If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
End If
ElseIf Op = CLAUSE_ENDWITH Then
If pbAutoLike Then
sValueClause = LikeCharacter & sValueClause
If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
Else
If pbAutoQuote Then sValueClause = prepStringForSQL(sValueClause)
End If
Else
If pbAutoQuote And bString Then sValueClause = prepStringForSQL(sValueClause)
End If
sValueClause = " " & sValueClause
sWhereStatement = sWhereStatement & sValueClause
pColWhereClauses.Add sWhereStatement
End Sub
Public Sub AddTable(ByVal TableName As String)
Dim iCount As Integer
Dim sTableName As String
sTableName = DoAutoBracket(TableName)
If Not TablePresent(sTableName) Then
iCount = UBound(psTableNames) + 1
ReDim Preserve psTableNames(iCount)
psTableNames(iCount) = sTableName
End If
'clear jointables and complex from
psFromClause = ""
psJoinTables = ""
psJoinFields = ""
piJoinOp = CLAUSE_EQUALS 'default
piJoinType = INNER_JOIN 'default
End Sub
Public Sub AddValue(ByVal Value As Variant)
Dim sValue As String
If Not ValidateValues(Value) Then Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
If ValidateValues(Value) Then
sValue = Value
If VarType(sValue) = vbString And pbAutoQuote Then sValue = prepStringForSQL(sValue)
pColValues.Add sValue
End If
End Sub
Public Sub AddValues(ParamArray args() As Variant)
Dim sSplit() As String
Dim i As Integer
Dim iCtr As Integer
Dim sAns As String
For i = 0 To UBound(args)
If ValidateValues(args(i)) = False Then Err.Raise ERR_INVALID_VALUE, , ERR_INVALID_VALUE_DESC
Next
For i = 0 To UBound(args)
sAns = args(i)
If VarType(args(i)) = vbString And pbAutoQuote Then sAns = prepStringForSQL(sAns)
pColValues.Add sAns
Next
End Sub
Public Sub ClearFromClause()
psFromClause = ""
psJoinTables = ""
psJoinFields = ""
piJoinType = INNER_JOIN
piJoinOp = CLAUSE_EQUALS
ReDim psTableNames(0) As String
End Sub
Public Sub ClearWhereClause()
Set pColWhereClauses = New Collection
ReDim piWhereLogic(0) As WHERE_CLAUSE_LOGIC
End Sub
Public Sub ClearOrderClause()
Set pColOrderClause = New Collection
ReDim pbOrderByDesc(0) As Boolean
End Sub
Public Sub ClearFields()
Set pColFieldNames = New Collection
End Sub
Public Sub ClearValues()
Set pColValues = New Collection
End Sub
Public Sub ListAddFields(ByVal FieldList As Variant, Optional ByVal TableName As String)
Dim bValid As Boolean
Dim bCollection As Boolean
Dim sAns As String
Dim l As Long
Dim v As Variant
Dim sItem As String
Dim lStartPoint As Long
If IsObject(FieldList) Then
bValid = (TypeOf FieldList Is Collection)
bCollection = True
Else
bValid = IsArray(FieldList)
End If
If Not bValid Then
Err.Raise ERR_LIST_REQUIRED, , ERR_LIST_REQUIRED_DESC
Exit Sub
End If
'optional: add type check for each value in array or collection
'can't have objects,
If bCollection Then
For Each v In FieldList
If Not ValidateValues(v) Then Err.Raise ERR_INVALID_LISTITEM, , ERR_INVALID_LISTITEM_DESC
If Len(v) > 0 Then
If Len(TableName) Then
sAns = DoAutoBracket(TableName) & "."
End If
sItem = Trim(CStr(v))
sAns = sAns & DoAutoBracket(sItem)
pColFieldNames.Add sAns
sAns = ""
End If 'len(v)
Next v
Else
On Error Resume Next
v = FieldList(0)
lStartPoint = IIf(Err.Number = 0, 0, 1)
Err.Clear
On Error GoTo 0
For l = lStartPoint To UBound(FieldList)
sAns = ""
If Not ValidateValues(FieldList(l)) Then Err.Raise ERR_INVALID_LISTITEM, , ERR_INVALID_LISTITEM_DESC
If Len(FieldList(l)) > 0 Then
If Len(TableName) Then
sAns = sAns & DoAutoBracket(TableName) & "."
End If
sAns = sAns & DoAutoBracket(FieldList(l))
pColFieldNames.Add sAns
End If 'len(FieldList(l) > 0
Next
End If 'bcollection
End Sub
Public Sub ListAddValues(ByVal ValueList As Variant)
Dim bValid As Boolean
Dim bCollection As Boolean
Dim sAns As String
Dim l As Long
Dim sSplit() As String
Dim iCtr As Integer
Dim vTest As String
Dim lStart As Long
Dim v As Variant
Dim lStartPoint As Long
'PURPOSE: ADD A list of values to the values collection
'Values are for Update or Insert queries
'The List can be either an array or a collection
If IsObject(ValueList) Then
If TypeOf ValueList Is Collection Then
bValid = True
Else
bValid = False
End If
bCollection = True
Else
bValid = IsArray(ValueList)
End If
If Not bValid Then
Err.Raise ERR_LIST_REQUIRED, , ERR_LIST_REQUIRED_DESC
Exit Sub
End If
If bCollection Then
For Each v In ValueList
If Not ValidateValues(v) Then Err.Raise ERR_INVALID_LISTITEM, , ERR_INVALID_LISTITEM_DESC
If VarType(v) <> vbString Or Not pbAutoQuote Then
pColValues.Add v
Else
pColValues.Add prepStringForSQL(CStr(v))
End If
Next
Else
'Determine if we are dealing with 0 or 1 bound arrays
Err.Clear
On Error Resume Next
vTest = ValueList(0)
lStartPoint = IIf(Err.Number = 0, 0, 1)
Err.Clear
On Error GoTo 0
For l = lStartPoint To UBound(ValueList)
If Not ValidateValues(ValueList(l)) Then Err.Raise ERR_INVALID_LISTITEM, , ERR_INVALID_LISTITEM_DESC
sAns = ""
If VarType(ValueList(l)) <> vbString Or Not pbAutoQuote Then
pColValues.Add ValueList(l)
Else
pColValues.Add prepStringForSQL(CStr(ValueList(l)))
End If
Next
End If
End Sub
Public Sub Reset()
ClearFromClause
ClearWhereClause
ClearOrderClause
ClearFields
ClearValues
'key for field, value for value
piStatementType = TYPE_SELECT 'default
End Sub
Public Sub SetupJoin(ByVal Table1 As String, ByVal Field1 As String, ByVal Table2 As String, ByVal Field2 As String, Optional Op As CLAUSE_OPERATOR = CLAUSE_EQUALS, Optional JoinType As JOIN_TYPE)
'check for bracketing and add if not present
Dim sTable1 As String, sTable2 As String
Dim sField1 As String, sField2 As String
sTable1 = DoAutoBracket(Table1)
sTable2 = DoAutoBracket(Table2)
sField1 = DoAutoBracket(Field1)
sField2 = DoAutoBracket(Field2)
psJoinTables = sTable1 & Delimiter & sTable2
psJoinFields = sField1 & Delimiter & sField2
piJoinOp = Op
Select Case JoinType
Case Is <= 0, Is > FULL_JOIN
If piJoinType = 0 Then piJoinType = INNER_JOIN
Case FULL_JOIN
piJoinType = IIf(piSQLType = SQL_TYPE_ANSI, FULL_JOIN, IIf(piJoinType = 0, INNER_JOIN, piJoinType))
Case Else
piJoinType = JoinType
End Select
'reset other from related options
ReDim psTableNames(0) As String
psFromClause = ""
End Sub
'#########################################################################################
' Public Properties
'#########################################################################################
Public Property Get AutoBracket() As Boolean
AutoBracket = pbAutoBracket
End Property
Public Property Let AutoBracket(ByVal newValue As Boolean)
pbAutoBracket = newValue
End Property
Public Property Get AutoLike() As Boolean
AutoLike = pbAutoLike
End Property
Public Property Let AutoLike(ByVal newValue As Boolean)
pbAutoLike = newValue
End Property
Public Property Get AutoQuote() As Boolean
AutoQuote = pbAutoQuote
End Property
Public Property Let AutoQuote(ByVal newValue As Boolean)
pbAutoQuote = newValue
End Property
Public Property Let ComplexFromClause(ByVal newValue As String)
'reset everything else
Dim sWkg As String
Dim sSplit() As String
sWkg = Trim$(newValue)
If Left$(newValue, 4) = "FROM" Then
sSplit = Split(sWkg, "FROM")
psFromClause = Trim$(sSplit(1))
Else
psFromClause = sWkg
End If
'reset to defaults
ReDim psTableNames(0) As String
psJoinTables = ""
psJoinFields = ""
piJoinOp = CLAUSE_EQUALS
piJoinType = INNER_JOIN
End Property
Public Property Get ComplexFromClause() As String
ComplexFromClause = psFromClause
End Property
Public Property Get JoinType() As JOIN_TYPE
JoinType = piJoinType
End Property
Public Property Let JoinType(ByVal newValue As JOIN_TYPE)
If newValue >= INNER_JOIN And newValue <= FULL_JOIN Then
If newValue = FULL_JOIN And piSQLType = SQL_TYPE_ACCESS And piJoinType = 0 Then
piJoinType = INNER_JOIN
Else
piJoinType = newValue
End If
End If
End Property
Public Property Get StatementType() As STATEMENT_TYPE
StatementType = piStatementType
End Property
Public Property Let StatementType(ByVal newValue As STATEMENT_TYPE)
piStatementType = IIf(newValue <= TYPE_DELETE, newValue, TYPE_SELECT)
End Property
Public Property Get SQLType() As SQL_TYPE
SQLType = piSQLType
End Property
Public Property Let SQLType(ByVal newValue As SQL_TYPE)
If newValue = SQL_TYPE_ACCESS Or newValue = SQL_TYPE_ANSI Then piSQLType = newValue
End Property
Public Property Get SQL() As String
MakeStatement
SQL = psSQL
End Property
Public Property Get TableCount() As Long
Dim lAns As Long
If psTableNames(0) = "" And UBound(psTableNames) = 0 Then
TableCount = ComplexTableCount
Else
TableCount = UBound(psTableNames)
End If
End Property
'#########################################################################################
' Private Properties
'#########################################################################################
Private Property Get LikeCharacter() As String
LikeCharacter = IIf(piSQLType = SQL_TYPE_ACCESS, "*", "%")
End Property
'#########################################################################################
' Private Subroutines
'#########################################################################################
Private Sub MakeStatement()
Dim sAns As String
Dim sWhereClause As String
Dim sOrderClause As String
Dim sJoinClause As String
Dim sCommand As String
Dim i As Integer
Dim sOp As String
Dim sTemp As String
Dim sSplitTables() As String
Dim sSplitFields() As String
Dim lUpLimit As Long
Select Case piStatementType
Case TYPE_SELECT
If UBound(psTableNames) > 0 Or psJoinTables <> "" Or psFromClause <> "" Then
'MAKE SELECT CLAUSE
sCommand = "SELECT "
'RULES FROM FROM CLAUSES ARE:
'IF NOT JOINS OR COMPLEX FROM STATEMENTS,
'YOU CAN HAVE AS MANY TABLES AS YOU WANT:
'OTHERWISE, USE JUST ONE JOIN OR ONE COMPLEXFROM STATEMENT
'COLLISIONS:
'OR: GO WITH THE LATEST ADDED: WHEN ADDING OF ONE TYPE, CLEAR THE OTHER TWO
If pColFieldNames.Count = 0 Then
sCommand = sCommand & "* "
Else
For i = 1 To pColFieldNames.Count
sCommand = sCommand & pColFieldNames(i)
If i <> pColFieldNames.Count Then sCommand = sCommand & ","
sCommand = sCommand & " "
Next
End If
sCommand = sCommand & "FROM "
On Error Resume Next
If Len(psFromClause) > 0 Then
sCommand = sCommand & psFromClause
Else
If UBound(psTableNames) >= 1 Then
For i = 1 To UBound(psTableNames)
sCommand = sCommand & psTableNames(i)
If i <> UBound(psTableNames) Then sCommand = sCommand & ", "
Next
Else
sSplitTables = Split(psJoinTables, Delimiter)
sSplitFields = Split(psJoinFields, Delimiter)
sCommand = sCommand & sSplitTables(0)
sCommand = sCommand & " "
'FIX TO DEAL WITH JOIN TYPES
If piJoinType < 1 Or piJoinType > 4 Then piJoinType = INNER_JOIN
Select Case piJoinType
Case INNER_JOIN
If piSQLType = SQL_TYPE_ACCESS Then sCommand = sCommand & "INNER "
Case LEFT_JOIN
sCommand = sCommand & " LEFT "
Case RIGHT_JOIN
sCommand = sCommand & " RIGHT "
Case FULL_JOIN
sCommand = sCommand & IIf(piSQLType = SQL_TYPE_ACCESS, " INNER ", " FULL ")
End Select
sCommand = sCommand & "JOIN " & sSplitTables(1) & " ON "
If InStr(sSplitFields(0), ".") > 0 Then
sCommand = sCommand & sSplitFields(0)
Else
sCommand = sCommand & sSplitTables(0) & "." & sSplitFields(0)
End If
sCommand = sCommand & " " & TransformOp(piJoinOp) & " "
If InStr(sSplitFields(1), ".") > 0 Then
sCommand = sCommand & sSplitFields(1)
Else
sCommand = sCommand & sSplitTables(1) & "." & sSplitFields(1)
End If
End If
End If
End If 'first condition, testing for at least one table
Case TYPE_INSERT '?
If Trim(psTableNames(1)) = "" Then
Err.Raise ERR_TABLE_REQUIRED, , ERR_TABLE_REQUIRED_DESC
Exit Sub
End If
sCommand = "INSERT INTO " & psTableNames(1)
If pColFieldNames.Count > 0 Then
sCommand = sCommand & " ("
For i = 1 To pColFieldNames.Count
sCommand = sCommand & pColFieldNames(i)
If i <> pColFieldNames.Count Then sCommand = sCommand & ", "
Next
sCommand = sCommand & ")"
End If
If pColValues.Count > 0 Then
sCommand = sCommand & " VALUES ("
For i = 1 To pColValues.Count
sCommand = sCommand & pColValues(i)
If i <> pColValues.Count Then sCommand = sCommand & ", "
Next
sCommand = sCommand & ")"
End If
Case TYPE_UPDATE
If pColFieldNames.Count > 0 And pColValues.Count > 0 And psTableNames(1) <> "" Then
lUpLimit = IIf(pColFieldNames.Count > pColValues.Count, pColValues.Count, pColFieldNames.Count)
sCommand = "UPDATE " & psTableNames(1) & " SET "
For i = 1 To lUpLimit
sCommand = sCommand & pColFieldNames(i) & " = " & pColValues(i)
If i <> lUpLimit Then sCommand = sCommand & ", "
Next
End If
Case TYPE_DELETE
If psTableNames(1) <> "" Then
sCommand = "DELETE FROM " & psTableNames(1)
End If
End Select
If piStatementType <> TYPE_INSERT And sCommand <> "" Then
For i = 1 To pColWhereClauses.Count
If i = 1 Then
sWhereClause = "WHERE"
Else
sWhereClause = sWhereClause & IIf(piWhereLogic(i) = LOGIC_AND, " AND", " OR")
End If
sWhereClause = sWhereClause & " (" & pColWhereClauses.Item(i) & ")"
'If Not pbWhereClauseNumeric(i) Then sWhereClause = sWhereClause & "'"
Next
End If ' pistatement type <> ..
'ORDER CLAUSE
If piStatementType = TYPE_SELECT Then
For i = 1 To pColOrderClause.Count
If i = 1 Then sOrderClause = "ORDER BY "
sOrderClause = sOrderClause & pColOrderClause.Item(i)
If pbOrderByDesc(i) = True Then sOrderClause = sOrderClause & " DESC"
If i <> pColOrderClause.Count Then sOrderClause = sOrderClause & ", "
Next
End If
sAns = sCommand
If Len(sWhereClause) > 0 Then sAns = sAns & " " & sWhereClause
If Len(sOrderClause) > 0 Then sAns = sAns & " " & sOrderClause
psOrderClause = sOrderClause
psSQL = sAns
End Sub
'#########################################################################################
' Private Functions
'#########################################################################################
Private Function DistinctValues(InputArray As Variant) As String()
Dim asAns() As String
Dim lStartPoint As Long
Dim lEndPoint As Long
Dim lCount As Long
Dim Col As New Collection
Dim l As Long
Dim vTest As Variant
ReDim asAns(0) As String
lCount = UBound(InputArray)
On Error Resume Next
vTest = InputArray(0)
lStartPoint = IIf(Err.Number = 0, 0, 1)
Err.Clear
For l = lStartPoint To lCount
Col.Add 0, InputArray(l)
If Err.Number = 0 Then
If asAns(0) = "" Then
asAns(0) = InputArray(l)
Else
ReDim Preserve asAns(UBound(asAns) + 1) As String
asAns(UBound(asAns)) = InputArray(l)
End If
End If
Err.Clear
Next
DistinctValues = asAns
End Function
Private Function DoAutoBracket(ByVal DBObjectName As String) As String
Dim sSplit() As String
Dim sAns As String
Dim iCtr As Integer
If InStr(DBObjectName, ".") > 0 Then
sSplit = Split(DBObjectName, ".")
For iCtr = 0 To UBound(sSplit)
If InStr(sSplit(iCtr), " ") > 0 And InStr(sSplit(iCtr), "(") = 0 And InStr(sSplit(iCtr), ")") = 0 And InStr(sSplit(iCtr), "[") = 0 And pbAutoBracket Then
sAns = sAns & "[" & sSplit(iCtr) & "]"
Else
sAns = sAns & Trim(sSplit(iCtr))
End If
If iCtr < UBound(sSplit) Then sAns = sAns & "."
Next
Else
sAns = Trim(DBObjectName)
If InStr(sAns, " ") > 0 And InStr(sAns, "(") = 0 And Left$(sAns, 1) <> "[" And pbAutoBracket Then
sAns = "[" & sAns & "]"
End If
End If
DoAutoBracket = sAns
End Function
Private Function prepStringForSQL(ByVal sValue As String) As String
Dim sAns As String
sAns = Replace(sValue, Chr(39), "''")
sAns = "'" & sAns & "'"
prepStringForSQL = sAns
End Function
Private Function ComplexTableCount() As Long
Dim sSplit() As String
Dim sSplit2() As String
Dim sInput As String
Dim asTables() As String
Dim sFinal As String
Dim iCtr As Integer
Dim vUnique As Variant
Dim iPos As Integer
Dim lAns As Long
If psFromClause <> "" Then
sSplit = Split(psFromClause, " ")
ReDim asTables(0) As String
asTables(0) = sSplit(0)
sSplit = Split(psFromClause, "JOIN")
For iCtr = 1 To UBound(sSplit)
sSplit2 = Split(Trim$(sSplit(iCtr)), " ")
ReDim Preserve asTables(UBound(asTables) + 1)
asTables(UBound(asTables)) = sSplit2(0)
Next
vUnique = DistinctValues(asTables)
lAns = UBound(vUnique) + 1
ElseIf Trim$(psJoinTables) <> "" Then
sSplit = Split(psJoinTables, Delimiter)
vUnique = DistinctValues(sSplit)
lAns = UBound(vUnique) + 1
End If
ComplexTableCount = lAns
End Function
Private Function TablePresent(TableName As String) As Boolean
Dim iCtr As Integer
Dim bAns As Boolean
If UBound(psTableNames) = 0 Then Exit Function
For iCtr = 1 To UBound(psTableNames)
If TableName = psTableNames(iCtr) Then bAns = True
Next
TablePresent = bAns
End Function
Private Function TransformOp(Op As CLAUSE_OPERATOR) As String
Dim sOp As String
Select Case Op
Case CLAUSE_EQUALS
sOp = "="
Case CLAUSE_LIKE
sOp = "LIKE"
Case CLAUSE_STARTWITH
sOp = "LIKE"
Case CLAUSE_ENDWITH
sOp = "LIKE"
Case CLAUSE_GREATERTHAN
sOp = ">"
Case CLAUSE_LESSTHAN
sOp = "<"
Case CLAUSE_GREATERTHANOREQUAL
sOp = ">="
Case CLAUSE_LESSTHANOREQUAL
sOp = "<="
Case CLAUSE_DOESNOTEQUAL
sOp = "<>"
Case Else
sOp = "="
End Select
TransformOp = sOp
End Function
Private Function ValidateValues(Values As Variant) As Boolean
'Purpose: Determines if a collection, variant array, or single value
'has valid values for an SQL String
Dim bCollection As Boolean
Dim iBadVarTypes(4) As Integer
Dim v As Variant
Dim i As Integer
Dim lCtr As Long
Dim lListCount As Long
Dim lStartPoint As Long
Dim iCount As Integer
Dim bAns As Boolean
iBadVarTypes(0) = vbObject
iBadVarTypes(1) = vbError
iBadVarTypes(2) = vbDataObject
iBadVarTypes(3) = vbUserDefinedType
iBadVarTypes(4) = vbArray
bAns = True
iCount = UBound(iBadVarTypes)
If IsObject(Values) Then
If Not TypeOf Values Is Collection Then
ValidateValues = False
Exit Function
End If
Else
If Not VarType(Values) = vbArray Then
For i = 0 To iCount
If VarType(Values) = iBadVarTypes(i) Then
bAns = False
Exit For
End If
Next
ValidateValues = bAns
Exit Function
End If
End If
bCollection = IsObject(Values) 'has to be collection
If bCollection Then
For Each v In Values
For i = 1 To iCount
If VarType(v) = iBadVarTypes(i) Or VarType(v) = iBadVarTypes(i) + vbVariant Then
bAns = False
Exit For
End If
Next
If bAns = False Then Exit For
Next
Else
lListCount = UBound(Values)
On Error Resume Next
v = Values(0)
lStartPoint = IIf(Err.Number = 0, 0, 1)
Err.Clear
On Error GoTo 0
For lCtr = lStartPoint To lListCount
For i = 1 To iCount
If VarType(Values(lCtr)) = iBadVarTypes(i) Or VarType(v) = iBadVarTypes(i) + vbVariant Then
bAns = False
Exit For
End If
Next
If bAns = False Then Exit For
Next
End If
ValidateValues = bAns
End Function
Private Sub Class_Initialize()
Reset
pbAutoLike = True
pbAutoQuote = True
piSQLType = SQL_TYPE_ANSI
pbAutoBracket = True
End Sub