|
MySQL.RU - Webboard
 Вернуться
 Visual Basic & MySQL (evgm) 17/11/2005 - 15:41:01
 Re: Visual Basic & MySQL (Lev) 17/11/2005 - 18:09:56
Re: Visual Basic & MySQL (evgm) 24/11/2005 - 12:47:47
Re: Visual Basic & MySQL (Lev) 24/11/2005 - 19:03:50
Re: Visual Basic & MySQL (Lev) 29/11/2005 - 19:15:48
Re: Visual Basic & MySQL (alexenin) 04/12/2005 - 20:58:48
> Original message text:
> From: evgm - 17/11/2005 - 15:41:01
> Subject:Visual Basic & MySQL
> -----------------
> Привет всем.
> CN.ConnectionString = "DRIVER=MySQL ODBC 3.51 Driver;SERVER=127.0.0.1;DATABASE=db1;UID=mysql;PWD=test"
>
> CN.Open
> RS.Open("SELECT * FROM table1;", CN, adOpenKeyset,
> ~~~~~~~~~~~~
> adLockOptimistic, adCmdText)
>
> Debug.Print RS.CursorType
> adOpenStatic !!!!
>
> и никак немогу побороть - всегда static - хоть что укажи при Open
> как быть?? что не так делаю??? раньше всегда все работало на ура
> заранее спасибо
> сервер, если что - 5.0.7-beta-max
>
From: alexenin - 04/12/2005 - 20:58:48
Subject:Visual Basic & MySQL
-----------------
Может поможет? Нужно было как-то написать модуль для работы с MySQL-5.0.9-beta и с .mdb из-под MS Access, вот остались наработки
Option Compare Database
'Глобальная переменная. Используется для открытого соединения с базой
Global MyConnectDB As New ADODB.Connection
Global MyRecordset As ADODB.Recordset
Global MyRecordsetField As ADODB.Recordset
Global ConnDBstring As String
Global rec_current As Long
Global Name_ID_Base As String
Global ShowErrors As Boolean
Public Function SQL_CONNECT_OF_NAME(Name_BASE As String) As ADODB.ObjectStateEnum
Dim dbname As String
Dim sql_string As String
Dim yy As Integer
Dim rst As ADODB.Recordset
err.Clear
dbname = CurrentPath() & "config.mde"
'Открываем заново связь с базой данных. Строка подключения находится в СписокБазДанных
Name_ID_Base = ""
SQL_CONNECT_OPEN ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbname & ";")
If err.Number > 0 And err.Number <> 3265 And err.Number <> 2046 And err.Number <> 92 Then
SQL_CONNECT_OF_NAME = adStateClosed
'MsgBox err.Function
If Not (ShowErrors) Then
yy = MsgBox("Ошибка подключения к конфигуратору." + vbNewLine + err.Description + vbNewLine + _
"Выводить последующие ошибки?", vbCritical + vbYesNo, "Ошибка подключения")
If yy = vbYes Then
ShowErrors = False
Else
ShowErrors = True
End If
End If
Exit Function
End If
err.Clear
sql_string = "SELECT type, connections_string " _
& "FROM Connections " _
& "WHERE name='" & Name_BASE & "';"
If (SQL_QUERY(sql_string) = adStateOpen) Then
Set rst = New ADODB.Recordset
'Получить набор записей
Set rst = SQL_GETRECORDSET
If rst.RecordCount > 0 Then
If rst("type").value Then
Name_ID_Base = Name_BASE
Else
Name_ID_Base = ""
End If
dbname = rst("connections_string").value
SQL_CONNECT_CLOSE
SQL_CONNECT_OF_NAME = SQL_CONNECT_OPEN(dbname)
End If
Else
SQL_CONNECT_OF_NAME = adStateClosed
If Not (ShowErrors) Then
yy = MsgBox("Ошибка подключения к базе данных " & Name_BASE & "." + vbNewLine + _
"Выводить последующие ошибки?", vbCritical + vbYesNo, "Ошибка подключения")
If yy = vbYes Then
ShowErrors = False
Else
ShowErrors = True
End If
End If
End If
End Function
Public Function SQL_CONNECT_OPEN(Connect_String As String) As ADODB.ObjectStateEnum
'Подключение к БД MySQL через ODBC
'Возвращаемое значение - статус подключения
If MyConnectDB.State = adStateOpen Then MyConnectDB.Close
' Если строка Connect_String пустая, то использовать подключение по умолчанию
If (Len(Connect_String) > 0) Then
MyConnectDB.Open Connect_String
ConnDBstring = Connect_String
Else
'Если глобальная переменная определена, то подключение делать по ней
If (Len(ConnDBstring) > 0) Then
Connect_String = ConnDBstring
Else
Connect_String = DLookup("[connections_string]", "connections", "[id]=25")
End If
MyConnectDB.Open Connect_String
'Определяем тип базы к которой обращаемся (Сервер - истина, mdb - ложь)
'MyConnectDB.Open "ODBC;DATABASE=forum;DSN=mysql5;"
'Строка для подключения через ODBC
'Provider=MSDASQL;ODBC;DATABASE=forum;DSN=mysql5;OPTION=16387;
'Строка для подключения к локальной базе
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\forum.mdb;
End If
If (Name_ID_Base <> "") Then
'Если база является сервером, то запрашиваем ее версию
MyRecordset.Open "SELECT VERSION();", MyConnectDB
'Нам нужна только первый символ версии (если версия = 5)
If (Left(MyRecordset(0), 1) = 5) Then
MyRecordset.Close
',то устанавливает кодировку для windows
'MyRecordset.Open "set character set utf8;", MyConnectDB
MyRecordset.Open "set character set cp1251;", MyConnectDB
'MyRecordset.Close
End If
End If
SQL_CONNECT_OPEN = MyConnectDB.State
End Function
Public Sub SQL_CONNECT_CLOSE()
'Закрываем соединение с сервером
If (MyConnectDB.State = adStateOpen) Then
MyConnectDB.Close
Else
MsgBox "Соединение с базой уже закрыто."
End If
End Sub
Public Function SQL_QUERY(sql_string As String, Optional sql_connect As String = "") As ADODB.ObjectStateEnum
' Выполняем полученную строку SQL запроса на сервере и возвращаем ошибку
On Error Resume Next
'Закрываем MyRecordset, если он был открыт
Set MyRecordset = New ADODB.Recordset
If MyRecordset.State = adStateOpen Then
MyRecordset.Close
End If
MyRecordset.CursorLocation = adUseClient
'MyRecordset.Properties.Count
' Выполняем запрос
If (MyConnectDB.State <> adStateOpen) Or sql_connect <> "" Then
If (SQL_CONNECT_OPEN(sql_connect) <> adStateOpen) Then
MsgBox "Ошибка подключения к базе данных.", vbCritical
Exit Function
End If
End If
'adLockOptimistic
MyRecordset.Open sql_string, MyConnectDB, adOpenStatic, adLockReadOnly, adCmdText
' Возвращаем результат выполнения
If MyRecordset.State <> adStateOpen Then
MsgBox "Ошибка выполнения запроса!" & Chr(13) & "SQL_QUERY:" & Chr(13) & sql_string, vbCritical
End If
SQL_QUERY = MyRecordset.State
End Function
Public Function SQL_GETROW(ByRef str As String) As Boolean
'Считываем из каждой строки по каждому столбцу
Dim IndexField As Integer
'Объединяем значения по всем полям через ";"
If (MyRecordset.EOF = False And MyRecordset.State = adStateOpen) Then
For IndexField = 0 To MyRecordset.Fields.count - 1
str = str & MyRecordset(IndexField) & ";"
Next
'Переходим на следующую запись
MyRecordset.MoveNext
'Возвращаем признак конца записей
SQL_GETROW = MyRecordset.EOF
'Если обнаружен конец записи, то закрыть текущий набор записей
'If (MyRecordset.EOF And MyRecordset.State = adStateOpen) Then MyRecordset.Close
Else
SQL_GETROW = MyRecordset.EOF
End If
End Function
Public Function SQL_GETROWS(sql_string As String, Optional sql_connect As String = "") As String
'Считываем из каждой строки по каждому столбцу, в каждой строке и закрываем набор записей
Dim IndexField As Integer
Dim str As String
Dim count_str As Long
str = ""
count_str = 0
'Объединяем значения по всем полям через ";", по всем записям
If (SQL_QUERY(sql_string, sql_connect) = adStateOpen) Then
Do While Not MyRecordset.EOF
For IndexField = 0 To MyRecordset.Fields.count - 1
str = str & Chr(34) & MyRecordset(IndexField) & Chr(34) & ";"
If count_str > 2800 Then
str = str & Chr(34) & "#Err.many" & Chr(34) & ";"
MyRecordset.MoveLast
End If
count_str = count_str + 1
Next
MyRecordset.MoveNext
Loop
'Закрываем набор записей
'MyRecordset.Close
End If
SQL_GETROWS = str
End Function
Public Function SQL_GETRECORDSET() As ADODB.Recordset
'Возвращаем ссылку на набор записей MyRecordset
' Set SQL_GETRECORDSET = New Recordset
If MyConnectDB.State = adStateOpen Then Set SQL_GETRECORDSET = MyRecordset
End Function
Public Sub SQL_FIETCH()
'Закрываем набор записей
Dim a As Variant
If (MyRecordset.State = adStateOpen) Then MyRecordset.Close
End Sub
Public Function SQL_COUNTREC() As Long
'Закрываем набор записей
If (MyRecordset.State = adStateOpen) Then
SQL_COUNTREC = MyRecordset.RecordCount
Else
SQL_COUNTREC = 0
End If
End Function
Public Function SQL_DLookup(s_select As String, s_from As String, Optional s_where As String = "1=1", Optional sql_connect As String = "") As Variant
'DLookup("[connections_string]", "connections", "[id]=18")
Dim result As Variant
If SQL_QUERY("SELECT " & s_select & " FROM " & s_from & " WHERE " & s_where & ";") = adStateOpen _
And MyRecordset.RecordCount > 0 Then
SQL_DLookup = MyRecordset(0)
MyRecordset.Close
Else
SQL_DLookup = Null
End If
End Function
Public Function CONCAT(ParamArray OtherArgs()) As String
Dim i As Integer
Dim str As String
str = ""
For i = 0 To UBound(OtherArgs)
str = str & OtherArgs(i)
Next
CONCAT = str
End Function
Public Function GET_FieldListed(st As Control, id As Variant, row As Variant, col As Variant, code As Variant) As Variant
Dim sql_string As String
On Error Resume Next
Select Case code
' (0)Nonzero if the function can fill the list; False (0) or Null otherwise.
Case acLBInitialize
rec_current = 0
sql_string = st.RowSource
If SQL_QUERY(sql_string) <> adStateOpen Then
MsgBox "Ошибка выполнения запроса." & vbNewLine & sql_string, vbCritical
Exit Function
Else
Set MyRecordsetField = New ADODB.Recordset
Set MyRecordsetField = SQL_GETRECORDSET
End If
err.Clear
GET_FieldListed = True
'Nonzero ID value if the function can fill the list; False or Null otherwise
Case acLBOpen ' (1)Open.
GET_FieldListed = Timer ' Unique ID.
'Number of rows in the list (can be zero); –1 if unknown.
Case acLBGetRowCount ' (3)Get rows.
GET_FieldListed = MyRecordsetField.RecordCount + IIf(st.ColumnHeads, 1, 0)
'Number of columns in the list (can't be zero); must match the property sheet value.
Case acLBGetColumnCount ' (4)Get columns.
GET_FieldListed = MyRecordsetField.Fields.count
'Width (in twips) of the column specified by the col argument; –1 to use the default width.
Case acLBGetColumnWidth ' (5)Get column width.
GET_FieldListed = -1 ' Use default width.
'List entry to be displayed in the row and column specified by the row and col arguments.
Case acLBGetValue ' (6)Get the data.
If (MyRecordsetField.State = adStateOpen) Then
If row = 0 And st.ColumnHeads Then
MyRecordsetField.MoveFirst
GET_FieldListed = MyRecordsetField(col).NAME
rec_current = 0
Else
If row = 0 And Not st.ColumnHeads Then
rec_current = 0
MyRecordsetField.MoveFirst
End If
MyRecordsetField.Move row - rec_current - IIf(st.ColumnHeads, 1, 0)
GET_FieldListed = MyRecordsetField(col).value
rec_current = row - IIf(st.ColumnHeads, 1, 0)
End If
End If
DoEvents
'(7)Format string to be used to format the list entry displayed in the row and
'column specified by the row and col arguments; –1 to use the default format.
Case acLBGetFormat
GET_FieldListed = -1
'Nothing.
Case acLBEnd
'If (MyRecordsetField.State = adStateOpen) Then MyRecordsetField.Close
'Not used.
Case acLBClose
'GET_FieldListed = Null
End Select
EEr:
Exit Function
err:
MsgBox err.Number & " : " & err.Description
Resume EEr
End Function
[Это сообщение - спам!]
Последние сообщения из форума
Уважаемые посетители форума MySQL.RU!
Убедительная просьба, прежде чем задавать свой вопрос в этом форуме, обратите внимание на разделы:
- ответы на наиболее часто задаваемые вопросы - FAQ
- раздел документация
- раздел поиск по сообщениям форума и документации
Также, старайтесь наиболее подробно указывать свою ситуацию (версию операционной системы, версию MySQL,
версию программного обеспечения, по которому возникает вопрос, текст возникающих ошибок, и др.)
Помните, чем конкретнее Вы опишете ситуацию, тем больше шансов получить реальную помощь.
25494
|
|
