MSOffice小知识:Access数据库的生成、修理压缩和版本转换

Author:水如烟

在前面的基本框架中给出了代码下载。到现在，其中一些文件需要修改，主要的是考虑了远程对象的使用，就是CreateObject(Application,Server)，加了Server。只是，现在给出的代码还是只是支持本地的。

修改后的有关文件如下：
ApplicationBase.vb

Option Strict Off
Namespace uOffice
    Public MustInherit Class ApplicationBase
        Implements IDisposable

        Friend gOfficeApplication As ApplicationEnum
        Protected gApplicationObject As Object

        Private gBeforeProcessStartTime As Date
        Private gAfterProcessStartTime As Date

        Private gServer As String = ""

        Friend Sub CreateInstance(ByVal officeApplication As ApplicationEnum, ByVal server As String)
            gOfficeApplication = officeApplication
            gServer = server
            CreateInstance()
        End Sub

        Private Sub CreateInstance()
            '保留原有配置
            SaveDefaultPropertiesWhenApplicationInitialize()

            '取实例前时间
            gBeforeProcessStartTime = Now

            '实例
            Select Case gOfficeApplication
                Case ApplicationEnum.Access
                    gApplicationObject = CreateObject(SR.GetString("Office_Application_Access"), gServer)
                Case ApplicationEnum.Excel
                    gApplicationObject = CreateObject(SR.GetString("Office_Application_Excel"), gServer)
                Case ApplicationEnum.Word
                    gApplicationObject = CreateObject(SR.GetString("Office_Application_Word"), gServer)
            End Select

            '取实例后时间
            gAfterProcessStartTime = Now
        End Sub

        ''' <summary>
        ''' 退出主进程
        ''' </summary>
        Public Sub Quit()
            '置回默认设置,如Excel.DisplayAlerts = True
            ResetDefaultPropertiesBeforeApplicationRelease()

            '释放其它对象,如Excel.Worksheets
            RealseInternalComObjectsBeforeApplicationRelease()

            '释放主进程,如Excel
            Application_Quit()

            '保证完全退出
            Try
                ApplicationRelease()
            Catch ex As Exception
            End Try
        End Sub

        ''' <summary>
        ''' 退出其它Com对象
        ''' </summary>
        Protected MustOverride Sub RealseInternalComObjectsBeforeApplicationRelease()

        Protected Overridable Sub Application_Quit()
            gApplicationObject.Quit()
        End Sub

        ''' <summary>
        ''' 退出OfficeApplication进程
        ''' </summary>
        Private Sub ApplicationRelease()
            ComObjReleaseMethod.ReleaseComObject(gApplicationObject)
            Select Case gOfficeApplication
                Case ApplicationEnum.Access
                    ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Access"), gBeforeProcessStartTime, gAfterProcessStartTime, gServer)
                Case ApplicationEnum.Excel
                    ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Excel"), gBeforeProcessStartTime, gAfterProcessStartTime, gServer)
                Case ApplicationEnum.Word
                    ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Word"), gBeforeProcessStartTime, gAfterProcessStartTime, gServer)
            End Select
        End Sub

        ''' <summary>
        ''' 保存默认设置
        ''' </summary>
        Protected MustOverride Sub SaveDefaultPropertiesWhenApplicationInitialize()

        ''' <summary>
        ''' 置回默认设置
        ''' </summary>
        Protected MustOverride Sub ResetDefaultPropertiesBeforeApplicationRelease()

        '///以下为实现IDisposable接口IDE自动创建的代码
        Private disposedValue As Boolean = False        ' To detect redundant calls

        ' IDisposable
        Protected Overridable Sub Dispose(ByVal disposing As Boolean)
            If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: free unmanaged resources when explicitly called
                    Quit()
                End If

                ' TODO: free shared unmanaged resources
            End If
            Me.disposedValue = True
        End Sub

#Region " IDisposable Support "
        ' This code added by Visual Basic to correctly implement the disposable pattern.
        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
#End Region

    End Class
End Namespace

ApplicationBaseCommon.vb

Option Strict Off

Namespace uOffice
    Partial Public Class ApplicationBase

        ''' <summary>
        ''' 设置对象可见性
        ''' </summary>
        ''' <param name="visible"></param>
        ''' <remarks></remarks>
        Public Sub SetVisible(ByVal visible As Boolean)
            Me.gApplicationObject.Visible = visible
        End Sub

        ''' <summary>
        ''' 服务器
        ''' </summary>
        ''' <remarks>本地时字符串为空,否则如\\MyComputer</remarks>
        Public ReadOnly Property Server() As String
            Get
                Return gServer
            End Get
        End Property

        ''' <summary>
        ''' 版本号
        ''' </summary>
        Public ReadOnly Property Version() As String
            Get
                Return Me.gApplicationObject.Version
            End Get
        End Property

        ''' <summary>
        ''' 默认文件地址
        ''' </summary>
        ''' <remarks>一般在MyDocuments目录下,按具体情形重载</remarks>
        Public Overridable ReadOnly Property DefaultFilePath() As String
            Get
                Return System.Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
            End Get
        End Property

        ''' <summary>
        ''' 稍停数秒
        ''' </summary>
        ''' <param name="seconds">秒数</param>
        ''' <remarks></remarks>
        Protected Sub WaitingSeconds(ByVal seconds As Integer)
            Dim tmpNow As Date = Now
            While Now.Subtract(tmpNow).Seconds < seconds
                Windows.Forms.Application.DoEvents()
            End While
        End Sub

    End Class
