VB6:调用时出错。打开adodb.Connection对象(适用于特定的上下文)

时间:2012-12-27 14:52:57

标签: vb6 odbc

我目前正在使用小型的旧VB6应用程序。

这是我的问题:当用户单击按钮时,程序正在打开与Oracle数据库的连接。从IDE运行或在Windows 95或Windows 98兼容模式下运行.exe时,这种方法很有效,否则会崩溃。 它确实在另一个工作站上工作,但我不知道为什么(不同的配置,但我不知道那可能是什么!)

以下是按下按钮时调用的代码(它在另一个没有设置兼容性设置但可能有其他配置差异的工作站上工作)。 大多数代码与连接无关,但为了完整起见,我已经让它不受影响。

Private Sub Form_Load()
'
'   Loads the list of printers (as defined in a table of the SQL DB)
'
    On Error GoTo error_handler

    '   icon
    Screen.MousePointer = vbHourglass


    'Dim conn As New adodb.Connection
    'Dim cmd As New adodb.Command
    'Dim rcs As New adodb.Recordset
    Dim conn As adodb.Connection
    Dim cmd As adodb.Command
    Dim rcs As adodb.Recordset

    Set conn = New adodb.Connection
    Set cmd = New adodb.Command
    Set rcs = New adodb.Recordset

    'Dim fs As New FileSystemObject
    Dim fs As FileSystemObject
    Set fs = New FileSystemObject
    Dim fic As File
    Dim texte As textStream
    Dim req As String


    Dim i As Integer
    Dim chem As Variant

    Dim buffer As String
    Dim retstring As String
    Dim rc As Long

    If fs.FileExists(Appli_Rep & "Queries\System\printers_list.txt") Then
        Set fic = fs.GetFile(Appli_Rep & "Queries\System\printers_list.txt")
        Set texte = fic.OpenAsTextStream(ForReading)
    End If


    '
    '   Reads connection string
    '
    buffer = String(145, " ")
    rc = GetPrivateProfileString("Requete", "DRIVER", "1", buffer, Len(buffer) - 1, Appli_Rep & "suivi__.ini")
    DoEvents
    retstring = Left(buffer, InStr(buffer, Chr(0)) - 1)

    '
    '   Gets the PATH environment variable
    '   So that we know where to find tnsname.ora
    '
    i = 0
    chem = Split(Environ("TNS_ADMIN"), ";")
    Do
        If Len(Dir(chem(i) & "\Tnsnames.ora")) <> 0 Then
            ChDrive chem(i)
            ChDir chem(i)
            Exit Do
        End If
        i = i + 1
        DoEvents
    Loop Until i > UBound(chem)


    ' Opens a connection (no DSN)

    'Set conn = New adodb.Connection
    conn.ConnectionString = "uid=_uid;pwd=_pwd;DRIVER=" & retstring & ";server=__PROD;"
    'conn.ConnectionTimeout = 30
    conn.ConnectionTimeout = 3000    ' (no change)

    conn.Open   ' -2147467259 [Microsoft][ODBC driver for Oracle][Oracle]ORA-06413: Connexion non ouverte
        ' Connexion non ouverte = french for "connection is closed".

    Set cmd.ActiveConnection = conn

    cmd.CommandText = texte.ReadAll

    DoEvents

    Set texte = Nothing
    Set fic = Nothing
    Set fs = Nothing

    Set rcs = cmd.Execute

    DoEvents

    rcs.MoveFirst

    Do
        Me.cbo_Imprimantes.AddItem (rcs.Fields("IMPRIMANTE").Value)
        rcs.MoveNext
        DoEvents
    Loop Until rcs.EOF

    '   Close connections / free objects
    Set rcs = Nothing
    Set cmd = Nothing
    If conn.State = 1 Then
        conn.Close
    End If
    Set conn = Nothing

    '   icon back to normal
    Screen.MousePointer = vbDefault

    Exit Sub

error_handler:

    '   retour normal
    Screen.MousePointer = vbDefault

    If Err.Number <> 0 Then
        MsgBox Err.Number & " " & Err.Description, vbCritical + vbOKOnly, "Erreur !!!"
        MsgBox Err.Source
    End If

    On Error Resume Next
    '   Fermeture des objets
    Set rcs = Nothing
    Set cmd = Nothing
    Set conn = Nothing
    Set texte = Nothing
    Set fic = Nothing
    Set fs = Nothing



End Sub

它在“conn.Open”语句中崩溃了。 连接字符串在两种情况下都是相同的(我已在消息框中显示它以确保'retstring'有效)。

感谢您的时间。

0 个答案:

没有答案