'****************************************************Описание****************
**************************************************
' 08.02.2006
' Класс позволяет соединяться с SQL хранилищем и выполнять запросы.
' Все функции возвращают true, в случае удачи, или false, в случае неудачи.
' В случае возникновения ошибок переменной "ErrorString" присваивается соответствующий текст.
'****************************************************************************
******************************************************
Class ADOConnect
con As Variant
ErrorString As String
ErrorNum As Long
Sub new
ErrorString = ""
End Sub
Property Get GetErrorString As String
GetErrorString = ErrorString
End Property
Property Get GetErrorNum As Long
GetErrorNum = ErrorNum
End Property
Function OpenConnectWithODBC(ODBCName As String, UserName As String, Password As String) As Boolean
'****************************************************Описание****************
**************************************************
' Фунция соединяется с ODBC источником
' Возвращаемое значение: true - если все нормально; false - если произошла ошибка.
' В случае неудачного подключения к ODBC источнику
' переменной "ErrorString" присваивается соответствующий текст
'****************************************************************************
******************************************************
On Error Goto errorhandler
OpenConnectWithODBC = False
Set con = CreateObject("ADODB.Connection")
Con.ConnectionString = "Data Source=" & ODBCName & ";UID=" & UserName & ";PWD=" & Password
Con.Open
OpenConnectWithODBC = True
Ex:
Exit Function
errorhandler:
ErrorString = "ADOConnect: OpenConnectWithODBC: Не удалось подключиться к ODBC источнику" &_
". Код ошибки: " & Cstr(con.Errors.Item(0).Number) &_
". Ошибка: " & con.Errors.Item(0).Description
ErrorNum = con.Errors.Item(0).Number
con.Errors.Clear
Resume ex
End Function
Function OpenConnectWithDBName(ServerName As String, DBName As String, UserName As String, Password As String) As Boolean
'****************************************************Описание****************
**************************************************
' Фунция соединяется с SQL хранилищем напрямую, минуя ODBC
' Возвращаемое значение: true - если все нормально; false - если произошла ошибка.
' В случае неудачного подключения к ODBC источнику
' переменной "ErrorString" присваивается соответствующий текст
'****************************************************************************
******************************************************
On Error Goto errorhandler
Dim conStr As String
OpenConnectWithDBName = False
Set con = CreateObject("ADODB.Connection")
conStr = "Provider=SQLOLEDB.1;Password=" & Password &_
";Persist Security Info=True;User ID=" & UserName &_
";Initial Catalog=" & DBName &_
";Data Source=" & ServerName
Con.ConnectionString = conStr
Con.Open
OpenConnectWithDBName = True
Ex:
Exit Function
errorhandler:
ErrorString = "ADOConnect: OpenConnectWithDBName: Не удалось подключиться к бд" &_
". Код ошибки: " & Cstr(con.Errors.Item(0).Number) &_
". Ошибка: " & con.Errors.Item(0).Description
ErrorNum = con.Errors.Item(0).Number
con.Errors.Clear
Resume ex
End Function
Function ExecSQLQuery(SQLQuery As String) As Boolean
'****************************************************Описание****************
**************************************************
' Фунция выполняет sql команду. Данные не возвращает!
' Возвращаемое значение: true - если все нормально; false - если произошла ошибка.
' В случае возникновения ошибки переменной "ErrorString" присваивается соответствующий текст.
'****************************************************************************
******************************************************
On Error Goto errorhandler
ExecSQLQuery = False
con.Execute SQLQuery, , 1
'If Len(con.Errors.Item(0).Description) > 0 Then Error 2006
ExecSQLQuery = True
Ex:
Exit Function
errorhandler:
ErrorString = "ADOConnect: ExecSQLQuery: Не удалось выполнить sql команду" &_
". Код ошибки: " & Cstr(con.Errors.Item(0).Number) &_
". Ошибка: " & con.Errors.Item(0).Description
ErrorNum = con.Errors.Item(0).Number
con.Errors.Clear
Resume ex
End Function
Function ExecStoredProcedure(StoredProcedureName As String) As Boolean
'****************************************************Описание****************
**************************************************
' Фунция выполняет хранимую процедуру.
' Возвращаемое значение: true - если все нормально; false - если произошла ошибка.
' В случае возникновения ошибки переменной "ErrorString" присваивается соответствующий текст.
'****************************************************************************
******************************************************
On Error Goto errorhandler
ExecStoredProcedure = False
con.Execute StoredProcedureName, , 4
'If con.Errors.Count > 0 Then
' Goto errorhandler
'End If
ExecStoredProcedure = True
Ex:
Exit Function
errorhandler:
ErrorString = "ADOConnect: ExecStoredProcedure: Не удалось выполнить хранимую процедуру" &_
". Код ошибки: " & Cstr(con.Errors.Item(0).Number) &_
". Ошибка: " & con.Errors.Item(0).Description
ErrorNum = con.Errors.Item(0).Number
con.Errors.Clear
Resume ex
End Function
Function CloseConnect As Boolean
'****************************************************Описание****************
**************************************************
' Фунция отключает от источника.
' Возвращаемое значение: true - если все нормально; false - если произошла ошибка.
'****************************************************************************
******************************************************
On Error Goto errorhandler
CloseConnect = False
con.Close
'Delete con
CloseConnect =True
Ex:
Exit Function
errorhandler:
ErrorString = "ADOConnect: CloseConnect: Не удалось отключиться к ODBC источника" &_
". Код ошибки: " & Cstr(con.Errors.Item(0).Number) &_
". Ошибка: " & con.Errors.Item(0).Description
ErrorNum = con.Errors.Item(0).Number
con.Errors.Clear
Resume ex
End Function
End Class