End Namespace

ComObjReleaseMethod.vb

Namespace uOffice
    Friend Class ComObjReleaseMethod

        Friend Shared Sub Invoke(ByVal comObj As Object, ByVal methodName As String, ByVal parameters() As Object)
            Dim mMethod As Reflection.MethodInfo = comObj.GetType.GetMethod(methodName)
            mMethod.Invoke(comObj, parameters)
        End Sub

        Friend Shared Sub ReleaseComObject(ByVal comObj As Object)
            System.Runtime.InteropServices.Marshal.ReleaseComObject(comObj)
            comObj = Nothing
        End Sub

        Friend Shared Sub KillProcess(ByVal comObjProcessName As String, ByVal beforeProcessStartTime As Date, ByVal afterProcessStartTime As Date)

            Dim mProcessList As Process()
            Dim mProcessStartTime As Date

            mProcessList = Process.GetProcessesByName(comObjProcessName)

            For Each tmpProcess As Process In mProcessList
                mProcessStartTime = tmpProcess.StartTime
                If mProcessStartTime.CompareTo(beforeProcessStartTime) > 0 AndAlso mProcessStartTime.CompareTo(afterProcessStartTime) < 0 Then
                    tmpProcess.Kill()
                End If
            Next

        End Sub

        Friend Shared Sub KillProcess(ByVal comObjProcessName As String, ByVal beforeProcessStartTime As Date, ByVal afterProcessStartTime As Date, ByVal Server As String)
            '暂只支持本地
            If Server = "" Then
                KillProcess(comObjProcessName, beforeProcessStartTime, afterProcessStartTime)
            Else

            End If

        End Sub

        Friend Shared Sub KillProcess(ByVal comObjProcessName As String)

            Dim mProcessList As Process()

            mProcessList = Process.GetProcessesByName(comObjProcessName)

            For Each tmpProcess As Process In mProcessList
                tmpProcess.Kill()
            Next

        End Sub

    End Class
End Namespace

相应的，有关的AccessApplication文件修改如下：

Namespace uOffice
    Public Class AccessApplication
        Inherits ApplicationBase

        Protected Overrides Sub SaveDefaultPropertiesWhenApplicationInitialize()

        End Sub

        Protected Overrides Sub ResetDefaultPropertiesBeforeApplicationRelease()

        End Sub

        Protected Overrides Sub RealseInternalComObjectsBeforeApplicationRelease()

        End Sub

        Sub New()
            Me.CreateInstance(ApplicationEnum.Access, "")
        End Sub

        Sub New(ByVal server As String)
            Me.CreateInstance(ApplicationEnum.Access, server)
        End Sub

        Private Function CurrentApplication() As Microsoft.Office.Interop.Access.Application
            Return DirectCast(Me.gApplicationObject, Microsoft.Office.Interop.Access.Application)
            'Return Me.gApplicationObject
        End Function

    End Class
End Namespace

为实现Access数据库的生成、修理压缩和版本转换，增加了以下文件。
AccessApplicationCommon.vb

