Coding4ever’s Blog

Just coding… coding… and coding… because coding should be fun :)

Implementasi Konsep Data Access Object (DAO) Di VB 6

| Comments

Maksud DAO disini bukan komponen Microsoft DAO yang populer di kalangan programmer vb untuk mengakses database tapi DAO disini lebih ke penerapan konsep DAO yang diperkenalkan Java untuk mengakses database.

Dalam konsep DAO kita akan memisahkan module program menjadi beberapa bagian/layer yaitu :

  1. Presentation

  2. Business Logic

  3. Data Access

Untuk presentation layer berhubungan dengan UI (user interface) .

Business Logic biasanya berhubungannya dengan entity class dan entity class sendiri merupakan representasi tabel-tabel yang ada di database biasanya juga disebut dengan istilah class model.

Terakhir Data Access yaitu bagian yang menangani urusan akses database biasanya terdapat operasi CRUD (Create, Read, Update, Delete).

Untuk kasusnya yang gampang aja :), kita akan mencoba mengakses data siswa yang mempunyai empat field yaitu nomor induk, nama, tempat lahir dan tanggal lahir.

Memulai project baru

Jalankan Visual Basih 6 kemudian pada dialog New Project aktifkan tab New kemudian pilih Standar EXE dan akhiri dengan menekan tombol Open.

Membuat Presentation Layer

Pada saat membuat project baru secara default sudah disiapkan 1 buah project  plus formnya

kemudian lakukan perubahan properties seperti gambar berikut :

untuk tampilannya kita akan desain seperti berikut :

Membuat Business Logic

Business Logic ada hubungannya dengan entity class yang merupakan representasi dari tabel-tabel yang ada didatabase.

Berdasarkan struktur tabel siswa diatas kita akan membuat sebuah class dengan nama Siswa yang mempunyai empat buah property yaitu Nomor Induk, Nama, Tempat Lahir dan Tanggal Lahir.

Jadi property ini sudah mewakili method mutator dan accessor yang sudah biasa kita kenal penggunakannya di Java.

Untuk menampung class-class yang berhubungan dengan Business Logic kita akan menambahkan project baru dengan tipe ActiveX DLL, adapun caranya seperti berikut :

Klik menu File -> Add Project setelah itu akan tampil dialog Add Project

kemudian pilih ActiveX DLL dan klik tombol Open

setelah itu akan ditambahkan 1 buah project dan class

kemudian lakukan perubahan properties seperti gambar berikut :

Adapun kode lengkap untuk class Siswanya adalah sebagai berikut :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private m_nomorInduk    As String
Private m_nama          As String
Private m_tempatLahir   As String
Private m_tanggalLahir  As Date

Public Property Let NomorInduk(ByVal vData As String)
    m_nomorInduk = vData
End Property
Public Property Get NomorInduk() As String
    NomorInduk = m_nomorInduk
End Property

Public Property Let Nama(ByVal vData As String)
    m_nama = vData
End Property
Public Property Get Nama() As String
    Nama = m_nama
End Property

Public Property Let TempatLahir(ByVal vData As String)
    m_tempatLahir = vData
End Property
Public Property Get TempatLahir() As String
    TempatLahir = m_tempatLahir
End Property

Public Property Let TanggalLahir(ByVal vData As Date)
    m_tanggalLahir = vData
End Property
Public Property Get TanggalLahir() As Date
    TanggalLahir = m_tanggalLahir
End Property

Membuat Data Access

Lapisan ini biasanya berisi operasi CRUD (Create, Read, Update, Delete), tapi kita akan menggunakan istilah yang sedikit berbeda untuk nama operasinya yaitu :

  1. Save

  2. Update

  3. Delete

  4. GetAll

  5. GetByName

  6. GetByNIS

Biasanya untuk penamaan classnya cukup menambahkan akhiran (suffixes) Dao untuk setiap class entitynya. Contoh untuk class entity Siswa, biasanya class Data Accessnya diberi nama SiswaDao.

Oke langsung saja kita tambahkan project baru dengan mengklik menu File -> Add Project setelah itu akan tampil dialog Add Project

kemudian pilih ActiveX DLL dan klik tombol Open

setelah itu akan ditambahkan 1 buah project dan class

kemudian lakukan perubahan properties seperti gambar berikut :

Adapun kode lengkap untuk class SiswaDaonya adalah seperti berikut :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private cmd     As ADODB.Command
Private strSql  As String

Private Function MappingRowToObject(ByVal rs As ADODB.Recordset) As SiswaModel.siswa
    Dim siswa As New SiswaModel.siswa

    With siswa
        .NomorInduk = IIf(IsNull(rs("nomor_induk").Value), "", rs("nomor_induk").Value)
        .nama = IIf(IsNull(rs("nama").Value), "", rs("nama").Value)
        .TempatLahir = IIf(IsNull(rs("tempat_lahir").Value), "", rs("tempat_lahir").Value)
        .TanggalLahir = IIf(IsNull(rs("tgl_lahir").Value), "1/1/1900", rs("tgl_lahir").Value)
    End With

    Set MappingRowToObject = siswa
