我目前正在使用小型的旧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'有效)。
感谢您的时间。