Membuat CRUD Master Barang dengan Database Access

Membuat CRUD Master Barang dengan Database Access

8:56 PM
Membuat CRUD Master Barang dengan Database ACCESS

Kali ini saya akan berbagi program aplikasi CRUD Master Barang dengan database Access, dengan menggunakan VB6. Pada pembahasan ini saya tidak secara detail membahas tentang masing-masing perintah yang digunakan, karena pada pembahasan-pembahasan sebelumnya telah dijelaskan secara lengkap disini.

Dalam program tersebut saya menggunakan Refference Microsoft ADO (ActiveX Data Object) untuk sistem koneksinya, dan menggunakan beberapa komponen standar seperti TextBox, CommandButton dan lain-lain.

Langkah-Langkah Pemrograman

Pertamakali yang harus disiapkan dalam program tersebut adalah membuat class yang berfungsi untuk koneksi databases Access, yang dibagi menjadi beberapa class yaitu:

  • ConnectionSetting

    Berfungsi untuk membuat object yang menyimpan data Database (file database Access), UserID, dan Password, serta beberapa property lain seperti ConnectionTimeOut dan CursorLocation.

  • ServerConnection

    Berfungsi untuk membuat object yang berfungsi melakukan proses koneksi database dari setting yang ditentukan.

  • frmConnectionSetting

    Dan satu Form yang berfungsi sebagai Form Dialog dalam melakukan setting untuk menentukan file database, UserID, dan Password yang digunakan dalam program.

Langkah selanjutnya ada membuat form dialog untuk CRUD Master Barang, yang saya beri nama form frmCRUD

ConnectionSetting

Pada Class ini hanya berisikan program untuk menentukan object yang digunakan dalam menyimpan dan mengambil data tentang nama file database Access, UserID, dan Password, yang mana data tersebut akan disimpan dalam Registry Windows, seperti kode program berikut ini: 

Option Explicit

'---------------------------------------------------------------
'Class Seting Koneksi Database Access
'Copyright (C) Logics Software, 2000-2019
'Allrights Reserved
'---------------------------------------------------------------
'Development Environment    : Visual Basic 6.0
'Database                   : Microsoft SQL Server 7.0
'Date Written               : 02 Februari 2005
'Author                     : Nurdin Budi Mustofa
'---------------------------------------------------------------

Public Enum TCursorLocation
    TCL_None = 1
    TCL_Server = 2
    TCL_Client = 3
End Enum

'-----------------------------------------------------------------------------------------------------------
'Property User ID
'-----------------------------------------------------------------------------------------------------------
Public Property Let UserID(UID As String)
       SaveSetting "Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "UserID", UID
End Property

Public Property Get UserID() As String
       If Trim(GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "UserID")) <> "" Then
          UserID = GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "UserID")
       Else
          UserID = "Admin"
       End If
End Property
'-----------------------------------------------------------------------------------------------------------


'-----------------------------------------------------------------------------------------------------------
'Property User ID
'-----------------------------------------------------------------------------------------------------------
Public Property Let Password(PWD As String)
       SaveSetting "Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "Password", PWD
End Property

Public Property Get Password() As String
       Password = GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "Password")
End Property
'-----------------------------------------------------------------------------------------------------------


'-----------------------------------------------------------------------------------------------------------
'Property Database
'-----------------------------------------------------------------------------------------------------------
Public Property Let Database(DbName As String)
       SaveSetting "Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "Database", DbName
End Property

Public Property Get Database() As String
       If Trim(GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "Database")) = "" Then
          Database = ModuleID
       Else
          Database = GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "Database")
       End If
End Property
'-----------------------------------------------------------------------------------------------------------


'-----------------------------------------------------------------------------------------------------------
'Property Timeout
'-----------------------------------------------------------------------------------------------------------
Public Property Let ConnectionTimeOut(TimeOut As Integer)
       SaveSetting "Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "ConnectionTimeOut", Trim(Str(TimeOut))
End Property

Public Property Get ConnectionTimeOut() As Integer
       ConnectionTimeOut = Val(GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "ConnectionTimeOut"))
End Property
'-----------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------
'Property CursorLocation
'-----------------------------------------------------------------------------------------------------------
Public Property Let CursorLocation(Cursor As TCursorLocation)
       SaveSetting "Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "CursorLocation", Trim(Str(Cursor))
End Property

