Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: VB.NET: Tietokanta, SQLite3 Data Access Layer (DAL)

nakkimake [26.04.2007 17:07:42]

#

Tällä DAL modulilla onnistuu helposti ja nopeasti tietokantasovelluksen tekeminen SQLite3:lla.

Modulin testaus:

Lataa System.Data.SQLite osoitteesta http://sqlite.phxsoftware.com/ ja lisää se referenssiksi projektiisi.

Lisää yksi moduuli (nimeä esim. modMyDataLayer) ja liitä listauksesessa 1 oleva koodi siihen.

Lisää formiin 7 command buttonia, 1 listbox, 1 combobox ja 1 datagridview.

Liitä listauksessa 2 oleva koodi formiin.

Tee listauksien 3 ja 4 mukaiset tekstitiedostot.

'
' SQLIte3 Data Access Layer, Version 1.1
' Copyright Markus Yliaho, 2007.
'
' Using of this code is completely free, with your own risk.
' Although I have tested this code in my own solutions,  I'm not responsible
' of any possible data losses that you may have when using it.
'
' Please, post any comments to nakkimake@hotmail.com
'
' Prequisites: System.Data.SQLite from http://sqlite.phxsoftware.com/
'
Imports System.IO.StreamReader
Imports System.Globalization
Imports System.Data.SQLite
Imports System.Data
Imports System.IO

