Office中国论坛/Access中国论坛

标题: [转帖]使用 Microsoft 数据引擎（MSDE）创建和部署 Access 解决方案 [打印本页]

作者: zhuyiwen 时间: 2004-7-15 18:10
标题: [转帖]使用 Microsoft 数据引擎（MSDE）创建和部署 Access 解决方案
转自中文MSDN网站

使用 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 服务器，以及将数据库附加到该服务器。本文将提供此类代码的示例。

简介

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 的引用。

(另外，可参见 http://access911.net/fixhtm/72FAB11E10DCEAF3.htm)

作者: zhuyiwen 时间: 2004-7-15 18:16
启动 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

复制代码

作者: zhuyiwen 时间: 2004-7-15 18:19
附加数据库

此函数执行将 MDF 数据文件附加到所选的服务器的任务。在此例中，我们使用了某些常量，您必须对它们进行相应更改，特别是数据库名“DemoDatabase”和 MDF 数据文件“adp1sql.mdf”。此外，该例还假设您使用 SQL 验证来附加到 MSDE 服务器（请参见模块 modFirstRunADP）：

Public Function sCopyMDF(sSvrName As String, _
sUID As String, _
sPWD As String, _
sMDFName As String) As String
'********************************************************************
'此函数将检查 DemoDatabase 是否存在于
'MSDE 服务器。如果数据库存在，此函数将
'从 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 Data 目录"
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

复制代码

作者: zhuyiwen 时间: 2004-7-15 18:27
创建连接

将数据库附加到服务器后，最后一步就是创建 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）。

作者: zhuyiwen 时间: 2004-7-15 18:28
进行整合

要创建可分发的 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 实例是计算机上唯一的实例，则此解决方案最为有效。如果有多个实例，并且您需要将数据库连接到特定实例，就必须提供额外代码，以便向用户请求实例名。遗憾的是，打包向导并不保存它所安装的实例名称。

作者: zhuyiwen 时间: 2004-7-15 18:33
启动窗体代码

提供此代码的目的是出于完整性的考虑，并演示如何将其它所有部分整合到一起。要使用此代码，请创建窗体，然后在其上放置一个按钮（名为 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

复制代码

作者: zhuyiwen 时间: 2004-7-15 18:41
模块 modGetSQLInstances

Option Compare Database
'此模块提供的函数共同执行
'查找现有的 SQL Server 和计算机名称的任务。
Private Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Private Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
Private Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, nSize As Long) As Long
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_MULTI_SZ = 7
'-----------------------------------------------------------
' SUB: GetValidSQLInstances
'
' 返回有效的 SQL 实例个数和表示实例列表的字符串
' （以空格分隔）。
'-----------------------------------------------------------
'
Public Function GetValidSQLInstances(ByRef sSQLInstances As String, ByRef fIsDefaultSQL7 As Boolean) As Integer
Dim hKey As Long
Dim sValue As String
'Dim sVerInfo As VERINFO
Dim i As Integer
fIsDefaultSQL7 = False
sSQLInstances = ""
GetValidSQLInstances = 0
If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Microsoft SQL Server", hKey) Then
RegQueryStringValue hKey, "InstalledInstances", sSQLInstances
RegCloseKey hKey
StrConv sSQLInstances, vbUpperCase
If InStr(1, sSQLInstances, "MSSQLSERVER") Then
If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion", hKey) Then
RegQueryStringValue hKey, "CurrentVersion", sValue
RegCloseKey hKey
'PackVerInfo sValue, sVerInfo
'If sVerInfo.FileVerPart1 = 7 Then
'fIsDefaultSQL7 = True
'End If
End If
End If
For i = 1 To Len(sSQLInstances)
If Mid$(sSQLInstances, i, 1) = " " Then
GetValidSQLInstances = GetValidSQLInstances + 1
End If
Next i
End If
End Function
'-----------------------------------------------------------
' 函数：RegOpenKey
'
' 打开系统注册表中现有的键。
'
' 返回：如果成功打开该键，则为 True，否则为 False
' 如果成功打开，将把 phkResult 设置为该键的句柄。
'-----------------------------------------------------------
'
Public Function RegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean
Dim lResult As Long
Dim strHkey As String
strHkey = strGetHKEYString(hKey)
lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)
If lResult = ERROR_SUCCESS Then
RegOpenKey = True
End If
End Function
'-----------------------------------------------------------
' 函数：RegCloseKey
'
' 关闭打开的注册表键。
'
' 返回：成功完成为 True，否则为 False。
'-----------------------------------------------------------
'
Public Function RegCloseKey(ByVal hKey As Long) As Boolean
Dim lResult As Long
lResult = OSRegCloseKey(hKey)
RegCloseKey = (lResult = ERROR_SUCCESS)
End Function
'-----------------------------------------------------------
'如果是 HKEY，将返回表示该键的
'文本字符串。
'-----------------------------------------------------------
Private Function strGetHKEYString(ByVal hKey As Long) As String
Dim s

复制代码

作者: zhuyiwen 时间: 2004-7-15 19:02
模块 modFirstRunADP

<DIV>

<FONT face=Verdana size=2>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 &amp

作者: zhuyiwen 时间: 2004-7-15 19:37
模块 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

作者: zhuyiwen 时间: 2004-7-15 19:37
<-- 全文完 -->

作者: xinbao 时间: 2004-7-15 23:29
非常好,难得如此详细的解说!!!

作者: chief_first 时间: 2005-6-4 05:15
good

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)