dbsqlce.vb

对现代企业来说

Imports System
Imports System.Data.SqlServerCe
Imports System.Data.Common
Imports System.Data
Imports System.IO
Imports System.Configuration
Imports System.Reflection

Public Class DBSqlCe
    Public ClassName As String = "DBSqlCe"                    ' Used to indicate which table is being used
    Public DebugFlag As Boolean = True                        ' Used for Runtime debugging
    Public ConnStr As String                                  ' Private Variable for ADO database connection
    Public ErrMsg As String                                   ' On error this will return what happened
    Public DebugTraceFN As String                             ' The file name where to write the debug trace

    REM Shared means that the connection is left open after the object is closed
    Public Shared objConn As New SqlCeConnection
    'Public objConn As SqlCeConnection

    Public RowOfData As Object
    Public CSVSeperator As String = ","
    Public Sub New(ByVal DBConnectionStr As String)
        Initialize(DBConnectionStr)
    End Sub
    Private Sub Initialize(ByVal DBConnectionStr As String)
        ErrMsg = ""
        ConnStr = DBConnectionStr
        ClassName = Me.GetType.Name
    End Sub
    Public Function OpenConnection() As SqlCeConnection
        Dim objConnection As New SqlCeConnection

        If objConn Is Nothing Then
            objConnection.ConnectionString = ConnStr
            objConnection.Open()
            Return objConnection
        End If

        If objConn.State <> ConnectionState.Open Then
            objConnection.ConnectionString = ConnStr
            objConnection.Open()
            Return objConnection
        Else
            Return objConn
        End If

        objConnection.ConnectionString = ConnStr
        objConnection.Open()
        Return objConnection

    End Function
    Public Sub CloseConnection(ByRef objConnection As SqlCeConnection)
        REM Close connection to database
        'objConnection.Close()
    End Sub
    Public Sub TerminateConnection()
        objConn.Close()
    End Sub
    Public Property ConnectionString() As String
        Get
            Return ConnStr
        End Get
        Set(ByVal Value As String)
            ConnStr = Value
        End Set
    End Property
    Public Function DBSTR(ByVal sStr As String) As String
        REM Function to convert strings into a format that the database can take
        sStr = sStr.Replace("'", "''")
        Return sStr
    End Function
    Public Function DATE_To_DBSTR(ByVal dDate As DateTime) As String
        REM Function to convert date format into a format recognized by the database
        Return DATE_To_DDMMMYYYY_HHMMSS(dDate)
    End Function
    Public Function SQLDateValue(ByVal dDate As DateTime) As String
        ' Rename & " #" & DATE_To_DBSTR(Now()) & "# " ' In Access this works
        Return " CONVERT(datetime,'" & DATE_To_DBSTR(dDate) & "') "
    End Function
    Public Function SQLBooleanValue(ByVal bBoolean As Boolean) As String
        '  " " & BOOLEAN_To_DBSTR(fields(i).GetValue(Row)) & " " ' In Access there is a boolean type
        Return " '" & BOOLEAN_To_DBSTR(bBoolean) & "' "

    End Function
    Public Function SQLStringValue(ByVal Str As String) As String
        Return " '" & DBSTR(Str) & "' "
    End Function
    Public Function BOOLEAN_To_DBSTR(ByVal bValue As Boolean) As String
        REM Function to convert boolean format into a format recognized by the database
        If bValue Then
            Return "True"
        Else
            Return "False"
        End If
    End Function
    Private Function DATE_To_DDMMMYYYY_HHMMSS(ByVal dDate As DateTime) As String
        REM Function to convert date format into a format recognized by the database
        REM =================================================================================== 

        Dim sDay As String
        Dim sMonth As String
        Dim sYear As String
        Dim sMonth_MMM As String

        Dim sHr As String
        Dim sMin As String
        Dim sSec As String

        Dim sDatabaseTime As String

        sDay = CStr(dDate.Day)
        sMonth = CStr(dDate.Month)
        sYear = CStr(dDate.Year)

        sHr = CStr(dDate.Hour)
        sMin = CStr(dDate.Minute)
        sSec = CStr(dDate.Second)

        If sSec.Length = 1 Then sSec = "0" + sSec
        If sMin.Length = 1 Then sMin = "0" + sMin
        If sHr.Length = 1 Then sHr = "0" + sHr

        If sDay.Length = 1 Then sDay = "0" + sDay
        If sMonth.Length = 1 Then sMonth = "0" + sMonth

        Select Case dDate.Month
            Case 1 : sMonth_MMM = "JAN"
            Case 2 : sMonth_MMM = "FEB"
            Case 3 : sMonth_MMM = "MAR"
            Case 4 : sMonth_MMM = "APR"
            Case 5 : sMonth_MMM = "MAY"
            Case 6 : sMonth_MMM = "JUN"
            Case 7 : sMonth_MMM = "JUL"
            Case 8 : sMonth_MMM = "AUG"
            Case 9 : sMonth_MMM = "SEP"
            Case 10 : sMonth_MMM = "OCT"
            Case 11 : sMonth_MMM = "NOV"
            Case 12 : sMonth_MMM = "DEC"
        End Select

        sDatabaseTime = sDay + " " + sMonth_MMM + " " + sYear + " " + sHr + ":" + sMin + ":" + sSec + ":000"
        Return sDatabaseTime

    End Function
    Public Const NullDate As String = "01 JAN 1 00:00:00:000"
    Public Function SQLDS(ByVal SQL As String) As DataSet
        Dim ErrLoc As String = ClassName + ".SQLDS"

        Try
            objConn = OpenConnection()

            Dim objCmd As New SqlCeDataAdapter(SQL, objConn)
            Dim ds As DataSet = New DataSet

            objCmd.Fill(ds, ClassName)
            objCmd.Dispose()
            CloseConnection(objConn)
            Return ds
        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
        End Try
    End Function
    Public Function SQLDR(ByVal SQL As String) As DataSet
        Dim ErrLoc As String = ClassName + ".SQLDS"

        Try
            objConn = OpenConnection()

            Dim objCmd As New SqlCeDataAdapter(SQL, objConn)
            Dim ds As DataSet = New DataSet

            objCmd.Fill(ds, ClassName)
            objCmd.Dispose()
            CloseConnection(objConn)
            Return ds
        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
        End Try
    End Function
    Public Function GetDR() As SqlCeDataReader
        Dim ErrLoc As String = ClassName + ".GetDR"
        Dim SQL As String


        SQL = "SELECT * FROM " + ClassName + " "

        Try
            objConn = OpenConnection()

            Dim objCmd As New SqlCeCommand(SQL, objConn)
            Dim dr As SqlCeDataReader

            dr = objCmd.ExecuteReader
            objCmd.Dispose()
            CloseConnection(objConn)
            Return dr
        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
        End Try
    End Function
    Public Function GetDR(ByRef Row As ValueType) As SqlCeDataReader
        Dim ErrLoc As String = ClassName + ".GetDR(Row)"
        Dim SQL As String

        Try

            Dim i As Integer
            Dim Seperator As String = ""
            Dim fields() As FieldInfo
            fields = Row.GetType.GetFields

            SQL = "SELECT * FROM " + ClassName + " WHERE "

            For i = 0 To fields.Length - 1
                If Not fields(i).GetValue(Row) Is Nothing Then
                    Select Case fields(i).FieldType.ToString
                        Case "System.String"
                            If Not fields(i).GetValue(Row).ToString = "<NOTHING>" Then
                                SQL &= Seperator & fields(i).Name & " = "
                                SQL &= " '" & DBSTR(fields(i).GetValue(Row).ToString) & "' "
                                Seperator = "AND "
                            End If
                        Case "System.DateTime"
                            If Not DATE_To_DBSTR(fields(i).GetValue(Row)) = "01-JAN-1 00:00:00" Then
                                SQL &= Seperator & fields(i).Name & " = "
                                SQL &= " CONVERT(datetime,'" & DATE_To_DBSTR(fields(i).GetValue(Row)) & "') "

                                Seperator = "AND "
                            End If
                        Case "System.Boolean"
                            SQL &= Seperator & fields(i).Name & " = "
                            SQL &= " '" & BOOLEAN_To_DBSTR(fields(i).GetValue(Row)) & "' "
                            Seperator = "AND "
                        Case Else
                            If Not fields(i).GetValue(Row) = "0" Then
                                SQL &= Seperator & fields(i).Name & " = "
                                SQL &= fields(i).GetValue(Row).ToString & " "
                                Seperator = "AND "
                            End If
                    End Select
                End If
            Next

            objConn = OpenConnection()

            Dim objCmd As New SqlCeCommand(SQL, objConn)
            Dim dr As SqlCeDataReader

            dr = objCmd.ExecuteReader
            objCmd.Dispose()
            CloseConnection(objConn)
            Return dr

        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
        End Try

    End Function
    Public Function ExecuteSQL(ByVal SQL As String) As Boolean
        Dim ErrLoc As String = ClassName + ".ExecuteSQL"

        Try
            objConn = OpenConnection()

            Dim objCmd As SqlCeCommand = New SqlCeCommand(SQL, objConn)
            objCmd.CommandType = CommandType.Text
            objCmd.ExecuteNonQuery()
            objCmd.Dispose()

            CloseConnection(objConn)
            Return True

        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
            Return False
        End Try

    End Function
    Function TableExists(ByVal TableName As String) As Boolean
        REM Function to determine if the current table exists
        REM =================================================================================== 
        Dim ErrLoc As String = ClassName + ".TableExists"
        Dim SQL As String

        SQL = "SELECT TABLE_NAME FROM "
        SQL &= "INFORMATION_SCHEMA.TABLES "
        SQL &= "WHERE TABLE_NAME = '" & TableName & "'"

        objConn = OpenConnection()

        Dim sqlReader As SqlCeDataReader
        Dim sqlCmd As New SqlCeCommand(SQL, objConn)
        Try
            sqlReader = sqlCmd.ExecuteReader
        Catch ex As Exception
            UnHandledError(ex.Message, ErrLoc, SQL)
            MsgBox("There was an error: " & Err.ToString())
        End Try

        CloseConnection(objConn)

        If sqlReader.Read Then
            'found the name?
            Return True
        Else
            Return False
        End If
    End Function
    Public Function UnHandledError(ByVal Exception As String, ByVal Location As String) As String
        MsgBox("[-->" + Location + "<--]" + Exception)
    End Function
    Public Function UnHandledError(ByVal Exception As String, ByVal Location As String, ByVal SQL As String)
        MsgBox("[-->" + Location + "<--]" + SQL + Exception)
    End Function

End Class