如何部署包括 Microsoft SQL Server 2000 桌面引擎的 Access 2002 项目

注意:这篇文章是由无人工介入的微软自动的机器翻译软件翻译完成。微软很高兴能同时提供给您由人工翻译的和由机器翻译的文章, 以使您能使用您的语言访问所有的知识库文章。然而由机器翻译的文章并不总是完美的。它可能存在词汇,语法或文法的问题,就像是一个外国人在说中文时总是可能犯这样的错误。虽然我们经常升级机器翻译软件以提高翻译质量,但是我们不保证机器翻译的正确度,也不对由于内容的误译或者客户对它的错误使用所引起的任何直接的, 或间接的可能的问题负责。

点击这里察看该文章的英文版: 299297
本文已归档。它按“原样”提供,并且不再更新。
本文只适用于 Microsoft Access 项目 (.adp)。

高级: 需要专家编码、 互操作性,和多用户技能。

为这篇文章的一个 Microsoft Office 2000 开发工具版本,请参阅 240293

本任务中

概要
Microsoft SQL Server 2000 桌面引擎 (MSDE 2000) 是 SQL Server 2000 兼容的数据存储服务器附带有权重新分发的 Microsoft Office XP 开发人员。Office XP 开发工具打包向导有一个选项,包括 SQL Server 2000 桌面引擎打包 Microsoft Access 项目 (*.adp) 的解决方案。一个用户的计算机上安装了该解决方案,SQL Server 2000 桌面引擎是与解决方案一起安装。但是,未启动 SQL Server 2000 桌面引擎,时并不将数据库附加到 SQL Server 2000 桌面引擎。

: Microsoft SQL Server 2000 桌面引擎的以前版本命名为 Microsoft 数据引擎 (MSDE)。

本文提供了您必须用来查找要启动服务器,如果它尚未启动已,将数据库附加到在的服务器,并将项目连接到新加载的数据库在服务器代码。该代码是特定于在项目中使用。但是,许多代码可用于通过任何 Visual Basic 应用程序 (VBA) 应用程序。

Microsoft 提供的编程示例只,用于说明不附带任何明示或暗示保证。这包括,但不限于对适销性或针对特定用途的适用性的暗示的担保。本文假定您熟悉演示了正在使用的编程语言以及用于创建和调试过程的工具。Microsoft 支持工程师可以帮助解释某个特定过程的功能,但他们不会修改这些示例以提供额外的功能或构建过程来满足您的具体要求。back to the top

步骤来修改现有的项目以进行部署的应用程序