End Function

1. Method Save

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Public Function Save(ByVal siswa As SiswaModel.siswa, ByVal conn As ADODB.Connection) As Integer
    On Error GoTo errHandle

    strSql = "INSERT INTO siswa (nomor_induk, nama, tempat_lahir, tgl_lahir) VALUES (?, ?, ?, ?)"

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandType = adCmdText
        .CommandText = strSql

        .Parameters(0) = siswa.NomorInduk
        .Parameters(1) = siswa.nama
        .Parameters(2) = siswa.TempatLahir
        .Parameters(3) = siswa.TanggalLahir

        .Execute Save
    End With
    Set cmd = Nothing

    Exit Function

errHandle:
    Save = 0
End Function

2. Method Update

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Public Function Update(ByVal siswa As SiswaModel.siswa, ByVal conn As ADODB.Connection) As Integer
    On Error GoTo errHandle

    strSql = "UPDATE siswa SET nama = ?, tempat_lahir = ?, tgl_lahir = ? WHERE nomor_induk = ?"

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandType = adCmdText
        .CommandText = strSql

        .Parameters(0) = siswa.nama
        .Parameters(1) = siswa.TempatLahir
        .Parameters(2) = siswa.TanggalLahir
        .Parameters(3) = siswa.NomorInduk

        .Execute Update
    End With
    Set cmd = Nothing

    Exit Function

errHandle:
    Update = 0
End Function

3. Method Delete

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Function Delete(ByVal nis As String, ByVal conn As ADODB.Connection) As Integer
    On Error GoTo errHandle

    strSql = "DELETE FROM siswa WHERE nomor_induk = ?"

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandType = adCmdText
        .CommandText = strSql

        .Parameters(0) = nis

        .Execute Delete
    End With
    Set cmd = Nothing

    Exit Function

errHandle:
    Delete = 0
End Function

4. Method GetAll

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Public Function GetAll(ByVal conn As ADODB.Connection) As Scripting.Dictionary
    Dim daftarSiswa     As New Scripting.Dictionary
    Dim rs              As ADODB.Recordset

    Dim key             As Long

    On Error GoTo errHandle

    strSql = "SELECT nomor_induk, nama, tempat_lahir, tgl_lahir " & 
             "FROM siswa " & 
             "ORDER BY nomor_induk"

    Set rs = OpenRecordset(strSql, conn)
    Do While Not rs.EOF

        Call daftarSiswa.Add(key, MappingRowToObject(rs))
        key = key + 1

        rs.MoveNext
    Loop
    Call CloseRecordset(rs)

    Set GetAll = daftarSiswa

    Exit Function
errHandle:
    Set GetAll = Nothing
End Function

5. Method GetByName

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Public Function GetByName(ByVal nama As String, ByVal conn As ADODB.Connection) As Scripting.Dictionary
    Dim daftarSiswa     As New Scripting.Dictionary
    Dim rs              As ADODB.Recordset

    Dim key             As Long

    On Error GoTo errHandle

    nama = Replace(nama, "'", "''")

    strSql = "SELECT nomor_induk, nama, tempat_lahir, tgl_lahir " & 
             "FROM siswa " & 
             "WHERE nama LIKE '%" & nama & "%' " & _
             "ORDER BY nomor_induk"

    Set rs = OpenRecordset(strSql, conn)
    Do While Not rs.EOF

        Call daftarSiswa.Add(key, MappingRowToObject(rs))
        key = key + 1

        rs.MoveNext
    Loop
    Call CloseRecordset(rs)

    Set GetByName = daftarSiswa

    Exit Function
errHandle:
    Set GetByName = Nothing
End Function

6. Method GetByNIS

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Function GetByNIS(ByVal nis As String, ByVal conn As ADODB.Connection) As SiswaModel.siswa
    Dim siswa   As SiswaModel.siswa
    Dim rs      As ADODB.Recordset

    On Error GoTo errHandle

    strSql = "SELECT nomor_induk, nama, tempat_lahir, tgl_lahir " & 
             "FROM siswa " & 
             "WHERE nomor_induk = '" & nis & "'"
    Set rs = OpenRecordset(strSql, conn)
    If Not rs.EOF Then
        Set siswa = MappingRowToObject(rs)
    End If
    Call CloseRecordset(rs)

    Set GetByNIS = siswa

    Exit Function

errHandle:
    Set GetByNIS = Nothing
End Function

Class SiswaDao diatas membutuhkan referensi/library tambahan berikut :

