Skip to content

Commit e0b35bb

Browse files
committed
V 1.7.1 (fixed: add-in version in reg) + SVN rev 560
1 parent 39df86a commit e0b35bb

File tree

4 files changed

+104
-22
lines changed

4 files changed

+104
-22
lines changed
12 KB
Binary file not shown.

source/_config_Application.bas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ Option Explicit
2323
Option Private Module
2424

2525
'Versionsnummer
26-
Private Const APPLICATION_VERSION As String = "1.7.0" '2022-12-25
26+
Private Const APPLICATION_VERSION As String = "1.7.1" '2023-03-01
2727

2828
#Const USE_CLASS_APPLICATIONHANDLER_APPFILE = 1
2929
#Const USE_CLASS_APPLICATIONHANDLER_VERSION = 1
Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
Attribute VB_Name = "_initApplication"
2+
'---------------------------------------------------------------------------------------
3+
' Modul: _initApplication (2009-07-08)
4+
'---------------------------------------------------------------------------------------
5+
'/**
6+
' <summary>
7+
' Initialisierungsaufruf der Anwendung
8+
' </summary>
9+
' <remarks>
10+
' </remarks>
11+
' \ingroup base
12+
' @todo StartApplication-Prozedur für allgemeine Verwendung umschreiben => in Klasse verlagern
13+
'**/
14+
'---------------------------------------------------------------------------------------
15+
'<codelib>
16+
' <file>base/_initApplication.bas</file>
17+
' <license>_codelib/license.bas</license>
18+
' <use>base/modApplication.bas</use>
19+
' <use>base/defGlobal.bas</use>
20+
'</codelib>
21+
'---------------------------------------------------------------------------------------
22+
'
23+
Option Compare Text
24+
Option Explicit
25+
Option Private Module
26+
27+
'-------------------------
28+
' Anwendungseinstellungen
29+
'-------------------------
30+
'
31+
' => siehe _config_Application
32+
'
33+
'-------------------------
34+
35+
'---------------------------------------------------------------------------------------
36+
' Function: StartApplication
37+
'---------------------------------------------------------------------------------------
38+
'/**
39+
' <summary>
40+
' Prozedur für den Anwendungsstart
41+
' </summary>
42+
' <returns>Boolean</returns>
43+
' <remarks>
44+
' </remarks>
45+
'**/
46+
'---------------------------------------------------------------------------------------
47+
Public Function StartApplication() As Boolean
48+
49+
On Error GoTo HandleErr
50+
51+
StartApplication = CurrentApplication.Start
52+
53+
ExitHere:
54+
Exit Function
55+
56+
HandleErr:
57+
StartApplication = False
58+
MsgBox "Anwendung kann nicht gestartet werden.", vbCritical, CurrentApplicationName
59+
Application.Quit acQuitSaveNone
60+
Resume ExitHere
61+
62+
End Function
63+
64+
Public Sub RestoreApplicationDefaultSettings()
65+
On Error Resume Next
66+
CurrentApplication.ApplicationTitle = CurrentApplication.ApplicationFullName
67+
End Sub

source/codelib/data/SqlTools.cls

Lines changed: 36 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -403,7 +403,7 @@ Public Function BuildCriteria(ByVal FieldName As String, ByVal FieldDataType As
403403
ByVal RelationalOperator As SqlRelationalOperators, _
404404
ByVal FilterValue As Variant, _
405405
Optional ByVal FilterValue2 As Variant = Null, _
406-
Optional ByVal IgnoreValue As Variant = Null, _
406+
Optional ByVal IgnoreValue As Variant, _
407407
Optional ByVal DisableIgnoreNullValue As Boolean = False) As String
408408