以下步骤假定您已经有一个正常工作项目已准备就绪,可部署的应用程序。该步骤将指导您完成如何将附加代码添加到 VBA 项目、 如何进行所需的调整您启动窗体和如何创建部署包的一个现有的 Microsoft Access 项目 (*.adp),包括 Microsoft SQL Server 2000 桌面引擎。
  1. 打开您要部署,在 Access 项目,然后创建一个新的模块。

    因为该代码将包含使用 SQLDMO 代码和编写脚本,您必须确保在所需的参照都存在。
  2. 工具 菜单 Visual Basic 编辑器的上, 单击 引用
  3. 引用 对话框中单击如果尚未选中,请选择下列:
    • Microsoft SQLDMO 对象库
    • Microsoft 脚本运行时
  4. 单击 确定 以关闭 引用 对话框。
  5. 复制下面的代码以将新的模块:
    Option Compare DatabaseOption ExplicitDim adp_UseIntegratedSecurity As BooleanPublic Function fStartUp(strDBName As String, strMDFName As String, _        Optional strUN As String, Optional strPW As String)'------------------------------------------------------------'The code in this project connects the MDF file'to a local MSDE, then establishes the connection between'the Access Project and MSDE.'------------------------------------------------------------    Dim strSQLInstances As String    Dim strServername As String    Dim intInst As Integer    Dim strMachineName As String    Dim spaceLocation As Long    'If no username is supplied, and you cannot 'use integrated security, the function requires that you provide a valid SQL Server user account and password.        If Not fCheckForCompatibleOS Then        strMachineName = "(local)"            If strUN = "" Then               MsgBox "Provide a valid SQL Server user account and password to log on to SQL Server because the current operating system does not support integrated security."               Exit Function            End If           adp_UseIntegratedSecurity = False    Else        strMachineName = ComputerName        If strUN = "" Then            adp_UseIntegratedSecurity = True        Else            adp_UseIntegratedSecurity = False        End If    End If    'Find the available instances of SQL 2000 on the computer.    intInst = GetValidSQLInstances(strSQLInstances)    If intInst < 1 Then        Dim strErrorMsg As String        strErrorMsg = "This application requires SQL Server 2000 " & _            "to be installed on the local computer."        MsgBox strErrorMsg, vbCritical, "SQL Server 2000 not installed!"        Exit Function    End If    'At this point, it has been determined that there is at    'least one valid SQL Server 2000 instance on the computer.    'The code below picks the default or first instance if more than    'one is available. You may want to add code to prompt the user for    'a choice when there is more than one instance on the computer.        If InStr(1, strSQLInstances, "MSSQLSERVER") Then        strServername = strMachineName    Else        spaceLocation = InStr(1, strSQLInstances, " ")        If spaceLocation = 0 Then            strServername = strMachineName & "\" & strSQLInstances        Else            strServername = strMachineName & "\" & Mid(strSQLInstances, 1, spaceLocation)        End If    End If        'Call fstartMSDE to connect to SQL Server    fStartMSDE strServername, strUN, strPW        'Call sCopyMDF to move the data file to the data folder    'of SQL Server, and then attach it to the server.    fCopyMDF strServername, strUN, strPW, strDBName, strMDFName        'Connect the ADP to the new database    fChangeADPConnection strServername, strDBName, strUN, strPWEnd FunctionPublic Function fStartMSDE(strServername As String, _                Optional strUN As String, Optional strPW As String)'------------------------------------------------------------'This subroutine will turn on MSDE. If the server has been'started, the error trap will exit the function leaving the'server running.''Note that it will not put the SQL Service Manager on'the start bar.''Input:'   strServername    The server to be started'   strUN        The user used to start server'   strPW        The password of user''Output:'   Resolution of start''References:'   SQLDMO'------------------------------------------------------------    Dim osvr As SQLDMO.SQLServer    Set osvr = CreateObject("SQLDMO.SQLServer")            On Error GoTo StartError 'Error Trap    osvr.LoginTimeout = 60    osvr.LoginSecure = adp_UseIntegratedSecurity    osvr.Start True, strServername, strUN, strPWExitSub:    Set osvr = Nothing    Exit FunctionStartError:    If Err.Number = -2147023840 Then    'This error is thrown when the server is already running,    'and Server.Start is executed on Windows NT, 2000, or XP.               osvr.Connect strServername, strUN, strPW  'Connect to Server                Else 'Unknown Error        MsgBox Err.Number & ": " & Err.Description    End If    Resume ExitSubEnd FunctionPublic Function fCopyMDF(strServername As String, _                strUN As String, strPW As String, _                strDBName As String, _                sMDFName As String)'------------------------------------------------------------'This Function determines whether the database is already on'the MSDE Server. If the database does not exist, this'function copies the MDF file from the same location as the'ADP to MSDE's Data directory and then attaches the database.''Input:'   strServername 	The server to be started'   strUN        	The user used to start server'   strPW 		The password of user'   strDBName 		The Name of the SQL Database'   sMDFName 		The Name of the MSDE Database to be copied''Output:'   Resolution of copy''References:'   SQLDMO'   Scripting Runtime'------------------------------------------------------------Dim FSO As Scripting.FileSystemObjectDim osvr As SQLDMO.SQLServerDim strMessage As StringDim db As VariantDim fDataBaseFlag As BooleanDim dbCount As IntegerOn Error GoTo sCopyMDFTrap    'The drive names used in FSO.Copyfile and    'oSvr.AttachDBWithSingleFile must match the    'locations for Program Files and MSDE on the    'computer of the end user.    fCopyMDF = ""    fDataBaseFlag = False    Set FSO = CreateObject("Scripting.FileSystemObject")    Set osvr = CreateObject("SQLDMO.SQLServer")    osvr.LoginSecure = adp_UseIntegratedSecurity    osvr.Connect strServername, strUN, strPW    dbCount = osvr.Databases.Count        'Look for database existence on Local MSDE Server    'by looping through all database names on the local    'MSDE Server.    For Each db In osvr.Databases            If db.Name = strDBName Then 'The database exists            fDataBaseFlag = True            Exit For 'Get out of loop        End If      Next        If Not fDataBaseFlag Then 'There is no database                              'matching sDBName        'Copy File to data folder.        FSO.CopyFile Application.CurrentProject.Path _        & "\" & sMDFName, _        osvr.Databases("master").PrimaryFilePath & _        sMDFName, True        'Attach to database.        strMessage = osvr.AttachDBWithSingleFile(strDBName, _            osvr.Databases("master").PrimaryFilePath _            & sMDFName)    End If     ExitCopyMDF:    osvr.Disconnect    Set osvr = NothingExit Function    sCopyMDFTrap:    If Err.Number = -2147216399 Then 'DMO must be initialized        Resume Next    Else        MsgBox Err.Description    End If        Resume ExitCopyMDFExit Function    End FunctionFunction MakeADPConnectionless()'------------------------------------------------------------'This code removes the connection properties from the'Access Project for troubleshooting purposes.'The ADP will open in a disconnected state until new connection'properties are supplied.'------------------------------------------------------------    Application.CurrentProject.OpenConnection ""End Function Function fChangeADPConnection(strServername, strDBName As String, Optional strUN As String, _        Optional strPW As String) As Boolean'------------------------------------------------------------'This Function resets the connection for an ADP by using the'input parameters to create a new connection string. If no username'is supplied, it tries to connect by using integrated security.''Input:'   strServerName    The server to be started'   strDBName   The Name of the MSDE Database'   strUN        The user used to start server'   strPW        The password of user'------------------------------------------------------------    Dim strConnect As String    On Error GoTo EH:    strConnect = "Provider=SQLOLEDB.1" & _    ";Data Source=" & strServername & _    ";Initial Catalog=" & strDBName    If adp_UseIntegratedSecurity Then        strConnect = strConnect & ";integrated security=SSPI"    Else        strConnect = strConnect & ";user id=" & strUN        strConnect = strConnect & ";password=" & strPW    End If    Application.CurrentProject.OpenConnection strConnect    fChangeADPConnection = True    Exit FunctionEH:    MsgBox Err.Number & ": " & Err.Description, vbCritical, "Connection Error"    fChangeADPConnection = FalseEnd Function					
  6. 将本模块保存为 modCopyConnect
  7. 创建一个第二个模块,然后将下面的代码复制到第二个模块:
    Option Compare DatabaseOption Explicit'This module provides functions that work together to'find existing computers running SQL Servers, and also the computer name.      Public Type OSVERSIONINFO    dwOSVersionInfoSize As Long    dwMajorVersion As Long    dwMinorVersion As Long    dwBuildNumber As Long    dwPlatformId As Long    szCSDVersion As String * 128End TypeDeclare Function GetVersionExA Lib "kernel32" _         (lpVersionInformation As OSVERSIONINFO) As IntegerPrivate Declare Function OSRegOpenKey Lib "advapi32" Alias _"RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, _phkResult As Long) As LongPrivate 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 LongPrivate Declare Function GetComputerName _Lib "kernel32" Alias _"GetComputerNameA" (ByVal lpBuffer As String, _nSize As Long) As LongPrivate Declare Function OSRegCloseKey Lib "advapi32" _Alias "RegCloseKey" (ByVal hKey As Long) As LongPrivate Const MAX_COMPUTERNAME_LENGTH As Long = 15&Public Const HKEY_CLASSES_ROOT = &H80000000Public Const HKEY_CURRENT_USER = &H80000001Public Const HKEY_LOCAL_MACHINE = &H80000002Public Const HKEY_USERS = &H80000003Private Const ERROR_SUCCESS = 0&Private Const VER_PLATFORM_WIN32s = 0  'Win32s on Windows 3.1Private Const VER_PLATFORM_WIN32_WINDOWS = 1  'Windows 95/98/ME.Private Const VER_PLATFORM_WIN32_NT = 2  'Windows NT/2000/XPPrivate Const REG_SZ = 1Private Const REG_BINARY = 3Private Const REG_DWORD = 4Private Const REG_MULTI_SZ = 7Public Function GetValidSQLInstances(ByRef strSQLInstances _                As String) As Integer'-----------------------------------------------------------' This returns number of valid SQL instances and a space' delimited string that lists the instances.'-----------------------------------------------------------    Dim hKey As Long, i As Integer    Dim strVersionInfo As String    strSQLInstances = ""    GetValidSQLInstances = 0        If RegOpenKey(HKEY_LOCAL_MACHINE, _    "Software\Microsoft\Microsoft SQL Server", hKey) Then        RegQueryStringValue hKey, "InstalledInstances", strSQLInstances        RegCloseKey hKey        StrConv strSQLInstances, vbUpperCase        If InStr(1, strSQLInstances, "MSSQLSERVER") Then           If RegOpenKey(HKEY_LOCAL_MACHINE, _           "Software\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion", _           hKey) Then                RegQueryStringValue hKey, "CurrentVersion", strVersionInfo                RegCloseKey hKey                If Mid(strVersionInfo, 1, 1) <> 8 Then                    Replace strSQLInstances, "MSSQLSERVER", ""                End If            End If        End If        Trim strSQLInstances        If Len(strSQLInstances) > 0 Then            GetValidSQLInstances = GetValidSQLInstances + 1        Else            Exit Function        End If        For i = 1 To Len(strSQLInstances)            If Mid$(strSQLInstances, i, 1) = " " Then                GetValidSQLInstances = GetValidSQLInstances + 1            End If        Next i    End IfEnd FunctionPublic Function RegOpenKey(ByVal hKey As Long, _ByVal lpszSubKey As String, phkResult As Long) As Boolean'-----------------------------------------------------------' FUNCTION: RegOpenKey' Opens an existing key in the system registry.' Returns: True, if the key opened successfully. False' otherwise.' Upon success, phkResult is set to the handle of the key.'-----------------------------------------------------------    Dim lResult As Long    Dim strHkey As String    strHkey = strGetHKEYString(hKey)    lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)    If lResult = ERROR_SUCCESS Then        RegOpenKey = True    End IfEnd FunctionPublic Function RegCloseKey(ByVal hKey As Long) As Boolean    Dim lResult As Long'-----------------------------------------------------------' FUNCTION: RegCloseKey' Closes an open registry key.' Returns: True on success, else False.'-----------------------------------------------------------    lResult = OSRegCloseKey(hKey)    RegCloseKey = (lResult = ERROR_SUCCESS)End FunctionPrivate Function strGetHKEYString(ByVal hKey As Long) As String'-----------------------------------------------------------'Given an HKEY, return the text string representing that key.'-----------------------------------------------------------    Dim strKey As String    Dim intIdx As Integer    strKey = strGetPredefinedHKEYString(hKey)    If Len(strKey) > 0 Then        strGetHKEYString = strKey        Exit Function    End If End FunctionPrivate Function strGetPredefinedHKEYString(ByVal _hKey As Long) As String'-----------------------------------------------------------'Given a predefined HKEY, return the text string representing'that key, or else return vbNullString.'-----------------------------------------------------------    Select Case hKey        Case HKEY_CLASSES_ROOT            strGetPredefinedHKEYString = "HKEY_CLASSES_ROOT"        Case HKEY_CURRENT_USER            strGetPredefinedHKEYString = "HKEY_CURRENT_USER"        Case HKEY_LOCAL_MACHINE            strGetPredefinedHKEYString = "HKEY_LOCAL_MACHINE"        Case HKEY_USERS            strGetPredefinedHKEYString = "HKEY_USERS"    End SelectEnd FunctionPublic Function RegQueryStringValue(ByVal hKey As Long, _ByVal strValueName As String, strData As String) As Boolean'-----------------------------------------------------------' Retrieves the string data for a named' (strValueName = name) or unnamed (Len(strValueName) = 0)' value in a registry key. If the named value' exists, but its data is not a string, this function' fails.'' Returns: True on success, else False.'   On success, strData is set to the string data value.'-----------------------------------------------------------    Dim lResult As Long    Dim lValueType As Long    Dim strBuf As String    Dim lDataBufSize As Long    lResult = OSRegQueryValueEx(hKey, strValueName, 0&, _              lValueType, _        ByVal 0&, lDataBufSize)    If lResult = ERROR_SUCCESS Then        If lValueType = REG_SZ Then            strBuf = space$(lDataBufSize)            lResult = OSRegQueryValueEx(hKey, strValueName, 0&, _                 0&, ByVal strBuf, lDataBufSize)            If lResult = ERROR_SUCCESS Then                RegQueryStringValue = True                strData = StringFromBuffer(strBuf)            End If                ElseIf lValueType = REG_MULTI_SZ Then            strBuf = space$(lDataBufSize)            lResult = OSRegQueryValueEx(hKey, strValueName, 0&, _                      0&, _                ByVal strBuf, lDataBufSize)            If lResult = ERROR_SUCCESS Then                RegQueryStringValue = True                strData = ReplaceNullsWithSpaces(strBuf)            End If        End If    End IfEnd FunctionPublic Function StringFromBuffer(Buffer As String) As String    Dim nPos As Long    nPos = InStr(Buffer, vbNullChar)    If nPos > 0 Then        StringFromBuffer = Left$(Buffer, nPos - 1)    Else        StringFromBuffer = Buffer    End IfEnd FunctionPublic Function ReplaceNullsWithSpaces(str As String) As String'-----------------------------------------------------------' Replace all null characters with spaces.'-----------------------------------------------------------    Dim i As Integer    If Len(str) > 0 Then        For i = 1 To Len(str)            If Mid$(str, i, 1) = vbNullChar Then                Mid$(str, i, 1) = " "            End If        Next i        ReplaceNullsWithSpaces = Left$(str, Len(str) - 2)    Else        ReplaceNullsWithSpaces = str    End IfEnd FunctionPublic Function ComputerName() As String'-----------------------------------------------------------'  Returns the local computer name.'-----------------------------------------------------------    Dim nLen As Long    Dim strComputerName As String    nLen = MAX_COMPUTERNAME_LENGTH    strComputerName = String$(nLen, 0)    GetComputerName strComputerName, nLen    strComputerName = Left$(strComputerName, nLen)    ComputerName = strComputerNameEnd Function  Public Function fCheckForCompatibleOS() As Boolean'-----------------------------------------------------------'  Checks to see if the OS can use integrated security.'-----------------------------------------------------------    Dim osinfo As OSVERSIONINFO    Dim retvalue As Integer    osinfo.dwOSVersionInfoSize = 148    osinfo.szCSDVersion = space$(128)    retvalue = GetVersionExA(osinfo)    If osinfo.dwPlatformId >= VER_PLATFORM_WIN32_NT Then        fCheckForCompatibleOS = True    Else        fCheckForCompatibleOS = False    End IfEnd Function
  8. 将第二个模块保存为 GetSQLInstances
  9. 在设计视图中打开您现有的启动窗体或创建一个新的启动窗体,如果您不具有一个启动窗体。
  10. 将命令添加到您的启动窗体调用 fStartUp 的函数的 OnOpen 事件属性。

    您必须指定要在 SQL Server 上创建数据库名称和现有 SQL Server 数据文件的名称。 还可以指定所需的 SQL Server 登录名和密码作为可选的第三个和第四个参数如果您没有使用集成的安全性。 例如对于如果您想要创建的情况使用数据文件称为 NorthwindSQL.mdf 称为罗斯文数据库,函数如下显示:
    =fStartUp("Northwind","NorthwindSQL.mdf","","")
    说明 此注意涉及 SQL Server 安全。如果未提供登录名前面提到的函数调用中,本文中的代码会尝试使用集成的安全性,如果基础操作系统可以支持它 (Microsoft Windows NT 4.0、 Microsoft Windows 2000,和 Microsoft Windows XP)。如果基础操作系统是 Microsoft Windows 98 或 Microsoft Windows Millennium 版 (Me),您必须提供一个有效 SQL Server 用户帐户和密码。 不管操作系统的系统如果指定至少一个的登录名代码尝试使用提供的登录名和密码使用 SQL 安全连接。如果您不具有 SQL Server 数据文件的副本,您必须使您部署程序包中包含该数据文件的副本。
  11. 工具 菜单上指向 数据库实用工具,然后单击 复制数据库文件
  12. 在生成 打开 的对话框框指定名称和位置要保存数据库文件,单击 $ 保存 以完成此过程中,然后关闭该对话框。当项目首次在目标计算机上运行时,Access 在尝试连接到该文件的连接属性中指定的 SQL Server。尽管本文中的代码仍然运行,并仍然更新连接信息,它是在部署之前删除现有的连接信息是个好主意。

    若要去现有的连接信息,您可以运行 MakeADPConnectionless() 函数包括 modCopyConnect 模块中。

  13. 若要运行该函数,请到 即时窗口 中键入以下然后按 ENTER 键:
    ?MakeADPConnectionless
  14. 保存所做的更改。
  15. 外接程序 菜单上列出的打包向导转到步骤 19。
  16. 外接程序 菜单上单击 外接程序管理器
  17. 可用加载项 列表中单击 打包向导
  18. 对于加载行为单击 已加载/未加载,然后单击 确定
  19. 外接程序 菜单上单击 打包向导
  20. 按照向导中的步骤,直到到达 依赖项 屏幕。
  21. 依存 屏幕上单击 添加文件... 以将以前备份的 MDF 文件添加。
  22. 直到您到达 访问运行时属性 屏幕,请单击 下一步。在此屏幕上单击以选中包含 MSDE 引擎 Microsoft SQL Server 2000 桌面引擎 (MSDE) 复选框。
  23. 请按照向导以完成包,也可以单击 完成,当需要时。
包创建后,您就可以在最终用户的计算机上安装该程序包。

back to the top

参考
有关在其他计算机的包中包括 SQL 2000 桌面引擎的其他信息请单击下面的文章编号,以查看 Microsoft 知识库中相应的文章:
290623如何将现有的 SQL Server 2000 数据库附加到 SQL Server 2000 桌面引擎
322228嵌入到自定义应用程序 (白皮书) 的安装的 MSDE 2000 安装程序
274199不能在 Windows 95 安装 MSDE 2000
299351错误: SQL Server 2000 Service Pack 1 或 2 安装的系统上的 MSDE 安装失败
升迁有关的其他信息 SQL 2000 桌面引擎中,您的数据库,请单击下面的文章编号,以查看 Microsoft 知识库中相应的文章:
325023升迁到 SQL Server SQL Server 2000 桌面引擎
back to the top
offxpdev ACCXP ACC2002

属性

文章 ID:299297 - 上次审阅时间:10/23/2013 19:54:52 - 修订版本: 5.1

Microsoft Office XP Developer Edition, Microsoft Access 2002 标准版

  • kbnosurvey kbarchive kbmt kbhotfixserver kbqfe kbhowto kbadp kbfaq KB299297 KbMtzh
反馈