Aplikasi ADO Sederhana


Sebagai dasar dalam mempelajari ADO library, perhatikan aplikasi ADO sederhana berikut. Aplikasi ini terdiri dari empat operasi utama ADO (mendapatkan, menguji, mengedit, dan memperbaharui data).

 fokus pada asas dasar ADO dan pengorganisasian kode, minimalisasi error

Aplikasi menggunakan contoh database Northwind yang disertakan dengan Microsoft® SQL Server 2000.

Untuk menjalankan HelloData

Buat sebuah Project Standard Executable Visual Basic yang baru dan masukan references ADO 2.6 library. Buat 4 buah tombol command dibagian atas form, set Name dan Caption properties seperti nilai dalam tabel berikut Setelah tombol tersebut, buat Microsoft DataGrid Control (Msdatgrd.ocx). Anda harus menambahkan “Microsoft DataGrid Control 6.0 (SP3) (OLEDB)” ke toolbox . Buat TextBox pada form setelah grid dan set properties seperti dalam tabel. Setelah selesai form akan terlihat seperti gambar berikut Finally, copy lsit code listed dalam “HelloData Code” dan paste ke window editor dari form . Tekan F5 untuk menjalankan kode.Catatan : Dalam contoh berikut, user id “MyId” dengan password “123aBc” digunakan untuk authenticate server. Anda harus menggantinya sesuai dengan nilai untuk server anda!.

hello-data.jpg

hello-data-detail.jpg

HelloData Code

‘BeginHelloDataOption Explicit Dim m_oRecordset1 As ADODB.RecordsetDim m_sConnStr As StringDim m_flgPriceUpdated As Boolean

Private Sub cmdEditData_Click()     

EditData

End Sub

Private Sub cmdExamineData_Click()      

ExamineData

End Sub

Private Sub cmdGetData_Click()

       GetData End Sub

Private Sub cmdUpdateData_Click()

     UpdateData

End Sub

Private Sub GetData()

Dim sSQL As String

Dim oConnection1 As ADODB.Connection

m_sConnStr = “Provider=SQLOLEDB;Data Source=MySrvr;” & _

             “Initial Catalog=Northwind;User d=MyId;Password=123aBc;”

On Error GoTo GetDataError

‘ Create and Open the Connection object.

Set oConnection1 = New ADODB.Connection

oConnection1.CursorLocation = adUseClient

oConnection1.Open m_sConnStr

sSQL = “SELECT ProductID, ProductName, CategoryID, UnitPrice ” & _

       “FROM Product”

‘ Create and Open the Recordset object.

Set m_oRecordset1 = New ADODB.Recordset

m_oRecordset1.Open sSQL, oConnection1, adOpenStatic, _

adLockBatchOptimistic, adCmdText

m_oRecordset1.MarshalOptions = adMarshalModifiedOnly

‘ Disconnect the Recordset.

Set m_oRecordset1.ActiveConnection = Nothing

oConnection1.Close

Set oConnection1 = Nothing

‘ Bind Recordset to the DataGrid for display.

Set grdDisplay1.DataSource = m_oRecordset1

Exit Sub

GetDataError:

If oConnection1 Is Nothing Then

HandleErrs “GetData”, m_oRecordset1.ActiveConnection

Else

HandleErrs “GetData”, oConnection1

End If

End Sub

Private Sub ExamineData()

Dim iNumRecords As Integer

Dim vBookmark As Variant

On Err GoTo ExamineDataErr

iNumRecords = m_oRecordset1.RecordCount

DisplayMsg “There are ” & CStr(iNumRecords) & _

” records in the current Recordset.”

‘ Loop through the Recordset and print the

‘ value of the AbsolutePosition property.

DisplayMsg “****** Start AbsolutePosition Loop ******”

Do While Not m_oRecordset1.EOF

‘ Store the bookmark for the 3rd record,

‘ for demo purposes.

If m_oRecordset1.AbsolutePosition = 3 Then _

