vb连接oracle
哪位高手能给出详细的程序 展开
打开数据库
Public Sub OpenOraDB()
On Error GoTo ToExit
OraDB_Open = False
Set OraDB = New ADODB.Connection
OraConstr = "Provider=OraOLEDB.Oracle.1;Password=" & strOraPWD & ";User ID=" & strOraUser & ";Data Source=" & OraDBNetName & ";Persist Security Info=False"
OraDB.CursorLocation = adUseServer
OraDB.Open OraConstr
OraDB_Open = True
Exit Sub
ToExit:
'MsgBox "连接数据库服务器错误,您可以在网络正常后继续使用。",vbInformation , "错误信息"
OraDB_Open = False
End Sub
关闭数据库
Public Sub CloseOraDB()
If OraDB_Open = True Then
If (OraDB.State = adStateOpen) Then
OraDB.Close
Set OraDB = Nothing
OraDB_Open = False
End If
End If
End Sub
打开数据集,写入数据
Set OraRS = New ADODB.Recordset
OraRS.ActiveConnection = OraDB
OraRS.CursorLocation = adUseServer
OraRS.LockType = adLockBatchOptimistic
strOraRS = "select * from " & OraDBtablename
OraRS.Open strOraRS, OraDB, adOpenStatic, adLockOptimistic
OraRS.AddNew
OraRS.Fields("PID") = strOraPID
OraRS.Fields("pname") = strName").Value
OraRS.Fields("psex") = strPsex
OraRS.Update
关闭数据集
OraRS.Close
Set OraRS = Nothing
Public appdisk As String
Public conn As New ADODB.Connection
Public Rs As New ADODB.Recordset
Public db As String
Private sSQL As String
Private Sub Command1_Click()
If Trim(Text1.Text) = "" Then
MsgBox "must input", vbCritical, "error"
Text1.SetFocus
Exit Sub
End If
If Trim(Text2.Text) = "" Then
MsgBox "must input", vbCritical, "error"
Text2.SetFocus
Exit Sub
End If
sSQL = "select * from USERID where id='" & Trim(Text1.Text) & "'"
Rs.Open sSQL, conn, adOpenKeyset, adLockPessimistic
If Rs.EOF = True Then
MsgBox "no this user", vbCritical, "error"
Text1.SetFocus
Rs.Close: Set Rs = Nothing
Exit Sub
End If
Rs.Close: Set Rs = Nothing
sSQL = "select * from USERID where id='" & Trim(Text1.Text) & "' and password='" & Trim(Text2.Text) & "'"
Rs.Open sSQL, conn, adOpenKeyset, adLockPessimistic
If Rs.EOF = True Then
MsgBox "password is wrong", vbCritical, "error"
Text2.SetFocus
Rs.Close: Set Rs = Nothing
Exit Sub
Else
If Val(Rs!Levels) = 0 Then
Form2.Show 1
Else
Form3.Show 1
End If
End If
Rs.Close: Set Rs = Nothing
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Form_Load()
Dim i As Integer
On Error GoTo Err
appdisk = Trim(App.Path)
If Right(appdisk, 1) <> "\" Then appdisk = appdisk & "\"
db = appdisk
db = "Provider=MSDAORA.1;Password=chun;User ID=chun;Data Source=chun;Persist Security Info=True"
conn.CursorLocation = adUseClient
conn.Open db
Exit Sub
Err:
MsgBox Err.Number
Unload Me
End Sub
'自己建立from吧 from1的代码就是这些 我得库名是CHUN 你给改成自己的就可以了 就下面这句话
db = "Provider=MSDAORA.1;Password=chun;User ID=chun;Data Source=chun;Persist Security Info=True"