Component File /DataStoreClass.vb (VB.NET)
1: Option Strict Off
2: Option Explicit On
3: Friend Class DataStoreClass
4: 'Set up the data connection
5: 'Private Function SetupDataConnection() As ADODB.Connection
6: Public DatabaseConnectionString As String
7:
8: Public Sub SetConnectionString(ByRef ConnectionString As String)
9:
10: 'DataConnection.ConnectionString = ConnectionString
11: DatabaseConnectionString = ConnectionString
12: 'DataConnection.Mode = adModeShareDenyNone
13: 'DataConnection.Open
14:
15: End Sub
16:
17:
18: 'UPGRADE_NOTE: Class_Terminate was upgraded to Class_Terminate_Renamed. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"'
19: Private Sub Class_Terminate_Renamed()
20:
21: ' If DataConnection.State =
22: ' DataConnection.Close
23: ' Set DataConnection = Nothing
24:
25: End Sub
26: Protected Overrides Sub Finalize()
27: Class_Terminate_Renamed()
28: MyBase.Finalize()
29: End Sub
30: Public Function ExecuteSQL(ByRef SQLStatement As String) As Boolean
31: Dim SQL As Object
32: Dim ConnectionDatabaseName As Object
33: Dim DataError As Object
34:
35: On Error Resume Next
36:
37: Dim DataConnection As New ADODB.Connection
38: Dim HasDatabaseConnectionError As Boolean
39: Dim HasDatabaseSQLError As Boolean
40:
41: DataConnection.ConnectionString = DatabaseConnectionString
42: DataConnection.Open(DatabaseConnectionString) ', adOpenForwardOnly, adLockReadOnly
43:
44: If DataConnection.State = 0 Then
45: FormMain.DefInstance.UpdateStatus(("Cannot open the DataStore"))
46: Call AppendToLogFile(CurrentLogFileName, "ERROR: Cannot open the DataStore " & vbCrLf)
47:
48: If DataConnection.Errors.Count > 0 Then
49: For Each DataError In DataConnection.Errors
50:
51: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
52: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: DataStore error: " & DataError & vbCrLf)
53:
54: Next DataError
55: End If
56:
57: HasDatabaseConnectionError = True
58: Else
59: HasDatabaseConnectionError = False
60: End If
61:
62: If HasDatabaseConnectionError = False Then
63:
64: DataConnection.Execute(SQLStatement)
65:
66: If DataConnection.Errors.Count > 0 Then
67: 'UPGRADE_WARNING: Couldn't resolve default property of object ConnectionDatabaseName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
68: FormMain.DefInstance.UpdateStatus(("Problem with SQL statement (see log) " & ConnectionDatabaseName))
69: 'UPGRADE_WARNING: Couldn't resolve default property of object SQL. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
70: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: Problem executing the SQL statement: " & SQL & vbCrLf)
71:
72: If DataConnection.Errors.Count > 0 Then
73: For Each DataError In DataConnection.Errors
74:
75: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
76: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: SQL Server error: " & DataError & vbCrLf)
77:
78: Next DataError
79: End If
80:
81: HasDatabaseSQLError = True
82: ExecuteSQL = False
83: Else
84: HasDatabaseSQLError = False
85: ExecuteSQL = True
86: End If
87:
88: If HasDatabaseSQLError = False Then
89:
90: Else
91:
92: ExecuteSQL = False
93:
94: End If
95:
96: End If
97:
98: DataConnection.Close()
99: 'UPGRADE_NOTE: Object DataConnection may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
100: DataConnection = Nothing
101:
102: End Function
103: Public Function ExecuteSQLReturnIdentity(ByRef SQLStatement As String) As Integer
104:
105: Dim DataConnection As New ADODB.Connection
106: Dim RS As New ADODB.Recordset
107: Dim HasDatabaseConnectionError As Boolean
108: Dim HasDatabaseSQLError As Boolean
109:
110: DataConnection.ConnectionString = DatabaseConnectionString
111: DataConnection.Open(DatabaseConnectionString) ', adOpenForwardOnly, adLockReadOnly
112: DataConnection.Execute(SQLStatement)
113: RS = DataConnection.Execute("select @@identity")
114: ExecuteSQLReturnIdentity = RS.Fields(0).Value
115: DataConnection.Close()
116: 'UPGRADE_NOTE: Object DataConnection may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
117: DataConnection = Nothing
118:
119: 'ExecuteSQL = True
120:
121: End Function
122:
123: Public Function ExecuteSQLReturnSingleValue(ByRef SQLStatement As String, ByRef ColumnName As String) As String
124:
125: On Error Resume Next
126:
127: ' Dim RS As New ADODB.Recordset
128: 'Dim DataConnection As New ADODB.Connection
129: Dim ReturnValue As String
130: 'DataConnection.ConnectionString = DatabaseConnectionString
131: 'DataConnection.Open DatabaseConnectionString ', adOpenForwardOnly, adLockReadOnly
132: Dim DataConnection As New ADODB.Connection
133: Dim RS As New ADODB.Recordset
134: Dim HasDatabaseConnectionError As Boolean
135: Dim HasDatabaseSQLError As Boolean
136:
137: DataConnection.ConnectionString = DatabaseConnectionString
138: DataConnection.Open(DatabaseConnectionString) ', adOpenForwardOnly, adLockReadOnly
139: RS = DataConnection.Execute(SQLStatement)
140:
141: Do While Not RS.EOF
142: 'i = i + 1
143: 'Debug.Print RS.Fields("ProjectName").Value
144:
145: ReturnValue = RS.Fields(ColumnName).Value
146:
147: RS.MoveNext()
148: Loop
149: 'RS.Close
150: DataConnection.Close()
151: 'UPGRADE_NOTE: Object DataConnection may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
152: DataConnection = Nothing
153: ExecuteSQLReturnSingleValue = ReturnValue
154:
155: End Function
156:
157:
158: Public Function GetRecordSet(ByRef SQLStatement As String) As ADODB.Recordset
159: Dim DataError As Object
160:
161: On Error Resume Next
162: 'See http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbcon98/html/vbconremotingfeaturesofvisualbasic.asp
163: 'for how to return recordsets from functions!
164:
165: Dim RS As New ADODB.Recordset
166: Dim DataConnection As New ADODB.Connection
167: Dim HasDatabaseConnectionError As Boolean
168: Dim HasDatabaseSQLError As Boolean
169:
170: DataConnection.ConnectionString = DatabaseConnectionString
171: DataConnection.Open(DatabaseConnectionString) ', adOpenForwardOnly, adLockReadOnly
172:
173: If DataConnection.State = 0 Then
174: FormMain.DefInstance.UpdateStatus(("Cannot open the DataStore"))
175: Call AppendToLogFile(CurrentLogFileName, "ERROR: Cannot open the DataStore " & vbCrLf)
176:
177: If DataConnection.Errors.Count > 0 Then
178: For Each DataError In DataConnection.Errors
179:
180: 'UPGRADE_WARNING: Couldn't resolve default property of object DataError. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
181: Call AppendToLogFile(CurrentLogFileName, vbTab & "ERROR: DataStore error: " & DataError & vbCrLf)
182:
183: Next DataError
184: End If
185:
186: HasDatabaseConnectionError = True
187: Else
188: HasDatabaseConnectionError = False
189: End If
190:
191: If HasDatabaseConnectionError = False Then
192:
193: RS = DataConnection.Execute(SQLStatement)
194:
195: End If
196: 'GetRecordSet = RS.RecordCount
197: 'RS.Open SQLStatement, DataConnection, adOpenForwardOnly, adLockReadOnly
198:
199: 'DataConnection.Errors
200: 'Errors = DataConnection.Errors
201:
202: 'If DataConnection.Errors.Count > 0 Then
203: 'For Each DBError In DataConnection.Errors
204:
205: 'Debug.Print DBError.Description
206:
207: 'Next
208:
209: 'End If
210: 'i = 0
211: 'Do While Not RS.EOF
212: 'i = i + 1
213: 'Debug.Print RS.Fields("ProjectName").Value
214:
215: ' RS.MoveNext
216: ' Loop
217: 'RS.Close
218: ' Set RS.ActiveConnection = Nothing
219:
220: GetRecordSet = RS
221:
222: End Function
223: End Class