Vb6 如何从其他系统或服务器访问数据库？

使用vb6

如何从其他系统或服务器访问数据库

代码

我不想在代码中直接提供连接，我想从其他系统或同一系统或服务器中选择一个连接和*.mdb文件

在VB中，我必须使用什么类型的控件从其他系统或服务器进行连接测试和mdb文件选择

首先我要选择一个连接，如果连接已测试，那么我要从其他系统或服务器选择一个*.mdb文件。如何在VB 6中选择连接和*.mdb文件

---

请需要VB 6代码帮助

共享您的应用程序。域的路径。然后在另一个系统上，将其应用程序路径指向您的共享

如果要动态选择路径和/或文件，请使用FileOpen对话框/控件

至于代码示例，我已经有近5年没有使用真正的VB6了，所以我没有任何真正的示例，或者无论如何，我也没有制作一个。最接近我的是Excel VBA 6.5。以下是我在Excel中用于浏览和打开Access数据库的VBA函数示例：

Public Function OpenDB() As Boolean
'Open the Database and indicate if successful'
 If IsOpen Then
    OpenDB = True   'we are already open'
    Exit Function
 End If

 If sFile = "" Then sFile = GetSetting("YourAppName", "History", "DBName")

 With Application.FileDialog(msoFileDialogFilePicker)
    'specify the file open dialog'
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Access Workbooks", "*.mdb"
    .Filters.Add "All Files", "*.*"
    .InitialFileName = sFile
    .Title = "Open TIP Database"

    .Show

    If .SelectedItems.Count > 0 Then
        sFile = .SelectedItems(1)
    Else    'user canceled ...'
        OpenDB = False
        Exit Function
    End If
 End With

 DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile
 On Error Resume Next
    DB.Open
 If Err.Number <> 0 Then
    MsgBox "Error(" & Err.Number & "): " & Err.Description, vbOKOnly + vbCritical, "Error in OpenDB"
    OpenDB = False
    Exit Function
 End If

 'Opened ok, so finsh-up and exit'
 OpenDB = True
 SaveSetting "YourAppName", "History", "DBName", sFile
End Function

公共函数OpenDB（）作为布尔值 '打开数据库并指示是否成功' 如果是伊索本那么 OpenDB=True“我们已经打开了” 退出功能 如果结束 如果sFile=”“，则sFile=GetSetting（“YourAppName”、“History”、“DBName”） 使用Application.FileDialog（msoFileDialogFilePicker） '指定文件打开对话框' .AllowMultiSelect=False .过滤器 .Filters.Add“Access工作簿”，“*.mdb” .Filters.Add“所有文件”，“***” .InitialFileName=sFile .Title=“打开提示数据库” 显示 如果.SelectedItems.Count>0，则 sFile=.SelectedItems（1） 否则“用户已取消…” OpenDB=False 退出功能 如果结束 以 DB.ConnectionString=“Provider=Microsoft.Jet.OLEDB.4.0；数据源=”&sFile 出错时继续下一步 DB.Open 如果错误号为0，则 MsgBox“Error（&Err.Number&）”：&Err.Description，vbOKOnly+vbCritical，“OpenDB中的错误” OpenDB=False 退出功能 如果结束 '打开了，好的，所以找到并退出' OpenDB=True 保存设置“YourAppName”、“History”、“DBName”、sFile 端函数 您必须将“Application.FileDialog”替换为对VB Forms FileDialog控件/组件的引用，您应该将该控件/组件从工具箱中放到您的VB中（它实际上是一个组件控件，因此实际上不可见）

您应该期望它会有一些不同，因为这些都是GUI特性，而VB表单GUI与Excel GUI完全不同。因此，属性和设置可能会有所不同，您必须使用它们或在VB帮助中查找它们

---

注意：GetSetting和SaveSetting只是保存注册表中使用的最后一个文件名和路径，以便下次可以将其用作默认位置。

RBarry指的是您可以在一台计算机上“共享”特定文件夹，以便另一台计算机可以访问该文件夹

如果两台计算机分别命名为computer1和computer2，则computer2可以在其C:驱动器上共享一个文件夹，并将其命名为“sharedfolder”。然后computer1可以使用路径“\\computer2\sharedfolder”访问该文件夹

---

如果computer1上的应用程序无法使用该路径，则可以将驱动器号（如F:）映射到路径“\\computer2\sharedfolder”。然后它看起来就像computer1上的F:drive。

您可以使用“数据链接属性”对话框定义OLE DB连接字符串。您可以先预定义提供程序和其他属性，然后让用户浏览MDB文件并选择它（如果预定义了Jet 4.0作为提供程序）

完成此选择后，您可以将连接作为.UDL（通用数据链接）文件进行持久化。UDL是很久很久以前取代DSN的东西。我很惊讶它们没什么用处

---

下面是一些示例代码，让您的程序为用户指定UDL和默认路径以浏览MDB文件。如果UDL不存在，它将打开“数据链路属性”对话框，以便用户可以选择MDB，并允许他们在冲入或取消设置之前从该对话框中测试连接。一旦完全定义了连接，它就会将其作为.UDL文件持久化，并打开连接对象

如果UDL文件存在，它将使用UDL中的规范打开连接

这里的关键是

DbOpenPromptSave（）

函数

