xmltable.vb

对现代企业来说

        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

            Dim ds As DataSet
            ds = GetDS()

            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


            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

                For i = 0 To fields.Length - 1
                    Select Case fields(Cols).FieldType.ToString
                        Case "System.String"
                            fields(i).SetValue(Row, strColumns(i))
                        Case "System.DateTime"
                            fields(i).SetValue(Row, CDate(strColumns(i)))
                        Case "System.Boolean"
                            fields(i).SetValue(Row, StringToBoolean(strColumns(i)))
                        Case "System.Int32"
                            fields(i).SetValue(Row, CInt(strColumns(i)))
                        Case Else
                            fields(i).SetValue(Row, strColumns(i))
                    End Select
                Next

            End While

            REM Return successfull
            r.Close()
            ds.WriteXml(_XMLPath)
            Return True

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

    End Function
    Public Function FindRecord(ByRef Row As ValueType) As Boolean
        Dim ErrLoc As String = ClassName + ".FindRecord"

        Try

            Dim Cols, Rows As Integer
            Dim ds As DataSet
            ds = GetDS()

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

            Dim CopyRowFlag As Boolean
            For Rows = 0 To ds.Tables(ClassName).Rows.Count - 1
                For Cols = 0 To fields.Length - 1
                    If Not fields(Cols).GetValue(Row) Is Nothing Then
                        Select Case fields(Cols).FieldType.ToString
                            Case "System.String"
                                Dim str, strDS As String
                                str = fields(Cols).GetValue(Row)
                                strDS = ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name)
                                If strDS.ToUpper.IndexOf(str.ToUpper) > 0 Then CopyRowFlag = True
                            Case "System.DateTime"
                                If fields(Cols).GetValue(Row) = ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Then CopyRowFlag = True
                            Case "System.Boolean"
                                If fields(Cols).GetValue(Row) = ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Then CopyRowFlag = True
                            Case "System.Int32"
                                If fields(Cols).GetValue(Row) = ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Then CopyRowFlag = True
                            Case Else
                                If fields(Cols).GetValue(Row) = ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Then CopyRowFlag = True
                        End Select
                    End If
                Next
                If CopyRowFlag Then
                    For Cols = 0 To fields.Length - 1
                        If Not ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Is DBNull.Value Then
                            fields(Cols).SetValue(Row, ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name))
                        Else
                            fields(Cols).SetValue(Row, Nothing)
                            'ErrMsg += "[-->" + ErrLoc + "<--] " + MyPropertyInfo.Name + " is NULL "
                            'MsgBox(ErrMsg) ' This error warnents a warning to the user
                        End If
                    Next
                End If
                If CopyRowFlag Then Return True
            Next

            Return False


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

    End Function
    Public Function GetRecord(ByRef Row As ValueType, ByVal RowIndex As Integer) As Boolean
        Dim ErrLoc As String = ClassName + ".GetRecord"

        Try


            Dim Cols, Rows As Integer
            Dim ds As DataSet
            ds = GetDS()

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

            Dim CopyRowFlag As Boolean
            For Rows = 0 To ds.Tables(ClassName).Rows.Count - 1
                If RowIndex = ds.Tables(ClassName).Rows(Rows)(TableIndex) Then
                    CopyRowFlag = True
                End If
                If CopyRowFlag Then
                    For Cols = 0 To fields.Length - 1
                        If Not ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Is DBNull.Value Then
                            fields(Cols).SetValue(Row, ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name))
                        Else
                            fields(Cols).SetValue(Row, Nothing)
                        End If
                    Next
                End If
                If CopyRowFlag Then Return True
            Next

            Return False


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

    End Function
    Public Function GetLastRecord(ByRef Row As ValueType) As Boolean
        Dim ErrLoc As String = ClassName + ".GetLastRecord"

        Try
            Dim ds As DataSet = New DataSet
            ds = GetDS()
            If ds.Tables(ClassName).Rows.Count = 0 Then Return False

            Dim i As Integer
            Dim LastRow As Integer
            LastRow = ds.Tables(ClassName).Rows.Count - 1

            Dim fields() As FieldInfo
            fields = Row.GetType.GetFields
            For i = 0 To fields.Length - 1
                If Not ds.Tables(ClassName).Rows(LastRow)(fields(i).Name) Is DBNull.Value Then
                    Select Case fields(i).FieldType.ToString
                        Case "System.String"
                            fields(i).SetValue(Row, ds.Tables(ClassName).Rows(LastRow)(fields(i).Name))
                        Case "System.DateTime"
                            fields(i).SetValue(Row, CDate(ds.Tables(ClassName).Rows(LastRow)(fields(i).Name)))
                        Case "System.Boolean"
                            fields(i).SetValue(Row, StringToBoolean(ds.Tables(ClassName).Rows(LastRow)(fields(i).Name)))
                        Case "System.Int32"
                            fields(i).SetValue(Row, CInt(ds.Tables(ClassName).Rows(LastRow)(fields(i).Name)))
                        Case Else
                    End Select
                Else
                    fields(i).SetValue(Row, Nothing)
                End If
            Next

            Return True

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

    End Function
    Public Function PutRecord(ByRef Row As ValueType, ByVal RowIndex As Integer) As Boolean
        Dim ErrLoc As String = ClassName + ".PutRecord"

        Try
            Dim Cols, Rows As Integer
            Dim ds As DataSet
            ds = GetDS()

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

            Dim CopyRowFlag As Boolean
            For Rows = 0 To ds.Tables(ClassName).Rows.Count - 1
                If RowIndex = ds.Tables(ClassName).Rows(Rows)(TableIndex) Then
                    CopyRowFlag = True
                End If
                If CopyRowFlag Then
                    For Cols = 0 To fields.Length - 1
                        If Not ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) Is DBNull.Value Then
                            ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) = fields(Cols).GetValue(Row)
                        Else
                            ds.Tables(ClassName).Rows(Rows)(fields(Cols).Name) = DBNull.Value
                        End If
                    Next
                End If
            Next
            If CopyRowFlag Then
                ds.WriteXml(_XMLPath)
                Return True
            Else
                Return False
            End If


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

    End Function
    Public Function InsertRecord(ByRef Row As ValueType) As Boolean
        Dim ErrLoc As String = ClassName + ".InsertRecord"
        Try

            Dim Cols As Integer
            Dim ds As DataSet
            ds = GetDS()

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

            Dim dTable As DataTable
            dTable = ds.Tables(ClassName)
            dTable = DSAddRows(Row, dTable)

            ds.WriteXml(_XMLPath)
            Return True

        Catch ex As Exception
            ErrMsg = UnHandledError(ex.ToString(), ErrLoc)
            Return False
        End Try
    End Function
    Public Function StringToBoolean(ByVal str As String) As Boolean
        REM Function to convert boolean format into a format recognized by the database
        If str.ToUpper = "TRUE" Then
            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