19 Temmuz 2008, 16:52
#1 Çevrimdışı
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
ADO İle Veritabanı
ALINTIDIR
PHP Kod: Kodu kopyalamak için üzerine çift tıklayın!
Dim WithEvents Con As ADODB . Connection Dim WithEvents rst As ADODB . Recordset Dim cmd As ADODB . Command Private Sub cmdaddnew_Click () chec : On Error GoTo errh Set rst = New ADODB . Recordset 'specifying attributes to this recordset With rst .ActiveConnection = Con .CursorLocation = adUseClient .CursorType = adOpenDynamic .LockType = adLockOptimistic .Open "tab1" ' opening tab1 table End With 'adding records from textbox to recordset With rst .AddNew .Fields!id = StrConv(Txtid, vbProperCase) .Fields!Name = StrConv(Txtname, vbProperCase) .Fields!age = StrConv(Txtage, vbProperCase) .Fields!*** = StrConv(Txt***, vbProperCase) .Update End With ' clearing the text boxes Txtname = "" Txtid = "" Txtage = "" Txt*** = "" ' closing the recordset rst.Close Set rst = Nothing Call dload ' calling private procedure to fill the flexgrid errh : 'in case of error, informing the user If Err.Description <> vbNullString Then MsgBox Err.Description End If End Sub Private Sub cmddelete_Click() Set cmd = New ADODB.Command ' using command object to execute sql commands With cmd . ActiveConnection = Con . CommandType = adCmdText . CommandText = "delete from tab1 where id = '" & Txtid & "'" . Execute End With Set cmd = Nothing ' clearing all the text boxes Txtname = "" Txtid = "" Txtage = "" Txt*** = "" Call dload ' calling procedure to fill flexgrid End Sub Private Sub cmdupdate_Click () On Error GoTo errhan Set rst = New ADODB . Recordset With rst . CursorLocation = adUseClient . ActiveConnection = Con . CursorType = adOpenDynamic . LockType = adLockPessimistic . Open "select * from tab1 where id='" & Txtid . Text & "'" 'opening the recordset .Fields!Name = StrConv(Txtname, vbProperCase) .Fields!*** = StrConv(Txt***, vbProperCase) .Fields!age = StrConv(Txtage, vbProperCase) .Update ' updating the recordset End With Set rst = Nothing Call dload Txtname = "" Txtid = "" Txtage = "" Txt*** = "" errhan : If Err . Description <> vbNullString Then MsgBox Err . Description End If End Sub Public Sub connect () Set Con = New ADODB . Connection Con . CursorLocation = adUseClient ' use this code to connect to the database using universal data link ' Con . Open "File Name=" & App . Path & "\test.udl" Con . Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App . Path & "\test.mdb" If Con . Provider = "SQLOLEDB.1" Then DataEnvironment1 . Connections ( 2 ). Open Con Else DataEnvironment1 . Connections ( 1 ). Open Con End If Call dload End Sub Private Sub dload () MSFlexGrid1 . Rows = 1 Set rst = New ADODB . Recordset rst . ActiveConnection = Con rst . CursorLocation = adUseClient rst . CursorType = adOpenDynamic rst . LockType = adLockOptimistic rst . Source = "tab1" rst . Open While Not rst . EOF () ' checking end of file MSFlexGrid1.AddItem rst!id & Chr(9) & rst!Name & Chr(9) & rst!age & Chr(9) & rst!*** ' adding records to flexgrid rst . MoveNext Wend Set rst = Nothing End Sub Private Sub Command1_Click () With DataEnvironment1 If Con . Provider = "SQLOLEDB.1" Then . Commands ( 2 ). CommandType = adCmdText . Commands ( 2 ). CommandText = "SELECT * FROM tab1 where id = '" & Txtid . Text & "'" . Commands ( 2 ). Execute DataReport2 . Show If . rsCommand2 . State = 1 Then . rsCommand2 . Close End If Else . Commands ( 1 ). CommandType = adCmdText . Commands ( 1 ). CommandText = "SELECT * FROM tab1 where id = '" & Txtid . Text & "'" . Commands ( 1 ). Execute DataReport1 . Show If . rsCommand1 . State = 1 Then . rsCommand1 . Close End If End If End With End Sub Private Sub Form_Load () Call connect End Sub Private Sub Form_Unload ( Cancel As Integer ) Con . Close Set Con = Nothing End Sub Private Sub MSFlexGrid1_Click () With MSFlexGrid1 ' populating the text boxes when user clicks the flexgrid .Col = 0 Txtid.Text = .Text .Col = 1 Txtname.Text = .Text .Col = 2 Txtage.Text = .Text .Col = 3 Txt***.Text = .Text End With End Sub