Namespace uOffice
    Partial Public Class AccessApplication

        ''' <summary>
        ''' 默认数据库路径
        ''' </summary>
        Public Overrides ReadOnly Property DefaultFilePath() As String
            Get
                '以下的字串是Default Database Directory
                Return Me.CurrentApplication.GetOption(SR.GetString("Office_Access_Default_Database_Directory")).ToString
            End Get
        End Property

        '取数据库文件全名
        Private Function FullFileName(ByVal file As String) As String
            Dim mFullfilename As String = file.Trim

            If mFullfilename = "" Then Return ""

            If mFullfilename.IndexOf("\") = -1 Then '默认目录上
                mFullfilename = Me.DefaultFilePath & mFullfilename
            End If

            Dim filename As String = mFullfilename.Substring(mFullfilename.LastIndexOf("\") + 1) '取文件名称,检查是否有后缀,没有加上.mdb
            If filename.IndexOf(".") = -1 Then
                mFullfilename &= ".mdb"
            End If

            Return mFullfilename
        End Function

    End Class
End Namespace

AcFileFormatEnum.vb

Namespace uOffice

    Public Enum AcFileFormatEnum
        Access2 = 2
        Access2000 = 9
        Access2002 = 10
        Access95 = 7
        Access97 = 8
    End Enum

End Namespace

这部分功能实现的主文件
AccessApplicationDatabase.vb

Option Strict Off

Namespace uOffice
    Partial Public Class AccessApplication

        ''' <summary>
        ''' 关闭当前数据库
        ''' </summary>
        Public Sub CloseCurrentDatabase()
            If Me.CurrentApplication.CurrentDb IsNot Nothing Then
                Me.CurrentApplication.CloseCurrentDatabase()
            End If

            '停1秒后执行
            WaitingSeconds(1)

        End Sub

        ''' <summary>
        ''' 删除数据库
        ''' </summary>
        ''' <param name="file">数据库文件名</param>
        Public Sub DeleteDatabase(ByVal file As String)
            file = FullFileName(file).ToLower

            If Not IO.File.Exists(file) Then Exit Sub

            '如果它是当前打开的数据库，则要关闭
            If Me.CurrentApplication.CurrentDb IsNot Nothing AndAlso IO.File.Equals(file, Me.CurrentApplication.CurrentDb.Name.ToLower) Then
                Me.CloseCurrentDatabase()
            End If

            IO.File.Delete(file)

            '停1秒后执行
            WaitingSeconds(1)
        End Sub

        ''' <summary>
        ''' 打开数据库
        ''' </summary>
        ''' <param name="file">数据库文件名</param>
        ''' <param name="exclusive">独占打开</param>
        ''' <param name="password">密码</param>
        ''' <remarks></remarks>
        Public Sub OpenCurrentDatabase(ByVal file As String, ByVal exclusive As Boolean, ByVal password As String)
            file = FullFileName(file)

            If Not IO.File.Exists(file) Then Exit Sub

            '关闭当前数据库
            CloseCurrentDatabase()

            Me.CurrentApplication.OpenCurrentDatabase(file, exclusive, password)

        End Sub

        ''' <summary>
        ''' 共享打开数据库，空密码
        ''' </summary>
        ''' <param name="file">数据库文件名</param>
        ''' <remarks></remarks>
        Public Sub OpenCurrentDatabase(ByVal file As String)

            Me.OpenCurrentDatabase(file, False, "")

        End Sub

        ''' <summary>
        ''' 创建数据库
        ''' </summary>
        ''' <param name="file">数据库文件名.如果网络支持，也可以按以下形式指定网络路径：\\Server\Share\Folder\Filename</param>
        ''' <remarks>若已存在相同文件的数据库，则被删除</remarks>
        Public Sub CreateDatabase(ByVal file As String)
            file = FullFileName(file).ToLower

            '若已存在，则删除
            DeleteDatabase(file)

            '关闭当前数据库
            Me.CloseCurrentDatabase()

            '生成新数据库并给置为当前数据库
            Me.CurrentApplication.NewCurrentDatabase(file)
        End Sub

        ''' <summary>
        ''' 压缩和修复指定的数据库
        ''' </summary>
        ''' <param name="SourceFile">要压缩和修复的数据库或项目文件的完整路径和文件名</param>
        ''' <param name="DestinationFile">完整的路径和文件名，代表所返回文件的保存位置</param>
        ''' <returns>如果处理成功，返回 True</returns>
        ''' <remarks></remarks>
        Public Function RepairDatabase(ByVal SourceFile As String, ByVal DestinationFile As String) As Boolean

            SourceFile = FullFileName(SourceFile)
            DestinationFile = FullFileName(DestinationFile)

            '如果要处理的数据库为当前打开的数据库，则要关闭
            If Me.CurrentApplication.CurrentDb IsNot Nothing AndAlso Me.CurrentApplication.CurrentDb.Name.ToLower.Equals(SourceFile.ToLower) Then
                Me.CloseCurrentDatabase()
            End If

            '如果目的文件存在，则删除
            If IO.File.Exists(DestinationFile) Then IO.File.Delete(DestinationFile)

            '滞1秒后执行
            WaitingSeconds(1)

            Return Me.CurrentApplication.CompactRepair(SourceFile, DestinationFile, True)
        End Function

        ''' <summary>
        ''' 转换版本
        ''' </summary>
        ''' <param name="SourceFile">待转换的文件名称</param>
        ''' <param name="DestinationFile">转换后的文件名称</param>
        ''' <param name="DestinationFileFormat">转换后的文件版本</param>
        ''' <remarks>并非所有版本都能转换成功</remarks>
        Public Sub ConvertAccessProject(ByVal SourceFile As String, ByVal DestinationFile As String, ByVal DestinationFileFormat As AcFileFormatEnum)
            SourceFile = FullFileName(SourceFile)
            DestinationFile = FullFileName(DestinationFile)

            Me.CurrentApplication.ConvertAccessProject(SourceFile, DestinationFile, DestinationFileFormat)
        End Sub

    End Class
End Namespace

至于其它功能，比如设密码、建用户组，可以参考Access、Dao的帮助文档，并辅以Reflector来做。我不再写这部分的代码了。
至于一些关键参数，比如Default Database Directory是怎么知道的，我是查了注册表。我手头的资料也非常的有限。

对于Access，如何取表，建立和修改表，这部分可以用Sql语句实现了，可以脱离Access.Application来做。当然，上面的部分，可以用别的方法来实现，我只是提供了在Access环境下的一种实现方法。