Karena class SiswaModel dan SiswaDao berbeda project sehingga untuk mengakses class Siswa berikut propertiesnya dari SiswaDao perlu ditambahkan referensi SiswaModel.

Referensi Microsoft Scripting Runtime mirip dengan class Collection.

Terakhir kita akan membahas bagaimana mengakses class Siswa dan SiswaDao dari form Siswa tapi sebelumnya kita harus menambahkan referensi SiswaModel, SiswaDataAccess, Microsoft ADO 2x dan Microsoft Scripting Runtime.

1. Menyimpan data

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub cmdSimpan_Click()
    Dim siswa As New SiswaModel.siswa

    With siswa
        .NomorInduk = txtNomorInduk.Text
        .nama = txtNama.Text
        .TempatLahir = txtTempatLahir.Text
        .TanggalLahir = dtpTanggal.Value
    End With

    result = siswaDao.Save(siswa, conn)
    If result > 0 Then
        MsgBox "Data siswa sudah disimpan"
        Call LoadDataSiswa

    Else
        MsgBox "Data siswa gagal disimpan"
    End If

    Set siswa = Nothing
End Sub

2. Mengupdate data

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub cmdPerbaiki_Click()
    Dim siswa As New SiswaModel.siswa

    With siswa
        .NomorInduk = txtNomorInduk.Text
        .nama = txtNama.Text
        .TempatLahir = txtTempatLahir.Text
        .TanggalLahir = dtpTanggal.Value
    End With

    result = siswaDao.Update(siswa, conn)
    If result > 0 Then
        MsgBox "Data siswa sudah disimpan"
        Call LoadDataSiswa

    Else
        MsgBox "Data siswa gagal disimpan"
    End If

    Set siswa = Nothing
End Sub

3. Menghapus data

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub cmdHapus_Click()
    Dim nis As String

    nis = lsvSiswa.ListItems(lsvSiswa.SelectedItem.Index).SubItems(1)

    If MsgBox("Apakah proses penghapusan ingin dilanjutkan ?", vbExclamation + vbYesNo, "Konfirmasi") = vbYes Then
        result = siswaDao.Delete(nis, conn)
        If result > 0 Then
            MsgBox "Data siswa sudah dihapus"
            Call LoadDataSiswa

            txtNomorInduk.Text = ""
            txtNama.Text = ""
            txtTempatLahir.Text = ""

            txtNomorInduk.SetFocus

        Else
            MsgBox "Data siswa gagal dihapus"
        End If
    End If
End Sub

4. Menampilkan semua data

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub FillToListView(ByVal siswa As SiswaModel.siswa)
    Dim row As Long

    With lsvSiswa
        row = .ListItems.Count + 1

        .ListItems.Add , , row
        .ListItems(row).SubItems(1) = siswa.NomorInduk
        .ListItems(row).SubItems(2) = siswa.nama
        .ListItems(row).SubItems(3) = siswa.TempatLahir

        If siswa.TanggalLahir <> "1/1/1900" Then
            .ListItems(row).SubItems(4) = Format(siswa.TanggalLahir, "dd/MM/yyyy")
        End If
    End With
End Sub

Private Sub LoadDataSiswa(Optional ByVal nama As String = "")
    Dim daftarSiswa As New Scripting.Dictionary
    Dim siswa       As SiswaModel.siswa

    Dim key         As Variant

    If Len(nama) > 0 Then
        Set daftarSiswa = siswaDao.GetByName(nama, conn)
    Else
        Set daftarSiswa = siswaDao.GetAll(conn)
    End If

    lsvSiswa.ListItems.Clear

    For Each key In daftarSiswa
        Set siswa = daftarSiswa.Item(key)

        Call FillToListView(siswa)
    Next

    Set siswa = Nothing
    Set daftarSiswa = Nothing
End Sub

kemudian tinggal panggil di event Form_Load

1
2
3
Private Sub Form_Load()
    Call LoadDataSiswa
End Sub

5. Menampilkan data berdasarkan nama

1
2
3
Private Sub cmdCariByName_Click()
    Call LoadDataSiswa(txtKeywordPencarian.Text)
End Sub

6. Menampilkan data berdasarkan nomor induk

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub cmdCariByNIS_Click()
    Dim siswa As SiswaModel.siswa

    Set siswa = siswaDao.GetByNIS(txtNomorInduk.Text, conn)
    If Not siswa Is Nothing Then
        With siswa
            txtNama.Text = .nama
            txtTempatLahir.Text = .TempatLahir

            If .TanggalLahir <> "1/1/1900" Then
                dtpTanggal.Value = siswa.TanggalLahir
            End If
        End With

    Else
        MsgBox "Data siswa tidak ditemukan"
    End If

    Set siswa = Nothing
End Sub

Selamat MENCOBA :)

Comments