409409
Dim FilterValueString As String
@@ -412,13 +412,20 @@ Public Function BuildCriteria(ByVal FieldName As String, ByVal FieldDataType As
412412
Dim Criteria1 As String
413413
Dim Criteria2 As String
414414
Dim TempArr() As String
415-
415+
416416
If (RelationalOperator And [_IgnoreAll]) = [_IgnoreAll] Then
417417
Exit Function
418418
End If
419419

420+
If IsMissing(IgnoreValue) Then
421+
If Not DisableIgnoreNullValue Then
422+
DisableIgnoreNullValue = True
423+
End If
424+
IgnoreValue = Null
425+
End If
426+
420427
If Not IsArray(FilterValue) Then
421-
428+
422429
If FilterValue = "{NULL}" Or FilterValue = "{LEER}" Or FilterValue = "{EMPTY}" Then
423430
FilterValue = Null
424431
DisableIgnoreNullValue = True
@@ -536,9 +543,9 @@ Public Function BuildCriteria(ByVal FieldName As String, ByVal FieldDataType As
536543
If (RelationalOperator And SQL_GreaterThan) = SQL_GreaterThan Then
537544
' nichts ändern => >= DataValue / SQL_Add_WildCardSuffix ist nicht logisch
538545
Else ' ganzen Tag berücksichtigen FieldName >= DateValue and FieldName < DateAdd("d", 1, FilterValue))
539-
BuildCriteria = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue) & _
546+
BuildCriteria = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue, , , False) & _
540547
SqlAndConcatString & _
541-
BuildCriteria(FieldName, FieldDataType, SQL_LessThan, DateAdd("d", 1, CDate(CLng(FilterValue))))
548+
BuildCriteria(FieldName, FieldDataType, SQL_LessThan, DateAdd("d", 1, CDate(CLng(FilterValue))), , , False)
542549
Exit Function
543550
End If
544551
Else
@@ -563,11 +570,11 @@ Public Function BuildCriteria(ByVal FieldName As String, ByVal FieldDataType As
563570
Else
564571
FilterValue2 = Replace(FilterValue, "*", vbNullString)
565572
End If
566-
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan, GetNextDigitNumber(FilterValue, True))
567-
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan + SQL_Equal, FilterValue2)
573+
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan, GetNextDigitNumber(FilterValue, True), , Null, False)
574+
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan + SQL_Equal, FilterValue2, , Null, False)
568575
Else
569-
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue)
570-
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan, GetNextDigitNumber(FilterValue))
576+
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue, , Null, False)
577+
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan, GetNextDigitNumber(FilterValue), , Null, False)
571578
End If
572579
BuildCriteria = Criteria1 & SqlAndConcatString & Criteria2
573580
Exit Function
@@ -793,7 +800,7 @@ Private Function TryBuildArrayCriteria(ByRef FieldName As String, ByVal FieldDat
793800

794801
'Kriterien über Or verbinden
795802
For Each itm In FilterValue
796-
ItmCriteria = BuildCriteria(FieldName, FieldDataType, RelationalOperator, itm, , IgnoreValue)
803+
ItmCriteria = BuildCriteria(FieldName, FieldDataType, RelationalOperator, itm, , IgnoreValue, False)
797804
If Len(ItmCriteria) > 0 Then
798805
Criteria = Criteria & SqlOrConcatString & ItmCriteria
799806
End If
@@ -821,8 +828,16 @@ Private Function TryBuildInCriteria(ByRef FieldName As String, ByVal FieldDataTy
821828

822829
If IsArray(FilterValue) Then
823830
FilterValueString = GetValueArrayString(FilterValue, FieldDataType, ",", IgnoreValue)
824-
ElseIf VarType(FilterValue) = vbString Then ' Value ist bereits die Auflistung als String
825-
FilterValueString = FilterValue
831+
ElseIf VarType(FilterValue) = vbString Then
832+
If FieldDataType = SQL_Text Then
833+
If Left(FilterValue, 1) = "'" Then ' schon als SQL-Text im FilterString
834+
FilterValueString = FilterValue
835+
Else
836+
FilterValueString = ConvertToSqlText(FilterValue, FieldDataType)
837+
End If
838+
Else
839+
FilterValueString = FilterValue ' Value ist bereits in der Auflistung als String
840+
End If
826841
Else
827842
FilterValueString = ConvertToSqlText(FilterValue, FieldDataType)
828843
End If
@@ -865,8 +880,8 @@ Private Function TryBuildBetweenCriteria(ByRef FieldName As String, ByVal FieldD
865880
End If
866881

867882
If (RelationalOperator And SQL_Not) = SQL_Not Then 'Bedingung umdrehen
868-
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan, FilterValue, , IgnoreValue)
869-
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan, FilterValue2, , IgnoreValue)
883+
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan, FilterValue, , IgnoreValue, False)
884+
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan, FilterValue2, , IgnoreValue, False)
870885
Criteria = Criteria1 & SqlAndConcatString & Criteria2
871886
TryBuildBetweenCriteria = True
872887
Exit Function
@@ -877,8 +892,8 @@ Private Function TryBuildBetweenCriteria(ByRef FieldName As String, ByVal FieldD
877892
FilterValue2 = Mid(FilterValue2, 3)
878893
ElseIf FilterValue2 Like "<*" Then
879894
FilterValue2 = Mid(FilterValue2, 2)
880-
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue)
881-
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan, FilterValue2)
895+
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue, , Null, False)
896+
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan, FilterValue2, , Null, False)
882897
Criteria = Criteria1 & SqlAndConcatString & Criteria2
883898
TryBuildBetweenCriteria = True
884899
Exit Function
@@ -892,14 +907,14 @@ Private Function TryBuildBetweenCriteria(ByRef FieldName As String, ByVal FieldD
892907
FilterValue = FilterValue2
893908
FilterValue2 = GetCheckedIgnoreValue(IgnoreValue)
894909
ElseIf (FieldDataType And SQL_Date) = SQL_Date And (RelationalOperator And SQL_Add_WildCardSuffix) Then
895-
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue)
896-
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan + SQL_Equal + SQL_Add_WildCardSuffix, FilterValue2)
910+
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue, , Null, False)
911+
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan + SQL_Equal + SQL_Add_WildCardSuffix, FilterValue2, , Null, False)
897912
Criteria = Criteria1 & SqlAndConcatString & Criteria2
898913
TryBuildBetweenCriteria = True
899914
Exit Function
900915
ElseIf (FieldDataType And SQL_Numeric) = SQL_Numeric And (RelationalOperator And SQL_Add_WildCardSuffix) Then
901-
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue)
902-
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan + SQL_Equal + SQL_Add_WildCardSuffix, FilterValue2)
916+
Criteria1 = BuildCriteria(FieldName, FieldDataType, SQL_GreaterThan + SQL_Equal, FilterValue, , Null, False)
917+
Criteria2 = BuildCriteria(FieldName, FieldDataType, SQL_LessThan + SQL_Equal + SQL_Add_WildCardSuffix, FilterValue2, , Null, False)
903918
Criteria = Criteria1 & SqlAndConcatString & Criteria2
904919
TryBuildBetweenCriteria = True
905920
Exit Function
@@ -920,7 +935,7 @@ Private Function GetCheckedIgnoreValue(ByVal IgnoreValue As Variant) As Variant
920935
End Function
921936

922937
Private Function NullFilterOrEmptyFilter(ByVal FieldName As String, ByVal FieldDataType As SqlFieldDataType, _
923-
ByVal RelationalOperator As SqlRelationalOperators, _
938+
ByVal RelationalOperator As SqlRelationalOperators, _
924939
ByVal Value As Variant, ByVal IgnoreValue As Variant, _
925940
ByRef NullFilterString As String, _
926941
Optional ByVal DisableIgnoreNullValue As Boolean = False) As Boolean

0 commit comments

Comments
 (0)