vBookmark = m_oRecordset1.Bookmark

DisplayMsg m_oRecordset1.AbsolutePosition

m_oRecordset1.MoveNext

Loop

DisplayMsg “****** End AbsolutePosition Loop ******” & vbCrLf

‘ Use our bookmark to move back to 3rd record.

m_oRecordset1.Bookmark = vBookmark

MsgBox vbCr & “Moved back to position ” & _

m_oRecordset1.AbsolutePosition & ” using bookmark.”, , _

“Hello Data”

‘ Display meta-data about each field. See WalkFields() sub.

Call WalkFields

‘ Apply a filter on the type field.

MsgBox “Filtering on type field. (CategoryID=2)”, _

vbOKOnly, “Hello Data”

m_oRecordset1.Filter = “CategoryID=2”

Exit Sub

ExamineDataErr:

HandleErrs “ExamineData”, m_oRecordset1.ActiveConnection

End Sub

Private Sub EditData()

On Error GoTo EditDataErr

‘Recordset still filtered on CategoryID=2.

‘Increase price by 10% for filtered records.

MsgBox “Increasing unit price by 10%” & vbCr & _

“for all records with CategoryID = 2.”, , “Hello Data”

m_oRecordset1.MoveFirst

Dim cVal As Currency

Do While Not m_oRecordset1.EOF

cVal = m_oRecordset1.Fields(“UnitPrice”).Value

m_oRecordset1.Fields(“UnitPrice”).Value = (cVal * 1.1)

m_oRecordset1.MoveNext

Loop

Exit Sub

EditDataErr:

HandleErrs “EditData”, m_oRecordset1.ActiveConnection

End Sub

Private Sub UpdateData()

Dim oConnection2 As New ADODB.Connection

On Error GoTo UpdateDataErr

MsgBox “Removing Filter (adFilterNone).”, , “Hello Data”

m_oRecordset1.Filter = adFilterNone

Set grdDisplay1.DataSource = Nothing

Set grdDisplay1.DataSource = m_oRecordset1

MsgBox “Applying Filter (adFilterPendingRecords).”, , “Hello Data”

m_oRecordset1.Filter = adFilterPendingRecords

Set grdDisplay1.DataSource = Nothing

Set grdDisplay1.DataSource = m_oRecordset1

DisplayMsg “*** PRE-UpdateBatch values for ‘UnitPrice’ field. ***”

‘ Display Value, UnderlyingValue, and OriginalValue for

‘ type field in first record.

If m_oRecordset1.Supports(adMovePrevious) Then

m_oRecordset1.MoveFirst

DisplayMsg “OriginalValue = ” & _

m_oRecordset1.Fields(“UnitPrice”).OriginalValue

DisplayMsg “Value = ” & _

m_oRecordset1.Fields(“UnitPrice”).Value

End If

oConnection2.ConnectionString = m_sConnStr

oConnection2.Open

Set m_oRecordset1.ActiveConnection = oConnection2

m_oRecordset1.UpdateBatch

m_flgPriceUpdated = True

DisplayMsg “*** POST-UpdateBatch values for ‘UnitPrice’ field ***”

If m_oRecordset1.Supports(adMovePrevious) Then

m_oRecordset1.MoveFirst

DisplayMsg “OriginalValue = ” & _

m_oRecordset1.Fields(“UnitPrice”).OriginalValue

DisplayMsg “Value = ” & _

m_oRecordset1.Fields(“UnitPrice”).Value

End If

MsgBox “See value comparisons in txtDisplay.”, , _

“Hello Data”

Exit Sub

UpdateDataErr:

HandleErrs “UpdateData”, oConnection2

End Sub

Private Sub WalkFields()

Dim iFldCnt As Integer

Dim oFields As ADODB.Fields

Dim oField As ADODB.Field

Dim sMsg As String

Set oFields = m_oRecordset1.Fields

DisplayMsg “****** BEGIN FIELDS WALK ******”

