Membuat CRUD Database Menggunakan Visual Basic ( Bagian 1 )

Selamat malam sobat indonesia, khusus untuk programmer veteran kali ini saya akan membagikan bagaimana mudahnya membuat CRUD Database menggunakan Visual Basic 6. Meskipun tergolong bahasa pemrograman yang cukup tua, namun pemrograman visual basic 6 masih banyak peminatnya, karena memang sangat ringan jika dijalankan di dalam sistem operasi windows.

Cara ini saya temukan disalah satu group programer di Indonesia. Class Database ini dibuat oleh seorang programer dan saya hanya membagikan untuk pembaca disini, semoga artikel ini bermanfaat kedepannya untuk anda.
Fungsi dari class ini adalah untuk koneksi database, menyimpan data, update data, dan hapus data serta fungsi SQL lainnya. Apabila kita tidak menggunakan class untuk proses crud databasenya mungkin akan terlalu banyak text perintah SQL yang akan kita ketik. Contoh misalnya jika kita mau melakukan perintah menyimpan data ke database maka kita harus nulis perintah SQL tersebut didalam program yang kita buat yaitu SQL simpan :

sql = "INSERT INTO tblbarang(kodebarang,namabarang,harga) VALUES( " & _ 
"'" & txtKodeBarang.Text & "'," & _ 
"'" & txtNamaBarang.Text & "'," & _ 
"'" & txtHarga.Text & "')" 
DB.Execute sql

Sedangkan kalau kita menggunakan fungsi class yang kita buat nantinya, maka akan lebih mudah dalam proses simpannya yaitu :

strTable = "tblbarang"

dtFields(0) = "kodebarang"
dtFields(1) = "namabarang"
dtFields(2) = "harga"

dtValues(0) = Trim(Me.txtKodeBarang.Text)
dtValues(1) = Trim(Me.txtNamaBarang.Text)
dtValues(2) = Trim(Me.txtHarga.Text)

.RunQueryInsert strTable, dtFields, dtValues

Proses simpan diatas dapat berjalan setelah kita deklarasikan strTable, dtFields, dan dtValues nya. Kita tidak perlu lagi menuliskan perintah SQL INSERT INTO, biasanya kalau kita tidak menggunakan fungsi class sering kali terjadi kesalahan perintah simpan dan update data pada titik koma. Oleh karena itu lebih efektif menurut saya jika kita membuat fungsi class CRUD database, dilihat juga lebih rapi untuk cara ngodingnya, langsung saja. 1. Kita buat classModule dan beri nama “clsDB”, tuliskan code dibawah ini dalam “clsDB ” tersebut :

Option Explicit
'Programmed by Agung Novian
'pujanggabageur@yahoo.com
'www.diajar.com

Private Declare Function GetShortPathName _
   Lib "kernel32" Alias "GetShortPathNameA" ( _
   ByVal lpszLongPath As String, _
   ByVal lpszShortPath As String, _
   ByVal cchBuffer As Long) As Long

   Private myConnection As ADODB.Connection
   Private WithEvents myRecordSet As ADODB.RecordSet
   Private myQuery As String
   Private blnErr As Boolean
   Private myIsConnect As Boolean
   Private myIsRun As Boolean
   Private lngRecordCount As Long
   Private lngRecordPos As Long
   Private myConnectionString As String

   Private strDBPath As String
   Private strDBName As String
   Private strDBPassword As String
   Private strDBServer As String
   Private strDBPort As String
   Private strDBUserName As String
   Private strErr As String

   Private strDSN As String

Enum tDatabase
   dbDSN = 0
   dbAcces2003 = 1
   dbAcces2007 = 2
   dbSQLServer = 3
   dbMySQL = 4
   dbFirebird = 5
End Enum

Private myDBType As tDatabase

Private Function GetShortPath(strFileName As String) As String
   Dim lngRes As Long
   Dim strPath As String
   strPath = String$(165, 0)
   lngRes = GetShortPathName(strFileName, strPath, 164)
   GetShortPath = Left$(strPath, lngRes)
End Function

