


Module WorkWithBase
    Dim con As New OleDb.OleDbConnection ' Объявляем 'con' как Connection Object
    Dim da As New OleDb.OleDbDataAdapter ' Создаём DataAdapter, посредника между DataSet и базой данных
    Public ds As New DataSet ' Создаём DataSet, объект, в который будут помещены данные из БД
    Public tblName As String ' Переменная, в которую будет помещено имя DataSet для упрощения обращения к нему
    Dim int_RowNumber As Integer ' Переменная, содержащая в себе текущую позицию курсора в DataSet
    Sub openDatabase(ByRef dbProvider As String, ByRef dbSource As String)
        ' dbProvider как "PROVIDER=Microsoft.Jet.OLEDB.4.0;"
        ' dbSource как "C:\databasename.mdb"
        con.ConnectionString = dbProvider & dbSource
        Try
            If con.State = ConnectionState.Closed Then
                con.Open()
            Else
                con.Close()
                con.Open()
            End If
        Catch ex As Exception
            MsgBox(ex.Message, , "Ошибка! Не удалось открыть " & dbSource & " OopenDataBase - module WorkWithBase")
        End Try
    End Sub
    Sub closeDatabase()
        con.Close()
    End Sub
    Sub connectToDB(str_queryString As String)
        ' queryString как "SELECT SongCount AS Номер, SingerName AS Исполнитель, SongName AS Название, Poet AS Автор_текста, Kompozitor AS Композитор, " _
        '                   & "FileName AS Имя_файла FROM Songs"
        Try
            ' разрушаем DataAdapter
            da.Dispose()
        Catch ex As Exception
            MsgBox(ex.Message, , "Sub queryDatbase - module WorkWithBase")
        End Try
        ' создаём DataAdapter
        da = New OleDb.OleDbDataAdapter(str_queryString, con)
    End Sub
    Sub fillDataSet(ByRef tblName As String)
        'Try
        '    ds.Tables(tblName).Reset()
        ds.Clear()
        'ds.Reset()
        '    ds.Tables.Add(tblName)
        'Catch ex As Exception
        'End Try
        Try
            Application.DoEvents()
            da.Fill(ds, tblName)
        Catch ex As Exception
            MsgBox(ex.Message, , "Sub fillDataSet - module WorkWithBase")
        End Try
    End Sub
    Sub saveToDatabase(ByRef tblName As String, dsNewRow As DataRow)
        '**********************************************************************************************************"
        ' 
        '**********************************************************************************************************"
        ' Создаём объект CommandBuilder:
        Dim cb As New OleDb.OleDbCommandBuilder(da)
        ' Создаём объект DataRow (в него поместим новую строку, которую добавим в таблицу):
        ' Dim dsNewRow As DataRow
        ' tblName = frmMain
        ' Заносим в объект dsnNewRow пустую строку в формате строк таблицы AddressBook:
        ' dsNewRow = ds.Tables(tblName).NewRow()
        ' Вносим в DataSet(AddressBook) новую строку:
        ds.Tables(tblName).Rows.Add(dsNewRow)
        ' С помощью DataAdapter 'da.Update' сохраняем изменённый Dataset в БД:
        da.Update(ds, tblName)
        ' Очищаем DataSet:
        ds.Clear()
        ' Обновляем набор данных в DataSet, так как мы добавили новую строку:
        da.Fill(ds, tblName)
        cb = Nothing
        dsNewRow = Nothing
    End Sub
    Sub updateDataBase(ByRef tblName As String) 'ByRef int_RowNumber As Integer, ByRef Arr() As String)
        ' Если база пуста - выходим из подпрограммы:
        If ds.Tables(tblName).Rows.Count = 0 Then
            Exit Sub
        End If
        ' Создаём объект CommandBuilder:
        Dim cb As New OleDb.OleDbCommandBuilder(da)
        Try
            da.Update(ds, tblName)
        Catch ex As Exception
            MsgBox(ErrorToString)
        End Try
        cb = Nothing
    End Sub
    Sub deleteFromDatabase(ByRef int_RowIndex As Integer, ByRef tblName As String)
        ' Если база пуста, сообщаем об этом и выходим из подпрограммы ничего не удалив:
        If ds.Tables(tblName).Rows.Count = 0 Then
            ShowDialogWindow("В базе данных нет ни одной записи, удалять нечего", "База данных пуста", "Я понял", "Точно понял")
            Exit Sub
        End If
        ' Задашиваем подтверждение удаления строки из БД:
        Dim retVal As Byte
        retVal = ShowDialogWindow("Удаление записи из БД", "Вы действительно хотите удалить запись из БД?", "Удалить", "Не удалять")
        If retVal = 2 Then Exit Sub
        Dim cb As New OleDb.OleDbCommandBuilder(da)  ' Создаём объект CommandBuilder 
        Try
            ds.Tables(tblName).Rows(int_RowIndex).Delete() ' Удаляем строку из таблицы
            'int_MaxRows = int_MaxRows - 1 ' Уменьшаем количество строк в таблице на 1
            da.Update(ds, tblName) ' Сохраняем изменения в БД
        Catch
            MsgBox(ErrorToString)
        End Try
        cb = Nothing ' Удаляем объект CommandBuilder
    End Sub
    Function ShowDialogWindow(ByRef FormCaption As String, MessageText As String, OK_ButtonText As String, Cancel_ButtonText As String) As Byte
        ' Функция вызывает диалоговое окно с настраиваемым текстом
        Dim retVal As Byte ' retVal = 1 OK; retVal = 2 Cancel
        dlgWindow.Text = FormCaption
        dlgWindow.Label1.Text = MessageText
        dlgWindow.OK_Button.Text = OK_ButtonText
        dlgWindow.Cancel_Button.Text = Cancel_ButtonText
        retVal = CByte(dlgWindow.ShowDialog())
        Return retVal
    End Function
    Function datagridfilter(ByRef strFilter As String) As Integer
        Dim dv As DataView
        dv = New DataView(ds.Tables(tblName))
        If strFilter = "" Then
            dv.RowFilter = [String].Empty
            dv.RowFilter = "Название LIKE '%'"
            Return 0
            Exit Function
        End If
        dv.RowFilter = [String].Empty
        dv.RowFilter = "Название LIKE '" + strFilter + "%'"
        'dv = New DataView(ds.Tables(tblName), "Название LIKE 'ночное такс'", "Название Desc", DataViewRowState.CurrentRows)
        'frmMain.dgvMain.DataSource = dv
        Dim aaa = 0
        Return 0
    End Function
    Function searchInDB(ByRef queryString As String, tblName As String) As String
        Dim str_SearchString As String = Nothing
        Dim dbProvider As String = Nothing
        Dim dbSource As String = Nothing
        ' меняем в запросе некорректные символы:
        'queryString = removeBadCharsFromString(queryString)
        ' формируем запрос к БД
        ' ЗАПРОСЫ ДОЛЖНЫ КОНСТРУИРОВАТЬСЯ ВЫЗЫВАЮЩЕЙ ПОДПРОГРАММОЙ
        str_SearchString = queryString ' "SELECT * FROM Songs WHERE SongName" ' LIKE '%" + queryString + "%' OR SingerName LIKE '%" + queryString + "%' ORDER BY SongName"
        ' Объявляем провайдера для работы с MS Access БД:
        dbProvider = "PROVIDER=Microsoft.Jet.OLEDB.4.0;"
        ' Указываем путь до файла БД: 
        dbSource = "Data Source = " & Application.StartupPath & "\db\Songs.mdb"
        ' Открываем базу данных
        openDatabase(dbProvider, dbSource)
        ' Выбираем данные по SQL-запросу из БД:
        connectToDB(str_SearchString)
        ' Заполняем выбранными из БД данными DataSet и присваиваем DataSet имя BazaPesen:
        'tblName = "BazaPesen"
        fillDataSet(tblName)
        ' Закрываем соединение с базой данных:
        closeDatabase()
        Return str_SearchString
    End Function
    Function removeBadCharsFromString(ByRef str_String As String) As String
        ' меняем в запросе некорректные символы  на приемлемые:
        ' 1 что менять, 2 на что менять
        Dim strToReplace() As String = {"ё", "е", "Ё", "Е", "'", "##", "–", "-", vbCrLf, "", vbCr, "",
                                         vbNewLine, "", "_", " "}
        For i = 0 To UBound(strToReplace) - 1 Step 2
            str_String = str_String.Replace(strToReplace(i), strToReplace(i + 1))
        Next
        If str_String = Nothing Then str_String = ""
        Return str_String
    End Function
End Module




AndrNet писал(а):accdb



Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
        ClientBindingSource.Filter = "VIN  Like  '%" & TextBox1.Text & "%'"
    End Sub



Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1