Module myDataLayer

    Public myCellCollection As New Collection
    Public myDataSet As New DataSet
    Public SQLStmt As String

    Private myConnection As New SQLiteConnection
    Private myDataAdapter() As SQLiteDataAdapter
    Private myWorkRow As DataRow

    Public Function OpenSQLConnection(ByVal Database As String) As Boolean

        Try
            If myConnection.State = ConnectionState.Closed Then
                myConnection.ConnectionString = "Data Source=" & Database & ";New=True;Compress=True;Synchronous=Off"
                myDataSet.Locale = CultureInfo.InvariantCulture
                myConnection.Open()
                myDataSet.Reset()
            End If
            Return True
        Catch ex As Exception
            MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
            ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        End Try

    End Function

    Public Sub CloseSQLConnection()

        If myConnection.State = ConnectionState.Open Then
            myConnection.Close()
        End If

    End Sub

    Public Sub DisposeDAL()

        CloseSQLConnection()
        If myDataAdapter IsNot Nothing Then
            For a As Short = 0 To UBound(myDataAdapter)
                myDataAdapter(a).Dispose()
                myDataAdapter(a) = Nothing
            Next
            myDataAdapter = Nothing
        End If

        If myDataSet IsNot Nothing Then
            myDataSet.Dispose()
            myDataSet = Nothing
        End If

        If myConnection IsNot Nothing Then
            myConnection = Nothing
        End If

        myCellCollection = Nothing

    End Sub

    Public Function ExecuteSQLStmt(ByVal Database As String, _
                                   ByVal sSQL As String, _
                                   Optional ByVal Disconnect As Boolean = False) As Boolean

        If OpenSQLConnection(Database) = True Then
            Dim myCmd As New SQLiteCommand(sSQL, myConnection)

            Try
                myCmd.ExecuteNonQuery()
                Return True
            Catch ex As Exception
                MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
                ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Return False
            Finally
                If Disconnect = True Then CloseSQLConnection()
                If myCmd IsNot Nothing Then
                    myCmd.Dispose()
                    myCmd = Nothing
                End If
            End Try
        Else
            Return False
        End If

    End Function
    '
    ' Note: This function is compatible with ListBox and ComboBox only.
    '
    Public Function StreamDataIntoControl(ByVal Database As String, _
                                          ByVal sSQL As String, _
                                          ByVal Col As Short, _
                                          ByVal myControl As Object, _
                                          Optional ByVal ClearControl As Boolean = True, _
                                          Optional ByVal Disconnect As Boolean = False) As Boolean

        If OpenSQLConnection(Database) = True Then
            Dim myCmd As New SQLiteCommand(sSQL, myConnection)

            Try
                Dim strArray() As String
                Dim myReader As SQLiteDataReader
                myReader = myCmd.ExecuteReader()

                If ClearControl = True Then
                    myControl.Items.Clear()
                End If

                Do While (myReader.Read())
                    strArray = myReader(Col).ToString().Split(",")
                    For Each x As String In strArray
                        myControl.Items.Add(x)
                    Next
                Loop

                If myReader IsNot Nothing Then
                    myReader.Close()
                    myReader = Nothing
                End If
                Return True
            Catch ex As Exception
                MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
                ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Return False
            Finally
                If Disconnect = True Then CloseSQLConnection()
                If myCmd IsNot Nothing Then
                    myCmd.Dispose()
                    myCmd = Nothing
                End If
            End Try
        Else
            Return False
        End If

    End Function
    '
    ' An optional myControl can be DataGridView control
    ' If OutputFile is specified a result will be saved to disk file
    '
    Public Function FillDataAdapter(ByVal Database As String, _
                                    ByVal TableIndex As Byte, _
                                    ByVal sSQL As String, _
                                    Optional ByVal myControl As Object = Nothing, _
                                    Optional ByVal OutputFile As String = "", _
                                    Optional ByVal Disconnect As Boolean = False) As Boolean

        If OpenSQLConnection(Database) = True Then
            Try
                If TableIndex + 1 > myDataSet.Tables.Count Then
                    ReDim Preserve myDataAdapter(TableIndex)
                    myDataSet.Tables.Add()
                End If

                myDataSet.Tables(TableIndex).Clear()
                myDataAdapter(TableIndex) = New SQLiteDataAdapter(sSQL, myConnection)
                myDataAdapter(TableIndex).Fill(myDataSet.Tables(TableIndex))

                If myControl IsNot Nothing Then
                    myControl.DataSource = myDataSet.Tables(TableIndex)
                End If

                If Not OutputFile = "" Then
                    Dim objWriter As StreamWriter
                    objWriter = New StreamWriter(OutputFile)

                    Try
                        Dim Cols As Integer = myDataSet.Tables(TableIndex).Columns.Count - 1
                        Dim Rows As Integer = myDataSet.Tables(TableIndex).Rows.Count - 1
                        Dim Col, Row As Integer
                        Dim Data As String = ""

                        For Row = 0 To Rows
                            For Col = 0 To Cols
                                Data += myDataSet.Tables(TableIndex).Rows(Row).Item(Col).ToString & ","
                            Next
                            objWriter.Write(Data.Remove(Len(Data) - 1, 1) & vbCrLf)
                            Data = ""
                        Next
                    Catch ex As Exception
                        MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
                        ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                        Return False
                    Finally
                        objWriter.Close()
                        objWriter.Dispose()
                        objWriter = Nothing
                    End Try
                End If

                Return True
            Catch ex As Exception
                MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
                ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Return False
            Finally
                If Disconnect = True Then CloseSQLConnection()
            End Try
        Else
            Return False
        End If

    End Function
    '
    ' This function is for use with DataAdapter
    '
    Public Function AddDataRowDA(ByVal TableIndex As Byte) As Boolean

        Try
            With myDataSet.Tables(TableIndex)

                myWorkRow = .NewRow
                For Cell As Short = 0 To myCellCollection.Count - 1
                    myWorkRow(Cell) = myCellCollection.Item(Cell + 1)
                Next

                .Rows.Add(myWorkRow)
                Return True
            End With
        Catch ex As Exception
            MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
            ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        Finally
            myCellCollection.Clear()
        End Try

    End Function
    '
    ' This function is for use with DataAdapter
    '
    Public Function DeleteDataRowDA(ByVal TableIndex As Byte, _
                                    ByVal Row As Short) As Boolean

        Try
            myDataSet.Tables(TableIndex).Rows(Row).Delete()
            Return True
        Catch ex As Exception
            MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
            ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        End Try

    End Function
    '
    ' This function is for use with DataAdapter
    '
    Public Function GetCellDataDA(ByVal TableIndex As Byte, _
                                  ByVal Row As Short, _
                                  ByVal Col As Short) As Object

        Try
            Return myDataSet.Tables(TableIndex).Rows(Row).Item(Col)
        Catch ex As Exception
            MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
            ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return "error"
        End Try

    End Function
    '
    ' This function is for use with DataAdapter
    '
    Public Function PutCellDataDA(ByVal TableIndex As Byte, _
                                  ByVal Row As Short, _
                                  ByVal Col As Short, _
                                  ByVal NewData As Object) As Boolean

        Try
            myWorkRow = myDataSet.Tables(TableIndex).Rows(Row)
            myWorkRow(Col) = NewData
            Return True
        Catch ex As Exception
            MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
            ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        End Try

    End Function
    '
    ' This function is for use with DataAdapter
    '
    Public Function UpdateDataAdapter(ByVal TableIndex As Byte, _
                                      ByVal State As DataRowState, _
                                      Optional ByVal Disconnect As Boolean = False) As Boolean

        Dim myDataRowsCommandBuilder As New SQLiteCommandBuilder(myDataAdapter(TableIndex))
        Dim ChildRecords As DataTable = myDataSet.Tables(TableIndex).GetChanges(State)

        Try
            Select Case State
                Case DataRowState.Added
                    myDataAdapter(TableIndex).InsertCommand = myDataRowsCommandBuilder.GetInsertCommand
                Case DataRowState.Deleted
                    myDataAdapter(TableIndex).DeleteCommand = myDataRowsCommandBuilder.GetDeleteCommand
                Case DataRowState.Modified
                    myDataAdapter(TableIndex).UpdateCommand = myDataRowsCommandBuilder.GetUpdateCommand
            End Select

            myDataAdapter(TableIndex).Update(ChildRecords)
            myDataSet.Tables(TableIndex).AcceptChanges()
            Return True
        Catch ex As Exception
            MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
            ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        Finally
            If Disconnect = True Then CloseSQLConnection()
            If myDataRowsCommandBuilder IsNot Nothing Then
                myDataRowsCommandBuilder.Dispose()
                myDataRowsCommandBuilder = Nothing
            End If
            If ChildRecords IsNot Nothing Then
                ChildRecords.Dispose()
                ChildRecords = Nothing
            End If
        End Try

    End Function
    '
    ' This function imports diskfile into a database
    ' Usage: ImportData("Database", "Table", "Field1,Field2", "c:\data.txt", [True])
    '
    Public Function ImportData(ByVal Database As String, _
                               ByVal Table As String, _
                               ByVal Fields As String, _
                               ByVal Filename As String, _
                               Optional ByVal Disconnect As Boolean = False) As Boolean

        If File.Exists(Filename) = True Then
            If OpenSQLConnection(Database) = True Then
                Dim objReader As New StreamReader(Filename)
                Dim myCmd As New SQLiteCommand
                Dim ValuesPart As String

                Try
                    myCmd.Connection = myConnection
                    Do While objReader.Peek() <> -1
                        ValuesPart = " VALUES (" & objReader.ReadLine() & ")"
                        myCmd.CommandText = "INSERT INTO " & Table & " (" & Fields & ") " & ValuesPart
                        myCmd.ExecuteNonQuery()
                    Loop
                    Return True
                Catch ex As Exception
                    MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
                    ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                    Return False
                Finally
                    If Disconnect = True Then CloseSQLConnection()
                    If objReader IsNot Nothing Then
                        objReader.Close()
                        objReader.Dispose()
                        objReader = Nothing
                    End If
                    If myCmd IsNot Nothing Then
                        myCmd.Dispose()
                        myCmd = Nothing
                    End If
                End Try
            Else
                Return False
            End If
        Else
            MessageBox.Show("File does not exist!", "Error", _
            MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        End If

    End Function
    '
    ' This function executes an SQL statement(s) from a diskfile
    '
    Public Function RunSQLStmtFile(ByVal Database As String, _
                                   ByVal Filename As String, _
                                   Optional ByVal Disconnect As Boolean = False) As Boolean

        If File.Exists(Filename) = True Then
            Dim objReader As New StreamReader(Filename)

            Try
                Dim result As Boolean = True
                Do While objReader.Peek() <> -1 And result = True
                    result = ExecuteSQLStmt(Database, objReader.ReadLine())
                Loop
                Return result
            Catch ex As Exception
                MessageBox.Show("An error has occured!" & vbCrLf & vbCrLf & _
                ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Return False
            Finally
                If Disconnect = True Then CloseSQLConnection()
                If objReader IsNot Nothing Then
                    objReader.Close()
                    objReader.Dispose()
                    objReader = Nothing
                End If
            End Try
        Else
            MessageBox.Show("File does not exist!", "Error", _
            MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False
        End If

    End Function
End Module
Public Class Form1
    Dim DB As String = "d:\test.db3"

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        SQLStmt = "DROP TABLE IF EXISTS Users;" & _
                  "CREATE TABLE Users (" & _
                  "FFMS_ID VARCHAR(50) NOT NULL PRIMARY KEY," & _
                  "FFMS_RealName VARCHAR(50) NOT NULL," & _
                  "FFMS_Description VARCHAR(50) NOT NULL," & _
                  "FFMS_DatabasePermissions VARCHAR(50) NOT NULL," & _
                  "FFMS_AdministrationAllowed VARCHAR(1) NOT NULL)"

        If ExecuteSQLStmt(DB, SQLStmt) Then
            If ImportData(DB, "Users", "FFMS_ID,FFMS_RealName,FFMS_Description,FFMS_DatabasePermissions,FFMS_AdministrationAllowed", "D:\Imports.txt") Then

                SQLStmt = "INSERT INTO Users " & _
                          "(FFMS_ID," & _
                          "FFMS_RealName," & _
                          "FFMS_Description," & _
                          "FFMS_DatabasePermissions," & _
                          "FFMS_AdministrationAllowed) " & _
                          "VALUES ('A','B','C','D','E')"

                If ExecuteSQLStmt(DB, SQLStmt) Then
                    SQLStmt = "SELECT * FROM Users"

                    If StreamDataIntoControl(DB, SQLStmt, 0, ListBox1) Then
                        If StreamDataIntoControl(DB, SQLStmt, 1, ComboBox1) Then
                            If FillDataAdapter(DB, 0, SQLStmt, DataGridView1, "d:\test.txt", True) Then

                            End If
                        End If
                    End If
                End If
            End If
        End If

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        FillDataAdapter(DB, 0, "SELECT * FROM Users", DataGridView1)
        PutCellDataDA(0, 0, 0, "Pasi")
        PutCellDataDA(0, 0, 1, "Pasi")
        PutCellDataDA(0, 0, 2, "Pasi")
        PutCellDataDA(0, 0, 3, "Pasi")

        UpdateDataAdapter(0, DataRowState.Modified, True)

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        FillDataAdapter(DB, 0, "SELECT * FROM Users", DataGridView1)

        myCellCollection.Add("AAA")
        myCellCollection.Add("BBB")
        myCellCollection.Add("CCC")
        myCellCollection.Add("DDD")
        myCellCollection.Add("EEE")

        AddDataRowDA(0)
        UpdateDataAdapter(0, DataRowState.Added, True)

    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        FillDataAdapter(DB, 0, "SELECT * FROM Users", DataGridView1)
        DeleteDataRowDA(0, 2)
        UpdateDataAdapter(0, DataRowState.Deleted, True)

    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        FillDataAdapter(DB, 0, "SELECT * FROM Users", DataGridView1, , True)
        MsgBox(GetCellDataDA(0, 1, 1))

    End Sub

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

        FillDataAdapter(DB, 0, "SELECT * FROM Users", DataGridView1)

        For Each Row As DataRow In myDataSet.Tables(0).Rows
            Row(1) = Now
        Next

        UpdateDataAdapter(0, DataRowState.Modified, True)

    End Sub

    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

        If RunSQLStmtFile(DB, "d:\SQLStmt.txt") Then
            FillDataAdapter(DB, 0, "SELECT * FROM Users", DataGridView1, , True)
        End If

    End Sub

    Private Sub Form1_Disposed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Disposed

        DisposeDAL()

    End Sub

End Class

D:\SQLStmtFile.txt

INSERT INTO Users (FFMS_ID,FFMS_RealName,FFMS_Description,FFMS_DatabasePermissions,FFMS_AdministrationAllowed) VALUES ('123','234','345','456','567')
INSERT INTO Users (FFMS_ID,FFMS_RealName,FFMS_Description,FFMS_DatabasePermissions,FFMS_AdministrationAllowed) VALUES ('_a_','_b_','_c_','_d_','_e_')

D:\Imports.txt

00,01,02,03,04
05,06,07,08,09
10,11,12,13,14
15,16,17,18,19

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta