dbcalss.vb

.net中word的扩展应用。用ado.net对word,excel进行存取_ADO.NET应用

Imports DAO
Public Class DBClass
    Public IsDirty As Boolean = False
    Private DBEng As New DAO.DBEngine
    Private DBConnect As Database
    'Public rsReportStdUnit As Recordset
    Public rsReport As Recordset
    Private rsUnit As Recordset
    Public tdfNew As TableDef
    Private Function FindStringNextPos1(ByVal source As String, ByVal str As String) As String
        Dim strArr() As String = source.Split(",")
        Dim s As String
        Dim s1 As String = ""
        For Each s In strArr
            If s.StartsWith(str, StringComparison.OrdinalIgnoreCase) Then
                s1 = s.Substring(str.Length)
                Exit For
            End If
        Next
        Return s1
    End Function
    Private Function FindStringNextPos(ByVal source As String, ByVal str As String) As String
        Dim strs() As String = {str.ToLower}
        Dim strArr() As String = source.ToLower.Split(strs, StringSplitOptions.None)
        Dim s1 As String = ""
        If strArr.Length > 1 Then
            Dim strArr1() As String = strArr(1).Split(",")
            If strArr1.Length > 0 Then
                s1 = strArr1(0)
            End If
        End If
        Return s1
    End Function
#Region "Translate Language"
    Private Sub AddNewProperty(ByVal obj As Object, ByVal strName As String, ByVal intType As Integer, ByVal varSetting As Object)
        Dim prp As DAO.Property
        'If varSetting = "" Then varSetting = " "
        prp = obj.CreateProperty(strName, intType, varSetting)
        obj.Properties.Append(prp)
        obj.Properties.Refresh()
    End Sub

    Public Function SetAccessProperty(ByVal obj As Object, ByVal strName As String, ByVal intType As Integer, ByVal varSetting As Object) As Boolean

        Dim prp As DAO.Property
        Const conPropNotFound As Integer = 3270

        On Error GoTo ErrorSetAccessProperty
        obj.Properties(strName) = varSetting
        obj.Properties.Refresh()
        Return True

ExitSetAccessProperty:
        Exit Function

ErrorSetAccessProperty:
        If Err.Number = conPropNotFound Then
            AddNewProperty(obj, strName, intType, varSetting)
            SetAccessProperty = True
            Resume ExitSetAccessProperty
        Else
            MsgBox(Err.Number & ": " & vbCrLf & Err.Description)
            Return False
            Resume ExitSetAccessProperty
        End If
    End Function

    Public Sub ChangeLang(ByRef tabReport As Object)    '对 report、 reportStdUnit 表翻译
        'Dim DBC1 As Database = DBEng.OpenDatabase("Science.MDB")
        'Dim tabReport As TableDef = DBC1.TableDefs("report")
        'Dim propt, ppt As DAO.Property
        Try
            Dim i As Integer
            For i = 1 To tabReport.Fields.Count
                ' On Error Resume Next
                Dim fld As DAO.Field = tabReport(i - 1)
                'propt = fld.Properties("description")
                'ppt = Nothing
                'ppt = fld.Properties("Caption")
                Dim str1 As String = fld.Properties("description").Value
                str1 = FindStringNextPos(str1, "CHS:")
                If str1 = "" Then str1 = fld.Name
                SetAccessProperty(tabReport.Fields(fld.Name), "Caption", DAO.DataTypeEnum.dbText, str1)
forEnd:
            Next
            'tabReport = Nothing
            'DBC1.Close()
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try

    End Sub

#End Region


    Public Function GetUnitID(ByVal fld As String) As Integer
        Dim str1 As String = rsReport(fld).Properties("description").Value
        'Dim id As Integer = UnitsClass.unitsSysOp1.NoneUIndex
        Dim id As Integer = 1
        Dim id1 As Integer = 0
        str1 = FindStringNextPos(str1, "Unit:")
        If str1 <> "" Then id = Val(str1)
        'rsUnit()
        Return id
    End Function
    ' 
    Public Sub OpenFile(ByVal fname As String)
        Try
            DBConnect = DBEng.OpenDatabase(fname, False, False)
            tdfNew = DBConnect.TableDefs("report")
            ChangeLang(tdfNew)
            rsReport = DBConnect.OpenRecordset("select * from report", DAO.RecordsetTypeEnum.dbOpenDynaset) ', , dbOptimistic)

            'MessageBox.Show(tdfNew(0).Properties("caption").Value)
            'rsUnit = DBConnect.OpenRecordset("Unit", DAO.RecordsetTypeEnum.dbOpenDynaset) ', , dbBatchOptimistic)
            'ChangeUnit()
        Catch ex As Exception
            MsgBox("打开数据库过程出错!" + vbCrLf + "错误号:" + CStr(Err.Number) + vbCrLf + Err.Description + vbCrLf + "致命性错误;需退出,重新进入程序!")
        End Try
    End Sub


    Protected Overrides Sub Finalize()
        MyBase.Finalize()
        DBConnect.Close()
        'rsReport.Close()
        'rsUnit.Close()
    End Sub


End Class