|
|
|
7i24.Com不停为您服务
使用 Microsoft 数据引擎创建和部署 Access 解决方案
Scott Smith
Microsoft Corporation
2001 年 4 月
适用于：
Microsoft® Office XP Developer
摘要：可以使用 Microsoft Office XP Developer 打包向导来打包 Access 数据项目 (Access Data Project, ADP) 解决方案，该方案包括一个 Access Runtime/MSDE 数据库以便于分发。然而，您必须提供所需代码以便查找和启动 MSDE 服务器，以及将数据库附加到该服务器。本文将提供此类代码的示例。
目录
简介
启动 MSDE
附加数据库
创建连接
进行整合
问题
启动窗体代码
简介
Microsoft® Desktop Engine (MSDE) 是 Microsoft Office XP Developer 附带的与 SQL Server 2000 兼容的数据存储服务器，允许再次分发。Office XP Developer 打包向导具有一个选项，可在打包 Access 数据项目 (ADP) 解决方案时包括 MSDE。在用户的计算机上安装解决方案后，MSDE 会随之安装。但是，MSDE 并不启动，数据库也不会附加到 MSDE。
本文提供了查找服务器、启动服务器（如果该服务器尚未启动）以及将数据库附加到服务器所需的代码。该代码特定用于 ADP；然而，大部分代码可用于任意 Visual Basic®for Applications (VBA) 应用程序。
一个前提条件是您必须具有 ADP 解决方案，并且其数据存储在 SQL Server 或 MSDE 数据库中。本文结尾部分提供该解决方案（不带数据库）的代码。还需注意，必须设置对 Microsoft SQL DMO 对象库和 Microsoft Scripting Runtime 的引用。
启动 MSDE
此解决方案启动时，ADP 设置处于无连接状态。初次启动解决方案后，它将执行检查以查看是否已进行连接，如果没有，则将执行连接任务。由于同一台计算机上可有多个 MSDE 实例，而且实例的完整名称基于计算机名称与实例的名称组合，所以用于查找和启动 MSDE 的代码就很长。此示例代码将返回计算机上所有可用的 SQL/MSDE 实例，但存在限制：它仅使用找到的第一个实例。本文并不准备介绍该代码的详细使用情况，但是在本文结尾处的模块 modGetSQLInstances 部分，将提供有关说明。
如果知道要附加到的服务器的名称，可使用以下函数检查服务器的状态，并在必要时启动该服务器（请参见模块 modFirstRunADP）：
Public Function sStartMSDE(sSvrName As String, sUID As String, sPWD As String) As String
'********************************************************************
'该子例程将打开 MSDE。如果服务器已启动，
'错误捕获将退出该函数，服务器照常运行
'
'请注意，它不会将 SQL Service Manager 放到启动栏上。
'
'输入：
' sSvrName 要启动的服务器
' sUID 启动服务器的用户
' sPWD 该用户的口令
'
'输出：
' 启动解决方案
'
'引用：
' SQLDMO
'********************************************************************
Dim osvr As SQLDMO.SQLServer
Set osvr = CreateObject("SQLDMO.SQLServer")
'创建 SQLDMO 服务器对象
On Error GoTo StartError '错误捕获
osvr.LoginTimeout = 60
'启动服务器
osvr.start True, sSvrName, sUID, sPWD
'返回结果
sStartMSDE = "已启动 " & sSvrName
ExitSub:
Exit Function
StartError:
If Err.Number = -2147023840 Then
'如果服务器已在运行，
'并且已在 NT 上执行 Server.Start，将产生此错误
osvr.Connect sSvrName, sUID, sPWD '连接到服务器
'返回结果
sStartMSDE = sSvrName & " 已启动"
Else '未知错误
'返回结果
sStartMSDE = Err.Description
End If
Resume ExitSub
End Function
附加数据库
此函数执行将 MDF 数据文件附加到所选的服务器的任务。在此例中，我们使用了某些常量，您必须对它们进行相应更改，特别是数据库名“DemoDatabase”和 MDF 数据文件“adp1sql.mdf”。此外，该例还假设您使用 SQL 验证来附加到 MSDE 服务器（请参见模块 modFirstRunADP）：
点击此处浏览
创建连接
将数据库附加到服务器后，最后一步就是创建 ADP 文件与数据库之间的连接。以下函数将执行此步骤（请参见模块 modFirstRunADP）：
Public Function sCopyMDF(sSvrName As String, sUID As String, sPWD As String, sMDFName As String) As String
'********************************************************************
'此函数将检查 ADP 中是否存在连接。如果连接
'不存在，它将使用输入参数创建一个连接
'
'输入：
' sSvrName 要启动的服务器
' sUID 启动服务器的用户
' sPWD 该用户的口令
' sDatabase MSDE 数据库的名称
'
'输出：
' 复制解决方案
'
'********************************************************************
On Error GoTo sCreateConnectionTrap:
If Application.CurrentProject.BaseConnectionString = "" Then
'此 ADP 无连接
sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & sPWD _
& ";PERSIST SECURITY INFO=TRUE;USER ID=" & sUID & "; _
INITIAL CATALOG=" & sDatabase & ";DATA SOURCE=" & sSvrName
Application.CurrentProject.OpenConnection sConnectionString
sCreateConnection = "已创建到此数据库的连接 " & sDatabase
Else '存在连接
sCreateConnection = "连接存在于 " & sDatabase
End If
sCreateConnectionExit:
Exit Function
sCreateConnectionTrap:
sCreateConnection = Err.Description
Resume sCreateConnectionExit
End Function
本文还包括用于从服务器删除数据库以及从 ADP 去除连接信息的代码。可将其用于测试目的（请参见模块 modCleanup）。
进行整合
要创建可分发的 Access Runtime/MSDE 数据库解决方案，必需具有此代码、数据库以及 Office XP Developer 打包向导。以下步骤将介绍如何进行整合：
针对现有的 SQL Server 或 MSDE 创建 Access ADP 解决方案。
在启动窗体中放置启动窗体代码。可能需要修改此代码以便符合启动窗体的要求。如果不想重置代码，就应删除 btnReset 函数。将该窗体设置为在启动时装载（菜单“工具”|“启动”）。
添加其余代码作为项目中的模块，并进行修改。
将 References 设置为 Microsoft SQL DMO 对象库和 Microsoft Scripting Runtime。
保存该项目，然后运行 Office XP Developer 打包向导。如果从“开始”菜单运行打包向导，请选择 ADP 文件作为主文件。
在打包向导中，确保已设置以下选项：
已选择 Access Runtime。
已选择 MSDE。
还可以选择从快捷菜单属性中，为帮助文件、标题、图标和启动位图设置 Access Runtime 配置文件。
完成打包向导，并构建安装程序。
至此，该解决方案应准备就绪，可以安装到任一台计算机。
问题
最难解决的问题是确定用户计算机上特定 MSDE 实例的任务。如果随解决方案安装的 MSDE 实例是计算机上唯一的实例，则此解决方案最为有效。如果有多个实例，并且您需要将数据库连接到特定实例，就必须提供额外代码，以便向用户请求实例名。遗憾的是，打包向导并不保存它所安装的实例名称。
启动窗体代码
提供此代码的目的是出于完整性的考虑，并演示如何将其它所有部分整合到一起。要使用此代码，请创建窗体，然后在其上放置一个按钮（名为 btnReset）。将此代码附于窗体后面，然后把此窗体设置为启动时装载。
Option Compare Database
Option Explicit
Dim SQLInstance As String
'此窗体具有一个按钮，可重置解决方案 – btnReset。 这将
'使 ADP 处于无连接状态，并从服务器删除数据库，
'从而易于对代码进行重新测试。
'然而，不应将其作为已部署的解决方案的一部分。
Private Sub btnReset_Click()
'可以重置解决方案，方法是使 ADP 处于非连接状态，然后从
'服务器删除数据库。 DeleteMDF SQLInstance, "sa", "", "DemoDatabase"
'删除当前数据库
MakeADPConnectionless '使 ADP 处于无连接状态
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim sSQLInt As String
Dim b As Boolean
Dim x As Integer
'在该计算机上查找可用的 MSDE/SQL 实例
x = GetValidSQLInstances(sSQLInt, b)
SQLInstance = ComputerName & "\" & sSQLInt
'从 modFistRunADP 调用 startMSDE，并将结果返回到消息框
MsgBox sStartMSDE(SQLInstance, "sa", "")
'从 modFistRunADP 调用 sCopyMDF，并将结果返回到消息框
MsgBox sCopyMDF(SQLInstance, "sa", "", "starssql.mdf")
'从 modFistRunADP 调用 sCreateConnection，并将结果返回到消息
'框
MsgBox sCreateConnection(SQLInstance, "sa", "", "DemoDatabase")
End Sub
模块 modGetSQLInstances
点击此处浏览
模块 modFirstRunADP
Option Compare Database
'此项目中的代码将演示如何把 MDF 文件
'连接到本地 MSDE，然后建立与无连接状态的 ADP
'的连接。
Public Function sStartMSDE(sSvrName As String, sUID As String, sPWD As String) As String
'********************************************************************
'该子例程将打开 MSDE。如果服务器已启动，
'错误捕获将退出该函数，服务器照常运行
'
'请注意，它不会将 SQL Service Manager 放到启动栏上。
'
'输入：
' sSvrName 要启动的服务器
' sUID 启动服务器的用户
' sPWD 该用户的口令
'
'输出：
' 启动解决方案
'
'引用：
' SQLDMO
'********************************************************************
Dim osvr As SQLDMO.SQLServer
Set osvr = CreateObject("SQLDMO.SQLServer")
'创建 SQLDMO 服务器对象
On Error GoTo StartError '错误捕获
osvr.LoginTimeout = 60
'启动服务器
osvr.start True, sSvrName, sUID, sPWD
'返回结果
sStartMSDE = "已启动 " & sSvrName
ExitSub:
Exit Function
StartError:
If Err.Number = -2147023840 Then
'如果服务器已在运行，
'并且已在 NT 上执行了 Server.Start，将产生此错误
osvr.Connect sSvrName, sUID, sPWD '连接到服务器
'返回结果
sStartMSDE = sSvrName & " 已启动"
Else '未知错误
'返回结果
sStartMSDE = Err.Description
End If
Resume ExitSub
End Function
Public Function sCopyMDF(sSvrName As String, sUID As String, sPWD As String, sMDFName As String) As String
'********************************************************************
'此函数将检查 MSDE 服务器上是否存在 DemoDatabase。如果数据库存在，此函数将
'从 ADP 所在的位置把 adp1
sql.mdf 复制到 MSDE Data
'目录。接着，附加 adp1sql.mdf。
'
'输入：
' sSvrName 要启动的服务器
' sUID 启动服务器的用户
' sPWD 该用户的口令
' sMDFName 要复制的 MSDE 数据库的名称
'
'输出：
' 复制解决方案
'
'引用：
' SQLDMO
' Scripting Runtime
'********************************************************************
Dim FSO As Scripting.FileSystemObject
Dim osvr As SQLDMO.SQLServer
Dim strMessage As String
Dim db As Variant
Dim fDataBaseFlag As Boolean
Dim x
On Error GoTo sCopyMDFTrap
'FSO.Copyfile 和 oSvr.AttachDBWithSingleFile
'中使用的驱动器名称需要与最终用户计算机上的
'Program Files 和 MSDE 的位置相匹配。
'初始化返回值
sCopyMDF = ""
fDataBaseFlag = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set osvr = CreateObject("SQLDMO.SQLServer")
'登录到数据库
osvr.Connect sSvrName, sUID, sPWD
x = osvr.Databases.Count '如果失败，DMO 需要进行初始化
'通过在本地 MSDE 服务器上循环检查所有数据库名称，
'检查 DemoDatabase 是否存在于该服务器。
For Each db In osvr.Databases
If db.Name = "DemoDatabase" Then '该数据库存在
fDataBaseFlag = True
Exit For '退出循环
End If
Next
If Not fDataBaseFlag Then '不存在名为 DemoDatabase 的数据库
'将文件复制到数据文件夹
FSO.CopyFile Application.CurrentProject.Path & "\" & sMDFName, _
osvr.Databases("主数据库").PrimaryFilePath & sMDFName, True
'附加到数据库
strMessage = osvr.AttachDBWithSingleFile("DemoDatabase", _
osvr.Databases("主数据库").PrimaryFilePath & sMDFName)
'返回结果
sCopyMDF = "已复制 " & sMDFName & " 到 MSDE 数据目录"
Else
sCopyMDF = sMDFName & " 退出 MSDE 服务器"
End If
ExitCopyMDF:
osvr.Disconnect
Set osvr = Nothing
Exit Function
sCopyMDFTrap:
If Err.Number = -2147216399 Then 'DMO 需进行初始化
Resume Next
Else
sCopyMDF = Err.Description
End If
Resume ExitCopyMDF
Exit Function
End Function
Public Function sCreateConnection(sSvrName As String, sUID As String, sPWD As String, sDatabase As String) As String
'********************************************************************
'此函数将检查 ADP 中是否存在连接。如果连接
'不存在，它将使用输入参数创建一个连接
'
'输入：
' sSvrName 要启动的服务器
' sUID 启动服务器的用户
' sPWD 该用户的口令
' sDatabase MSDE 数据库的名称
'
'输出：
' 复制解决方案
'
'********************************************************************
On Error GoTo sCreateConnectionTrap:
If Application.CurrentProject.BaseConnectionString = "" Then
'此 ADP 无连接
sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & sPWD _
& ";PERSIST SECURITY INFO=TRUE;USER ID=" & sUID & "; _
INITIAL CATALOG=" & sDatabase & ";DATA SOURCE=" & sSvrName
Application.CurrentProject.OpenConnection sConnectionString
sCreateConnection = "已创建到此数据库的连接 " & sDatabase
Else '存在连接
sCreateConnection = "连接存在于 " & sDatabase
End If
sCreateConnectionExit:
Exit Function
sCreateConnectionTrap:
sCreateConnection = Err.Description
Resume sCreateConnectionExit
End Function
模块 modCleanup
Option Compare Database
'按照设计，此代码用于重置该示例。然而，它将使用 MakeADPConnectionless 创建
'无连接的 ADP。
Sub MakeADPConnectionless()
'********************************************************************
'此子例程将从 ADP 删除连接,使其
'处于无连接状态。
'********************************************************************
Application.CurrentProject.CloseConnection '关闭连接
Application.CurrentProject.OpenConnection '将连接设置为
'无
End Sub
Sub DeleteMDF(sSvrName As String, sUID As String, sPWD As String, sDatabase As String)
'********************************************************************
'此子例程将使用 SQLDMO
'从 MSDE 服务器删除当前连接的数据库
'
'注：有一种循环带有错误捕获，可避免删除一个
'连接
'
'引用：
' adodb
'********************************************************************
Dim osvr As SQLDMO.SQLServer
Dim i As Integer
On Error GoTo DeleteMDFTrap
Application.CurrentProject.CloseConnection
'关闭连接
Set osvr = CreateObject("SQLDMO.SQLServer") '创建 SQLDMO 对象
osvr.Connect sSvrName, sUID, sPWD '连接到 MSDE 服务器
osvr.Databases(sDatabase).Remove '删除数据库
DeleteMDFExit: '清除
osvr.Close
Set osvr = Nothing
Exit Sub
DeleteMDFTrap:
Select Case Err.Number
Case 6008 '避免关闭连接的问题
If i < 99 Then '继续循环以尝试关闭连接
DoEvents
Resume
Else '连接由于某种原因而无法关闭
'因此停止尝试并退出
MsgBox Err.Description
Resume DeleteMDFExit
End If
Case Else
MsgBox Err.Description
Resume DeleteMDFExit
End Select
Exit Sub
End Sub
|
|
|