'Requries references to:
'   Microsoft ActiveX Data Objects x Library (x >= 2.5)
'   Microsoft OLE DB Service Component 1.0 Type Library

Private Function DbOpenPromptSave( _
    ByVal Conn As ADODB.Connection, _
    ByVal UDLPath As String, _
    Optional ByVal MDBSearchStartPath As String = "") As Boolean
    'Returns True if user cancels the dialog.

    On Error Resume Next
    GetAttr UDLPath
    If Err.Number Then
        'No UDL, we need to prompt the user then create one.
        On Error GoTo 0
        Dim dlkUDL As MSDASC.DataLinks

        Set dlkUDL = New MSDASC.DataLinks
        Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                              & "Persist Security Info=False;" _
                              & "Jet OLEDB:Engine Type=5;" _
                              & "Data Source=" & MDBSearchStartPath & "\;" _
                              & "Window Handle=" & CStr(Me.hWnd)
        If Not dlkUDL.PromptEdit(Conn) Then
            DbOpenPromptSave = True
            Exit Function
        End If

        'Use a Stream as Unicode writer.  Using a relative path to save
        'respects the Current Directory of the process.
        Dim stmUDL As ADODB.Stream
        Set stmUDL = New ADODB.Stream
        With stmUDL
            .Open
            .Type = adTypeText
            .Charset = "unicode"
            .WriteText "[oledb]", adWriteLine
            .WriteText "; Everything after this line is an OLE DB initstring", _
                       adWriteLine
            .WriteText Conn.ConnectionString
            .SaveToFile UDLPath, adSaveCreateOverWrite
            .Close
        End With
        Conn.Open
    Else
        Conn.Open "File Name=" & UDLPath
    End If
End Function

Private Function DbActions() As Boolean
    'Returns True on cancel.
    Dim connDB As ADODB.Connection

    Set connDB = New ADODB.Connection
    If DbOpenPromptSave(connDB, "sample.udl", App.Path) Then
        MsgBox "User canceled!"
        DbActions = True
        Exit Function
    End If
    DoDbOperations connDB 'Whatever you need to do until closing.
    connDB.Close
End Function

DbActions（）

函数只是调用

DbOpenPromptSave（）

打开数据库的一个示例。此函数打开数据库，调用

DoDbOperations（）

（未显示）以实际使用打开的数据库，然后关闭数据库连接

此示例为

sample.udl

使用相对路径（当前目录，通常与App.path相同），并将

MDBSearchStartPath

（选择访问数据库对话框打开的位置）设置为App.path（因为此对话框默认为上次打开CommonDialog的位置）

换句话说

它在CD（通常为App.Path）中查找/保存UDL

sample.UDL

，并在App.Path中打开MDB选择对话框。呼

我想在这种情况下传递

CurDir$（）

可能会更清楚

---

我希望这接近你的要求，有点模糊

---

用户打开的MDB选择子对话框几乎是一个标准的CommonDialog.ShowOpen对话框。用户应该能够在任何驱动器上浏览MDB文件，包括远程系统上的文件共享。

@RBarryYoung。请阅读我的问题，很明显我提到我想打开一个文件目录，我想从其他系统中选择一个数据库文件。我应该补充的是，UDL通常很容易维护。你可以简单地双击它们

'Requries references to:
'   Microsoft ActiveX Data Objects x Library (x >= 2.5)
'   Microsoft OLE DB Service Component 1.0 Type Library

Private Function DbOpenPromptSave( _
    ByVal Conn As ADODB.Connection, _
    ByVal UDLPath As String, _
    Optional ByVal MDBSearchStartPath As String = "") As Boolean
    'Returns True if user cancels the dialog.

    On Error Resume Next
    GetAttr UDLPath
    If Err.Number Then
        'No UDL, we need to prompt the user then create one.
        On Error GoTo 0
        Dim dlkUDL As MSDASC.DataLinks

        Set dlkUDL = New MSDASC.DataLinks
        Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                              & "Persist Security Info=False;" _
                              & "Jet OLEDB:Engine Type=5;" _
                              & "Data Source=" & MDBSearchStartPath & "\;" _
                              & "Window Handle=" & CStr(Me.hWnd)
        If Not dlkUDL.PromptEdit(Conn) Then
            DbOpenPromptSave = True
            Exit Function
        End If

        'Use a Stream as Unicode writer.  Using a relative path to save
        'respects the Current Directory of the process.
        Dim stmUDL As ADODB.Stream
        Set stmUDL = New ADODB.Stream
        With stmUDL
            .Open
            .Type = adTypeText
            .Charset = "unicode"
            .WriteText "[oledb]", adWriteLine
            .WriteText "; Everything after this line is an OLE DB initstring", _
                       adWriteLine
            .WriteText Conn.ConnectionString
            .SaveToFile UDLPath, adSaveCreateOverWrite
            .Close
        End With
        Conn.Open
    Else
        Conn.Open "File Name=" & UDLPath
    End If
End Function

Private Function DbActions() As Boolean
    'Returns True on cancel.
    Dim connDB As ADODB.Connection

    Set connDB = New ADODB.Connection
    If DbOpenPromptSave(connDB, "sample.udl", App.Path) Then
        MsgBox "User canceled!"
        DbActions = True
        Exit Function
    End If
    DoDbOperations connDB 'Whatever you need to do until closing.
    connDB.Close
End Function