Public Function ConnectDB() As Boolean
   On Error GoTo YourMama
   ConnectDB = False

   If myConnectionString = "" Then Exit Function

    Set myConnection = New ADODB.Connection
    myConnection.Open myConnectionString

    IsConnect = True
    ConnectDB = True
  Exit Function

  YourMama:
  Dim lngErrorNumber As Long
  strErr = "Err " & CStr(Err.Number) & ": " & Err.Description
  IsConnect = False
  Exit Function
End Function

Function GetErrorResult(Description As String, Optional strErr As String) As String
   Dim intCari As Integer
   Dim lngReturn As Long

   blnErr = True

   intCari = InStr(1, Description, "unknown database", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 1
     strErr = "Error " & lngReturn & ": " & "Periksa nama database"
   End If

   intCari = InStr(1, Description, "access denied for user", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 2
     strErr = "Error " & lngReturn & ": " & "Periksa nama user & pass"
   End If

   intCari = InStr(1, Description, "unknown mysql server", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 3
     strErr = "Error " & lngReturn & ": " & "Periksa nama server"
   End If

   intCari = InStr(1, Description, "can't connect to mysql server", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 4
     strErr = "Error " & lngReturn & ": " & "Periksa port server/mysql service"
   End If

   intCari = InStr(1, Description, "data source name not found", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 5
     strErr = "Error " & lngReturn & ": " & "Periksa nama DSN"
   End If

   intCari = InStr(1, Description, "table", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 6
     strErr = "Error " & lngReturn & ": " & "Periksa nama tabel"
   End If

   intCari = InStr(1, Description, "unknown column", vbTextCompare)
   If intCari <> 0 Then
     lngReturn = 7
     strErr = "Error " & lngReturn & ": " & "Periksa nama tabel"
   End If

   GetErrorResult = strErr
   Exit Function
End Function

Function OpenConnection() As Boolean
  On Error GoTo YourMama
  Set myRecordSet = New ADODB.RecordSet

  With myRecordSet
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockOptimistic
  End With

  myRecordSet.Open Query, myConnection
    IsRun = True
    OpenConnection = True
Exit Function

  YourMama:
  Dim lngErrorNumber As Long
   strErr = "Err " & CStr(Err.Number) & ": " & Err.Description
   Set myRecordSet = Nothing
   IsRun = False
   OpenConnection = False
   Exit Function
End Function

Private Function GetConnectionString() As String
Dim strConnection As String
Dim strDBPathFull As String
Dim strProvider As String

If myDBType = dbAcces2003 Then
strProvider = "Microsoft.Jet.OLEDB.4.0"
ElseIf myDBType = dbAcces2007 Then
strProvider = "Microsoft.ACE.OLEDB.12.0"
End If

If Right(strDBPath, 1) = "\" Then
strDBPath = Mid(strDBPath, 1, Len(strDBPath) - 1)
End If

strDBPath = strDBPath & "\"

Select Case myDBType
Case 0
strConnection = "dsn=" & strDSN
Case 1, 2
strDBPathFull = strDBPath & strDBName
If strDBPassword = "" Then
strConnection = "Provider=" & strProvider & ";" & _
"Data Source=" & strDBPathFull & _
";Persist Security Info=False;"
Else
If strDBUserName = "" Then
strConnection = "Provider=" & strProvider & ";" & _
"Data Source=" & strDBPathFull & _
";Persist Security Info=False;Jet OLEDB:" & _
"Database Password=" & strDBPassword
Else
strConnection = "Provider=" & strProvider & ";" & _
"Data Source=" & strDBPathFull & _
";Persist Security Info=False;Password=" & _
strDBPassword & ";User ID=" & strDBUserName
End If
End If
Case 3
If strDBServer <> "" Then
strConnection = "Provider=SQLOLEDB;Data Source=" & _
strDBServer & ";Initial Catalog=" & strDBName & _
";User Id=" & strDBUserName & _
";Password=" & strDBPassword & ";"
Else
strConnection = "Provider=SQLOLEDB" & _
";Initial Catalog=" & strDBName & _
";User Id=" & strDBUserName & _
";Password=" & strDBPassword & ";"
End If
Case 4
If strDBServer = "" Then
strDBServer = "localhost"
End If

strConnection = "DRIVER={MySQL ODBC 5.1 Driver}" & _
";SERVER=" & strDBServer & _
";PORT=" & strDBPort & _
";DATABASE=" & strDBName & _
";USER=" & strDBUserName & _
";PASSWORD=" & strDBPassword & _
";OPTION=3;"
Case 5
strDBPathFull = GetShortPath(strDBPath) & strDBName
strConnection = _
"DRIVER={Firebird/InterBase(r) driver}" & _
";DATABASE=" & strDBPathFull & _
";USER=" & strDBUserName & _
";PASSWORD=" & strDBPassword & _
";DIALECT=3;"
End Select
GetConnectionString = strConnection
End Function

Public Property Get RecordSet() As ADODB.RecordSet
Set RecordSet = myRecordSet
End Property

Public Property Let RecordSet(ByVal vNewValue As ADODB.RecordSet)
Set myRecordSet = vNewValue
End Property

Public Property Get Query() As String
Query = myQuery
End Property

Public Property Let Query(ByVal vNewValue As String)
myQuery = vNewValue
End Property

Public Property Get IsConnect() As Boolean
IsConnect = myIsConnect
End Property

Public Property Let IsConnect(ByVal vNewValue As Boolean)
myIsConnect = vNewValue
End Property

Public Property Get IsRun() As Boolean
IsRun = myIsRun
End Property

Public Property Let IsRun(ByVal vNewValue As Boolean)
myIsRun = vNewValue
End Property

Public Property Get DBType() As tDatabase
DBType = myDBType
End Property

Public Property Let DBType(ByVal vNewValue As tDatabase)
myDBType = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DBPort() As String
DBPort = strDBPort
End Property

Public Property Let DBPort(ByVal vNewValue As String)
strDBPort = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DBServer() As String
DBServer = strDBServer
End Property

Public Property Let DBServer(ByVal vNewValue As String)
strDBServer = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DBPath() As String
DBPath = strDBPath
End Property

Public Property Let DBPath(ByVal vNewValue As String)
strDBPath = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DBName() As String
DBName = strDBName
End Property

Public Property Let DBName(ByVal vNewValue As String)
strDBName = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DSN() As String
DSN = strDSN
End Property

Public Property Let DSN(ByVal vNewValue As String)
strDSN = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DBUserName() As String
DBUserName = strDBUserName
End Property

Public Property Let DBUserName(ByVal vNewValue As String)
strDBUserName = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get DBPassword() As String
DBPassword = strDBPassword
End Property

Public Property Let DBPassword(ByVal vNewValue As String)
strDBPassword = vNewValue
myConnectionString = GetConnectionString
End Property

Public Property Get ConnectionString() As String
ConnectionString = myConnectionString
End Property

Public Property Get ErrQuery() As String
ErrQuery = strErr
End Property

Public Function RunQuery(Optional strQuery As String = "") As Boolean
On Error GoTo YourMama
Dim strSQL As String
Dim blnRunOK As Boolean
strSQL = IIf(strQuery = "", myQuery, strQuery)
If IsConnect Then
Query = strSQL
blnRunOK = OpenConnection
End If
RunQuery = blnRunOK
Exit Function
YourMama:
Exit Function
End Function

Public Function RunQueryDelete(strTable As String, Optional strWhere As String = "") As Boolean
On Error GoTo YourMama
Dim strSQL As String
Dim blnRunOK As Boolean

strSQL = "DELETE FROM " & strTable
If strWhere <> "" Then strSQL = strSQL & " WHERE " & strWhere

If IsConnect Then
Query = strSQL
blnRunOK = OpenConnection
End If

RunQueryDelete = blnRunOK
Exit Function
YourMama:
Exit Function
End Function

Public Function RunQueryInsert(strTable As String, _
dtFields() As Variant, dtValues() As Variant) As Boolean
On Error GoTo YourMama
Dim strSQL As String
Dim blnRunOK As Boolean

If IsConnect Then
Dim q As String
Dim v As String
Dim n As String
Dim i As Integer

i = 0

v = ""
n = ""

q = "INSERT INTO " & strTable & " "

Dim xdtField As Variant
Dim xdtValue As Variant

For Each xdtField In dtFields()
n = n & xdtField & ", "
Next

For Each xdtValue In dtValues()
xdtValue = IIf(IsNumeric(xdtValue), xdtValue, "'" & xdtValue & "'")

If LCase(xdtValue) = "null" Then
v = v & "NULL, "
ElseIf LCase(xdtValue) = "now()" Then
v = v & Format(Now, "yyyy-mm-dd hh:mm:ss") & ", "
ElseIf xdtValue = "" Then
v = v & "'', "
Else
v = v & xdtValue & ","
End If
i = i + 1
Next

n = RTrim(n)
v = RTrim(v)

If Right(n, 1) = "," Then n = Mid(n, 1, Len(n) - 1)
If Right(v, 1) = "," Then v = Mid(v, 1, Len(v) - 1)

q = q & "(" & n & ") VALUES (" & v & ")"

Query = q
blnRunOK = RunQuery
RunQueryInsert = blnRunOK
End If
Exit Function
YourMama:
RunQueryInsert = False
Exit Function
End Function

Public Function RunQueryUpdate(strTable As String, _
dtFields() As Variant, dtValues() As Variant, _
Optional strWhere As String = "") As Boolean
On Error GoTo YourMama
Dim strSQL As String
Dim blnRunOK As Boolean

If IsConnect Then
Dim q As String
Dim v As String
Dim n As String
Dim i As Integer

i = 0

v = ""
n = ""

q = "UPDATE " & strTable & " SET "

Dim xdtField As Variant
Dim xdtValue As Variant

For Each xdtValue In dtValues()
xdtField = dtFields(i)
n = xdtField

xdtValue = IIf(IsNumeric(xdtValue), xdtValue, "'" & xdtValue & "'")

If LCase(xdtValue) = "'null'" Then
v = "NULL, "
ElseIf LCase(xdtValue) = "'now()'" Then
v = "'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'"
ElseIf xdtValue = "" Then
v = "''"
Else
v = xdtValue
End If

q = q & n & "=" & v & ","

i = i + 1
Next

q = RTrim(q)
If Right(q, 1) = "," Then q = Mid(q, 1, Len(q) - 1)

If strWhere <> "" Then q = q & " WHERE " & strWhere

Debug.Print q

Query = q
blnRunOK = RunQuery
RunQueryUpdate = blnRunOK
End If
Exit Function
YourMama:
RunQueryUpdate = False
Exit Function
End Function

Private Sub Class_Initialize()
myDBType = -1
strDBPath = ""
strDBName = ""
strDBPassword = ""
strDBServer = ""
strDBPort = ""
strDBUserName = ""
Call ConnectDB
End Sub

Private Sub Class_Terminate()
Set myRecordSet = Nothing
Set myConnection = Nothing
End Sub

2. Kita buat sebuah Module untuk koneksi ke databasenya, kita berinama “basDB”. tuliskan code dibawah ini dalam “basDB” tersebut :

Option Explicit

Public myDB As New clsDB
Public strDBServer As String
Public strDBPort As String
Public strDBUserName As String
Public strDBPassword As String
Public strDBName As String
Public strErr As String

Function Koneksi()
Set myDB = New clsDB
With myDB
.DBType = dbMySQL
.DBServer = "localhost"
.DBPort = 3306
.DBUserName = "root"
.DBPassword = ""
.DBName = "dbtoko"
.ConnectDB
strErr = .ErrQuery
If Not myDB.IsConnect Then
MsgBox strErr, vbExclamation
Else
MsgBox "Koneksi berhasil", vbInformation
End If
End With
End Function

Ok sobat, selesai sudah dalam membuat class untuk CRUD databasenya, selanjutnya kita akan buat form pada VB 6 untuk proses simpan edit dan hapus data. Sampai jumpa di artikel berikutnya, Membuat CRUD Database MySQL – VB 6 ( Bagian 2 ). Semoga bermanfaat, terima kasih