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