Public Property Get CursorLocation() As TCursorLocation
       If Val(GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "CursorLocation")) = 0 Then
          CursorLocation = 2
       Else
          CursorLocation = Val(GetSetting("Kodiing", "Software\LogicsSoftware\" + ModuleID + "\ConnectionSetting", "CursorLocation"))
       End If
End Property
'-----------------------------------------------------------------------------------------------------------

Public Sub ShowSetting(ConnectionModuleID As String)
    frmConnectionSetting.Show vbModal
End Sub

ConnectionSetting

Pada Class berisikan kode program yang berfungsi untuk melakukan koneksi database Acess, yang bisa anda lihat seperti berikut ini: 

Option Explicit

'---------------------------------------------------------------
'Class Koneksi Database
'Copyright (C) Logics Software, 2000-2009
'Allrights Reserved
'---------------------------------------------------------------
'Development Environment    : Visual Basic 6.0
'Database                   : Microsoft Access
'Date Written               : 06 Desember 20009
'Author                     : Nurdin Budi Mustofa
'---------------------------------------------------------------

Private oConnect As ADODB.Connection

'----------------------------------------------------------
'Constructor
'----------------------------------------------------------
Private Sub Class_Initialize()
    Set oConnect = CreateObject("ADODB.Connection")
End Sub

'----------------------------------------------------------
'Destructor
'----------------------------------------------------------
Private Sub Class_Terminate()
    Set oConnect = Nothing
End Sub

'----------------------------------------------------------
'Connect To Database Server
'----------------------------------------------------------
Public Function ConnectToServer(ConnectionModuleID As String) As Boolean
    Dim oSetting As New ConnectionSetting
    Dim StrConnect As String
    Dim DSN As Boolean
    
    On Error GoTo ProcessError
    
    ConnectToServer = True
    
    'Connect to Database Access
    StrConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + oSetting.Database + ";Persist Security Info=False"
    oConnect.CommandTimeout = oSetting.ConnectionTimeOut
    oConnect.CursorLocation = oSetting.CursorLocation
    oConnect.Open StrConnect, oSetting.UserID, oSetting.Password
        
    Set oSetting = Nothing
    
    Exit Function
    
ProcessError:
    ConnectToServer = False
    
End Function

'----------------------------------------------------------
'Disconnect From Database Server
'----------------------------------------------------------
Public Function DisconnectFromServer() As Boolean
    On Error GoTo ProcessError
    
    DisconnectFromServer = True
    oConnect.Close
    Exit Function
    
ProcessError:
    DisconnectFromServer = False
    
End Function

'----------------------------------------------------------
'Get Connection Reference
'----------------------------------------------------------
Public Function Server() As Object
    Set Server = oConnect
End Function

'----------------------------------------------------------
'Transaction
'----------------------------------------------------------
Public Sub BeginTransaction()
    oConnect.BeginTrans
End Sub

Public Sub CommitTransaction()
    oConnect.CommitTrans
End Sub

Public Sub RollBackTransaction()
    oConnect.RollbackTrans
End Sub

Koneksi Database dari Form

Kemudian dari form CRUD kita tambahkan kode program untuk koneksi database dan melakukan tutup database (close) pada saat keluar dari program Form CRUD, seperti kode program berikut ini: 

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Fungsi Buka Koneksi Database
Private Function BukaKoneksiDatabase() As Boolean
    Dim oSetting As New ConnectionSetting

TryConnectToServer:
    BukaKoneksiDatabase = oConnection.ConnectToServer(ModuleID)
    If Not BukaKoneksiDatabase Then
        If MsgBox("Koneksi Ke Database Server [" + ModuleID + "] Gagal ! , Cek Setting Koneksi Database ? ", vbQuestion + vbYesNo, "Peringatan") = vbYes Then
            oSetting.ShowSetting ModuleID
            GoTo TryConnectToServer
        End If
    End If

    Set oSetting = Nothing
End Function

'Prosedur Tutup Koneksi Database
Private Sub TutupKoneksiDatabase()
    oConnection.DisconnectFromServer
    Set oConnection = Nothing
End Sub

'Lakukan Koneksi Database Dan Reset Data
Private Sub Form_Load()
    Center Me
    lConnect = BukaKoneksiDatabase
    If lConnect Then
        ResetData
    End If
End Sub

'Cek Koneksi Database
Private Sub Form_Activate()
    If Not lConnect Then
        Unload Me
    Else
        Me.Refresh
    End If
End Sub

'Unload Form (Tutup Koneksi Database)
Private Sub Form_Unload(Cancel As Integer)
    If MsgBox("Keluar Dari Program Tersebut ?", vbQuestion + vbYesNo, "Konfirmasi") = vbNo Then
       Cancel = 1
    Else
       TutupKoneksiDatabase
    End If
End Sub

Class Data Service

Dalam perintah untuk melakukan pengolahan data (Tambah, Hapus, Baca Data), saya menggunakan 2 class, yang masing-masing berfunsgi: FieldsMasterBarang untuk menyimpan variable object dari fields master barang dan MasterBarang yang berisikan fungsi-sungsi untuk menyimpan data, menghapus, mencari dan membaca data master barang, yang bisa perhatikan seperti kode program berikut ini: 

Option Explicit

Public KodeBarang As String
Public NamaBarang As String
Public Satuan As String
Public HPP As Currency
Public HargaJual As Currency
Public StokBarang As Long

Public Inisial As String



Option Explicit

Public KodeBarang As String
Public NamaBarang As String
Public Satuan As String
Public HPP As Currency
Public HargaJual As Currency
Public StokBarang As Long

Public Inisial As String




Option Explicit

Public Fields As New FieldsMasterBarang
Public RecordCount As Long

'-------------------------------------------------------------
'Add Record
'-------------------------------------------------------------
Public Function Add(oConnection As Object) As Boolean
    Dim oCmd As New ADODB.Command
    Dim SQL As String

    SQL = "INSERT INTO MASTERBARANG " + _
          "(KodeBarang,NamaBarang,Satuan,HPP,HargaJual,StokBarang) " + _
          "VALUES " + _
          "(?, ?, ?, ?, ?, ?) "
    
    Add = True
    On Error GoTo ProcessError
    
    oCmd.ActiveConnection = oConnection
    oCmd.CommandType = adCmdText
    oCmd.CommandText = SQL
    oCmd.Parameters(0) = Fields.KodeBarang
    oCmd.Parameters(1) = Fields.NamaBarang
    oCmd.Parameters(2) = Fields.Satuan
    oCmd.Parameters(3) = Fields.HPP
    oCmd.Parameters(4) = Fields.HargaJual
    oCmd.Parameters(5) = Fields.StokBarang
    oCmd.Execute
    
    Exit Function
    
ProcessError:
    Add = False
    Err.Raise Err.Number, ", Err.Description"
End Function


'-------------------------------------------------------------
'Edit Record
'-------------------------------------------------------------
Public Function Edit(oConnection As Object) As Boolean
    Dim oCmd As New ADODB.Command
    Dim SQL As String

    SQL = "UPDATE MASTERBARANG SET " + _
          "NamaBarang =?, " + _
          "Satuan =?, " + _
          "HPP =?, " + _
          "HargaJual =?, " + _
          "StokBarang =? " + _
          "WHERE KodeBarang = ? "
    
    Edit = True
    On Error GoTo ProcessError

    oCmd.ActiveConnection = oConnection
    oCmd.CommandType = adCmdText
    oCmd.CommandText = SQL
    oCmd.Parameters(0) = Fields.NamaBarang
    oCmd.Parameters(1) = Fields.Satuan
    oCmd.Parameters(2) = Fields.HPP
    oCmd.Parameters(3) = Fields.HargaJual
    oCmd.Parameters(4) = Fields.StokBarang
    oCmd.Parameters(5) = Fields.KodeBarang
    oCmd.Execute

    Exit Function

ProcessError:
    Edit = False
    Err.Raise Err.Number, ", Err.Description"
End Function


'-------------------------------------------------------------
'Delete Record
'-------------------------------------------------------------
Public Function Delete(oConnection As Object) As Boolean
    Dim oCmd As New ADODB.Command
    Dim SQL As String

    SQL = "DELETE FROM MASTERBARANG " + _
          "WHERE KodeBarang = ? "
    
    Delete = True
    On Error GoTo ProcessError

    oCmd.ActiveConnection = oConnection
    oCmd.CommandType = adCmdText
    oCmd.CommandText = SQL
    oCmd.Parameters(0) = Fields.KodeBarang
    oCmd.Execute

    Exit Function

ProcessError:
    Delete = False
    Err.Raise Err.Number, ", Err.Description"
End Function


'-------------------------------------------------------------
'Find Record
'-------------------------------------------------------------
Public Function Find(oConnection As Object) As Boolean
    Dim oCmd As New ADODB.Command
    Dim oResult As ADODB.Recordset
    Dim SQL As String

    SQL = "SELECT * FROM MASTERBARANG " + _
          "WHERE KodeBarang = ? "

    oCmd.ActiveConnection = oConnection
    oCmd.CommandType = adCmdText
    oCmd.CommandText = SQL
    oCmd.Parameters(0) = Fields.KodeBarang
    Set oResult = oCmd.Execute

    If Not oResult.EOF Then
       Fields.KodeBarang = Trim(oResult!KodeBarang)
       Fields.NamaBarang = Trim(oResult!NamaBarang)
       Fields.Satuan = Trim(oResult!Satuan)
       Fields.HPP = oResult!HPP
       Fields.HargaJual = oResult!HargaJual
       Fields.StokBarang = oResult!StokBarang
       Find = True
    Else
       Find = False
    End If

    oResult.Close
End Function


'-------------------------------------------------------------
'Read Record
'-------------------------------------------------------------
Public Function Read(oConnection As Object) As Object
    Dim oCmd As New ADODB.Command
    Dim oResult As ADODB.Recordset
    Dim SQL As String

    SQL = "SELECT * FROM MASTERBARANG " + _
          "ORDER BY NamaBarang"
    
    oCmd.ActiveConnection = oConnection
    oCmd.CommandType = adCmdText
    oCmd.CommandText = SQL

    oConnection.CursorLocation = adUseClient
    Set oResult = oCmd.Execute
    Set oResult.ActiveConnection = Nothing
    Set Read = oResult
    oConnection.CursorLocation = adUseServer

    Set oResult = Nothing
    Set oCmd = Nothing
End Function

Implementasi dalam Form

Kemudian untuk implementasi dalam kode program di Form ada bisa berimprovisasi secara bebas, tetapi yang perlu diketahui adalah untuk penggunaan class master barang diatas adalah: dengan menuliskan kode program program berikut ini: 

'Evaluasi Command Button
Private Sub cmdProses_Click(Index As Integer)
    Dim oMasterBarang As New MasterBarang

    Select Case Index

        'Jika Simpan Data
        Case cmdSave
            '--------------------------------------------------------------------
            If MsgBox("Simpan Data Tersebut ? ", vbQuestion + vbYesNo, "Konfirmasi") = vbNo Then
               Exit Sub
            End If
            
            On Error GoTo ProcessError
            oConnection.BeginTransaction
            
            oMasterBarang.Fields.KodeBarang = Trim(txtKodeBarang.Text)
            oMasterBarang.Fields.NamaBarang = Trim(txtNamaBarang.Text)
            oMasterBarang.Fields.Satuan = Trim(txtSatuan.Text)
            oMasterBarang.Fields.HPP = Val(GetNumeric(txtHPP.Text))
            oMasterBarang.Fields.HargaJual = Val(GetNumeric(txtHargaJual.Text))
            oMasterBarang.Fields.StokBarang = Val(GetNumeric(txtStokBarang.Text))
            If SaveMode = AddMode Then
                oMasterBarang.Add oConnection.Server
            Else
                oMasterBarang.Edit oConnection.Server
            End If

            oConnection.CommitTransaction

            On Error GoTo 0
            ResetData
            txtKodeBarang.SetFocus
            '--------------------------------------------------------------------
        
        'Jika Hapus Data
        Case cmdDelete
            'Cek Data On Transaction
            '--------------------------------------------------------------------
            If MsgBox("Hapus Record Ini ? ", vbQuestion + vbYesNo, "Konfirmasi") = vbYes Then
                On Error GoTo ProcessError
                oConnection.BeginTransaction
                
                oMasterBarang.Fields.KodeBarang = Trim(txtKodeBarang.Text)
                oMasterBarang.Delete oConnection.Server
                
                oConnection.CommitTransaction
                On Error GoTo 0
                ResetData
                txtKodeBarang.SetFocus
            End If
            '--------------------------------------------------------------------

        Case cmdCancel
            '--------------------------------------------------------------------
            If MsgBox("Input/Edit Data Dibatalkan ? ", vbQuestion + vbYesNo, "Konfirmasi") = vbNo Then
               Exit Sub
            End If

            ResetData
            txtKodeBarang.SetFocus
            '--------------------------------------------------------------------

        Case cmdExit
            '--------------------------------------------------------------------
            Unload Me
            Exit Sub
            '--------------------------------------------------------------------

    End Select
    Set oMasterBarang = Nothing
    Exit Sub

ProcessError:
    Set oMasterBarang = Nothing
    oConnection.RollBackTransaction
    MsgBox Err.Number & ", " & Err.Description, vbExclamation, "Peringatan"
End Sub
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------

Dan untuk membaca data barang dapat anda perhatikan seperti kode program berikut ini: 

'Menampilkan Data Barang
Private Sub TampilkanDataBarang()
    Dim oMasterBarang As New MasterBarang
    Dim oResult As Object
    Dim oData As ListItem
    
    lsvMasterBarang.ListItems.Clear
    Set oResult = oMasterBarang.Read(oConnection.Server)
    While Not oResult.EOF
          Set oData = lsvMasterBarang.ListItems.Add
          oData.Text = Trim(oResult!KodeBarang)
          oData.SubItems(1) = Trim(oResult!NamaBarang)
          oData.SubItems(2) = Trim(oResult!Satuan)
          oData.SubItems(3) = Format(oResult!HPP, "###,##0")
          oData.SubItems(4) = Format(oResult!HargaJual, "###,##0")
          oData.SubItems(5) = Format(oResult!StokBarang, "###,##0")
 
          oResult.MoveNext
    Wend
    
    Set oMasterBarang = Nothing
End Sub



Next
« Prev Post
Previous
Next Post »
Subscribe to: Post Comments (Atom)