forked from AllenMattson/VBA_personal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Connection.vb
153 lines (101 loc) · 3.89 KB
/
Connection.vb
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
Option Explicit
'---------------------------------------------------------------------------------------
' Method : CompareVersions
' Author : v.doynov
' Date : 08.12.2016
' Purpose: Two public subs - PostInfo and CompareVersions
'---------------------------------------------------------------------------------------
Private version_sql As String
Private date_sql As Date
Public Function CompareVersions() As Boolean
If (Me.DateSQL = Me.DateWorkbook) And (Me.VersionSQL = Me.VersionWorkbook) Then
CompareVersions = True
Else
CompareVersions = False
End If
End Function
Private Function str_connection_string() As String
Dim arr_info(5) As Variant
arr_info(0) = [set_conn_provider]
arr_info(1) = [set_conn_data_source]
arr_info(2) = [set_conn_database]
arr_info(3) = [set_conn_user_id]
arr_info(4) = [set_conn_password]
str_connection_string = "Provider=" & arr_info(0) & _
"; Data Source=" & arr_info(1) & _
"; Database=" & arr_info(2) & _
";User ID=" & str_generator(arr_info(3), True) & _
"; Password=" & str_generator(arr_info(4), True) & ";"
End Function
Private Function str_generator(ByVal str_value As String, ByVal b_fix As Boolean) As String
Dim l_counter As Long
Dim l_number As Long
Dim str_char As String
On Error GoTo str_generator_Error
If b_fix Then
str_value = Left(str_value, Len(str_value) - 1)
str_value = Right(str_value, Len(str_value) - 1)
End If
For l_counter = 1 To Len(str_value)
str_char = Mid(str_value, l_counter, 1)
If b_is_odd(l_counter) Then
l_number = Asc(str_char) + IIf(b_fix, -2, 2)
Else
l_number = Asc(str_char) + IIf(b_fix, -3, 3)
End If
str_generator = str_generator + Chr(l_number)
Next l_counter
If Not b_fix Then
str_generator = Chr(l_number) & str_generator & Chr(l_number)
End If
On Error GoTo 0
Exit Function
str_generator_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure str_generator of Function Modul1"
End Function
Private Function b_is_odd(l_number As Long) As Boolean
b_is_odd = l_number Mod 2
End Function
Public Property Get VersionWorkbook() As String
VersionWorkbook = [set_version_number]
End Property
Public Property Get DateWorkbook() As Date
DateWorkbook = [set_version_date]
End Property
Public Property Get VersionSQL() As String
VersionSQL = version_sql
End Property
Public Property Get DateSQL() As Date
DateSQL = date_sql
End Property
Public Function str_post_info() As String
str_post_info = " Diese Version ist - " & Me.VersionWorkbook & " von " & Me.DateWorkbook & "." & vbCrLf & _
" Die letzte ist - " & Me.VersionSQL & " von " & Me.DateSQL & "."
End Function
Public Sub GetDataFromSQLServer()
If [set_in_production] Then On Error GoTo GetDataFromSQLServer_Error
Dim cnLogs As Object
Dim rsData As Object
Set cnLogs = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
cnLogs.Open str_connection_string
cnLogs.Execute "SET NOCOUNT ON"
With rsData
.ActiveConnection = cnLogs
.Open "SELECT [VersionNumber],[MyDate] FROM [Versions] WHERE IsLastCurrent=1;"
version_sql = rsData.Fields("VersionNumber").value
date_sql = rsData.Fields("MyDate").value
End With
rsData.Close
cnLogs.Close
Set cnLogs = Nothing
Set rsData = Nothing
On Error GoTo 0
Exit Sub
GetDataFromSQLServer_Error:
Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure GetDataFromSQLServer of Sub cls_Version"
Set cnLogs = Nothing
Set rsData = Nothing
version_sql = [set_version_check_error]
date_sql = [set_version_check_error]
End Sub