For iFldCnt = 0 To (oFields.Count – 1)

Set oField = oFields(iFldCnt)

sMsg = “”

sMsg = sMsg & oField.Name

sMsg = sMsg & vbTab & “Type: ” & GetTypeAsString(oField.Type)

sMsg = sMsg & vbTab & “Defined Size: ” & oField.DefinedSize

sMsg = sMsg & vbTab & “Actual Size: ” & oField.ActualSize

grdDisplay1.SelStartCol = iFldCnt

grdDisplay1.SelEndCol = iFldCnt

DisplayMsg sMsg

MsgBox sMsg, , “Hello Data”

Next iFldCnt

DisplayMsg “****** END FIELDS WALK ******” & vbCrLf

Set oField = Nothing

Set oFields = Nothing

End Sub

Private Function GetTypeAsString(dtType As ADODB.DataTypeEnum) As String

‘ To save space, we are only checking for data types

‘ that we know are present.

Select Case dtType

Case adChar

GetTypeAsString = “adChar”

Case adVarChar

GetTypeAsString = “adVarChar”

Case adCurrency

GetTypeAsString = “adCurrency”

Case adInteger

GetTypeAsString = “adInteger”

End Select

End Function

Private Sub Form_Load()

grdDisplay1.AllowAddNew = False

grdDisplay1.AllowDelete = False

grdDisplay1.AllowUpdate = False

m_flgPriceUpdated = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim oConnection3 As New ADODB.Connection

Dim sSQL As String

Dim lAffected As Long

If Not m_oRecordset1 Is Nothing Then

Set m_oRecordset1 = Nothing

End If

‘ Undo the changes we’ve made to the database on the server.

If m_flgPriceUpdated Then

sSQL = “UPDATE Products SET UnitPrice=(UnitPrice/1.1) ” & _

“WHERE CategoryID=2”

oConnection3.Open m_sConnStr

oConnection3.Execute sSQL, lAffected, adCmdText

MsgBox “Restored prices for ” & CStr(lAffected) & _

” records affected.”, , “Hello Data”

End If

If oConnection3.State = adStateOpen Then

oConnection3.Close

Set oConnection3 = Nothing

End If

End Sub

Private Sub HandleErrs(sSource As String, ByRef oConnection1 As ADODB.Connection)

DisplayMsg “ADO (OLE) ERROR IN ” & sSource

DisplayMsg vbTab & “Error: ” & Err.Number

DisplayMsg vbTab & “Description: ” & Err.Description

DisplayMsg vbTab & “Source: ” & Err.Source

If Not oConnection1 Is Nothing Then

If oConnection1.Errors.Count <> 0 Then

DisplayMsg “PROVIDER ERROR”

Dim oError1 As ADODB.Error

For Each oError1 In oConnection1.Errors

DisplayMsg vbTab & “Error: ” & oError1.Number

DisplayMsg vbTab & “Description: ” & oError1.Description

DisplayMsg vbTab & “Source: ” & oError1.Source

DisplayMsg vbTab & “Native Error:” & oError1.NativeError

DisplayMsg vbTab & “SQL State: ” & oError1.SQLState

Next oError1

oConnection1.Errors.Clear

Set oError1 = Nothing

End If

End If

MsgBox “Error(s) occurred. See txtDisplay1 for specific information.”, , _

“Hello Data”

Err.Clear

End Sub

Private Sub DisplayMsg(sText As String)

txtDisplay1.Text = (txtDisplay1.Text & vbCrLf & sText)

End Sub

Private Sub Form_Resize()

grdDisplay1.Move 100, 700, Me.ScaleWidth – 200, (Me.ScaleHeight – 800) / 2

txtDisplay1.Move 100, grdDisplay1.Top + grdDisplay1.Height + 100, _

Me.ScaleWidth – 200, (Me.ScaleHeight – 1000) / 2

End Sub

‘EndHelloData

Iklan

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: