dbtable.vb

对现代企业来说

                    REM determine type
                    REM Ideally I would like to read the type directly from the dataset
                    REM I have not found a way to do this so I pass the Row object and compare the names
                    REM and get the type
                    REM ==> Select Case ds.Tables(ClassName).Columns(Cols).DataType.ToString <==

                    Dim fields() As FieldInfo
                    fields = Row.GetType.GetFields

                    REM Go through structure to find column name
                    TypeStr = ""
                    For i = 0 To fields.Length - 1
                        If ds.Tables(ClassName).Columns(Cols).ColumnName = fields(i).Name Then
                            Select Case fields(i).FieldType.ToString
                                Case "System.String"
                                    TypeStr = "String"
                                Case "System.Boolean"
                                    TypeStr = "Boolean"
                                Case "System.DateTime"
                                    TypeStr = "DateTime"
                                Case Else
                                    TypeStr = ""
                            End Select
                        End If
                    Next

                    Try
                        Select Case TypeStr
                            Case "String"
                            Case "Boolean"
                            Case "DateTime"
                                If ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) Is DBNull.Value Then
                                    Validflg = False
                                Else
                                    If Not IsDate(ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName)) Then
                                        Validflg = False
                                    End If
                                    If ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) = "" Then
                                        Validflg = False
                                    End If
                                End If
                                If Validflg Then dtValue = CType(ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName), DateTime)
                            Case ""
                                If ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) Is DBNull.Value Then
                                    Validflg = False
                                Else
                                    If Not IsNumeric(ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName)) Then
                                        Validflg = False
                                    End If
                                End If
                        End Select
                    Catch ex As Exception
                        Validflg = False
                    End Try


                    Dim TempStr As String

                    If ds.Tables(ClassName).Columns(Cols).ColumnName <> TableIndex() Then
                        SQL &= Seperator
                        If TypeStr = "DateTime" Then
                            SQL &= SQLDateValue(dtValue)
                        ElseIf TypeStr = "String" Then
                            If Not ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) Is DBNull.Value Then
                                SQL &= SQLStringValue(ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName))
                            Else
                                SQL &= "''"
                            End If
                        ElseIf TypeStr = "Boolean" Then
                            If Not ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) Is DBNull.Value Then
                                SQL &= SQLBooleanValue(ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName))
                            Else
                                SQL &= SQLBooleanValue(False)
                            End If
                        Else
                            If Not ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) Is DBNull.Value Then
                                SQL &= " " + ds.Tables(ClassName).Rows(Rows)(ds.Tables(ClassName).Columns(Cols).ColumnName) + " "
                            Else
                                SQL &= " 0 "
                            End If

                        End If
                        Seperator = ","
                    End If
                Next
                SQL &= ") "

                REM Insert into database
                'If Validflg Then
                If ExecuteSQL(SQL) Then
                End If
                'End If
            Next

            REM Return successfull
            CloseConnection(objConn)

            REM Return successfull
            Return True

        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
            Return False
        End Try
    End Function
    Public Function ExportCSV(ByVal ExportDir As String, ByRef Row As ValueType) As Boolean
        Dim SQL As String
        Dim ErrLoc As String = ClassName + ".ExportCSV"

        Dim ds As DataSet
        Dim r As DataRow
        Dim StrLine As String

        Try
            REM Get a data of all records
            ds = GetDS()

            REM If there is an error let us know about it
            If ErrMsg <> "" Then MsgBox(ErrMsg)

            REM Create a file name corresponding to the database table name
            Dim fs As FileStream = New FileStream(ExportDir & "\" & ClassName & ".txt", FileAccess.Write)
            Dim w As StreamWriter = New StreamWriter(fs)   ' create a Char writer 

            Dim i As Integer
            Dim Seperator As String = ""
            REM Create Header
            StrLine = ""
            Dim fields() As FieldInfo
            fields = Row.GetType.GetFields
            For i = 0 To fields.Length - 1
                StrLine &= Seperator & fields(i).Name
                Seperator = CSVSeperator
            Next
            w.WriteLine(StrLine)


            REM Check if there are no entries for this patient
            If ds.Tables(ClassName).Rows.Count = 0 Then
                w.WriteLine("EOF")   ' write message
                w.Close()            ' close the writer and underlying file
                REM Let us know that a posible error has happend
                MsgBox("No data in table " & ClassName)
                REM Return successfull because no actuall unexected error happened
                Return True
            End If

            REM Go through data set line by line
            For Each r In ds.Tables(ClassName).Rows '
                StrLine = ""
                Seperator = ""
                REM Read parameters
                For i = 0 To fields.Length - 1
                    StrLine &= Seperator & r(fields(i).Name)
                    Seperator = CSVSeperator
                Next
                w.WriteLine(StrLine)
            Next
            REM Write the End Of File Marker
            w.WriteLine("EOF")
            w.Close()   ' close the writer and underlying file

            REM Return successfull
            Return True

        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc, SQL)
            Return False
        End Try
    End Function
    Public Function ImportCSV(ByVal ImportDir As String, ByRef Row As ValueType) As Boolean
        Dim SQL As String
        Dim ErrLoc As String = ClassName + ".ImportCSV"

        Dim StrTitle As String                    ' Used to verify the header of the file
        Dim StrLine As String                     ' An individuel line of data
        Dim strColumns() As String                ' An Array containg the columns of the current line
        Dim i As Integer                          ' Index

        Try
            REM Open file name for reading
            Dim r As StreamReader = New StreamReader(ImportDir & "\" & ClassName & ".txt", FileAccess.Read)   ' create a Char writer 

            REM Create Header string to check
            Dim Seperator As String = " "
            REM Create Header
            StrTitle = ""
            Dim fields() As FieldInfo
            fields = Row.GetType.GetFields
            For i = 0 To fields.Length - 1
                StrTitle &= Seperator & fields(i).Name
                Seperator = CSVSeperator
            Next

            StrLine = r.ReadLine

            REM If the header is not correct 
            If StrLine <> StrTitle Then
                MsgBox("Error in Header :" & ClassName)
                REM Return unsuccessfull
                Return False
            End If

            Dim strValue As String
            Dim dValue As Double
            Dim dtValue As DateTime
            Dim Validflg As Boolean
            Dim TypeStr As String = ""
            Dim Rows As Integer
            Dim Cols As Integer
            Dim SQLHeader As String

            SQLHeader = "INSERT INTO " + ClassName + " ( "
            For i = 0 To fields.Length - 1
                If Not fields(i).Name = TableIndex() Then
                    SQLHeader &= Seperator & fields(i).Name
                    Seperator = ","
                End If
            Next

            REM Loop for reading in data
            While StrLine <> "EOF"
                StrLine = r.ReadLine             ' Read one Row of Data
                strColumns = Split(StrLine, CSVSeperator) ' Split this row into an array based on ; as a seperator

                REM Check the number of columns in this row of data
                If fields.Length <> strColumns.Length And strColumns.Length <> 1 Then
                    MsgBox("Error wrong number of columns ")
                    REM Return unsuccessfull
                    Return False
                End If

                REM fill database
                SQLHeader &= ") VALUES ( "
                Validflg = True

                SQL = SQLHeader
                Seperator = ""
                For Cols = 0 To fields.Length - 1

                    REM determine type
                    REM Ideally I would like to read the type directly from the dataset
                    REM I have not found a way to do this so I pass the Row object and compare the names
                    REM and get the type
                    REM ==> Select Case ds.Tables(ClassName).Columns(Cols).DataType.ToString <==

                    For i = 0 To fields.Length - 1
                        If Not fields(i).Name = TableIndex() Then
                            Select Case fields(i).FieldType.ToString
                                Case "System.String"
                                    TypeStr = "String"
                                Case "System.DateTime"
                                    TypeStr = "DateTime"
                                Case Else
                                    TypeStr = ""
                            End Select
                        End If
                    Next

                    Try
                        Select Case TypeStr
                            Case "String"
                            Case "DateTime"
                                If Not IsDate(strColumns(Cols)) Then
                                    Validflg = False
                                End If
                                If strColumns(Cols) = "" Then
                                    Validflg = False
                                End If
                                If Validflg Then dtValue = CType(strColumns(Cols), DateTime)
                            Case ""
                                If Not IsNumeric(strColumns(Cols)) Then
                                    Validflg = False
                                End If
                        End Select
                    Catch ex As Exception
                        Validflg = False
                    End Try

                    If Not fields(Cols).Name = TableIndex() Then
                        SQL &= Seperator
                        If TypeStr = "DateTime" Then
                            SQL &= SQLDateValue(dtValue)
                        ElseIf TypeStr = "Boolean" Then
                            If strColumns(Cols).ToUpper = "TRUE" Then
                                SQL &= SQLBooleanValue(True)
                            ElseIf strColumns(Cols).ToUpper = "FALSE" Then
                                SQL &= SQLBooleanValue(False)
                            Else
                                MessageBox.Show("Invalid Boolean :" + strColumns(Cols))
                                SQL &= SQLBooleanValue(False)
                            End If
                        ElseIf TypeStr = "String" Then
                            SQL &= DBSTR(strColumns(Cols))
                        End If
                        Seperator = ","
                    End If
                Next
                SQL &= ") "
                REM Insert into database
                If Validflg Then
                    If ExecuteSQL(SQL) Then
                    Else
                    End If
                End If
            End While