Listing Program Server
Sub hapus()
kode.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = "&simpan"
End Sub
Sub prosesdb(log As Byte)
Select Case log
Case 0
sql = "insert into barang(kode,nama,harga)" & _
" values('" & kode.Text & _
"','" & nama.Text & _
"' ,'" & harga.Text & "')"
Case 1
sql = "update barang set nama ='" & nama.Text & "', " & _
" harga ='" & harga.Text & "' " & _
" where kode ='" & kode.Text & "'"
Case 2
sql = "delete from barang where kode='" & kode.Text & "'"
End Select
MsgBox "pemrosesan RECORD database telah berhasil....!", vbInformation, "data barang"
db.BeginTrans
db.Execute sql, adCmdTable
db.CommitTrans
Adodc1.Refresh
Call hapus
kode.SetFocus
End Sub
Sub tampilbarang()
On Error Resume Next
kode.Text = rs!kode
nama.Text = rs!nama
harga.Text = rs!harga
End Sub
Private Sub Cmdproses_Click(Index As Integer)
Select Case Index
Case 0
Call hapus
kode.SetFocus
Case 1
If cmdproses(1).Caption = "&simpan" Then
Call prosesdb(0)
Else
Call prosesdb(1)
End If
Case 2
x = MsgBox("yakin RECORD barang akan di hapus...!", vbQuestion + vbYesNo, "barang")
If x = vbYes Then prosesdb 2
Call hapus
kode.SetFocus
Case 3
Call hapus
kode.SetFocus
Case 4
Unload Me
Case 5
Adodc1.Refresh
End Select
End Sub
Private Sub Form_Load()
Call opendb
Call hapus
End Sub
Private Sub kode_keypress(keyascii As Integer)
If keyascii = 13 Then
If kode.Text = "" Then
MsgBox "masukan kode barang..!", vbInformation, "barang"
kode.SetFocus
Exit Sub
End If
sql = "select * from barang where kode='" & kode.Text & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open sql, db, adopendymic, adLockOptimistic
If rs.RecordCount <> 0 Then
tampilbarang
Call rubahcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&edit"
kode.Enabled = False
Else
x = kode.Text
Call hapus
kode.Text = x
Call rubahcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&simpan"
End If
nama.SetFocus
End If
End Sub
LISTING MODULE SERVER
Public db As New ADODB.Connection
Public rs As New ADODB.Recordset
Public rs2 As New ADODB.Recordset
Public sql As String
Sub opendb()
If db.State = adStateOpen Then db.Close
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\pertemuan X\test.mdb;Persist Security Info=False"
End Sub
Sub clearform(f As Form)
Dim ctl As Control
For Each ctl In f
If TypeOf ctl Is TextBox Then ctl.Text = ""
If TypeOf ctl Is ComboBox Then ctl.Text = ""
Next
End Sub
Sub center(f As Form)
f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4
End Sub
Sub rubahcmd(f As Form, l0 As Boolean, l1 As Boolean, l2 As Boolean, l3 As Boolean)
f.cmdproses(0).Enabled = l0
f.cmdproses(1).Enabled = l1
f.cmdproses(2).Enabled = l2
f.cmdproses(3).Enabled = l3
End Sub
Sub hapus()
kode.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = "&simpan"
End Sub
Sub prosesdb(log As Byte)
Select Case log
Case 0
sql = "insert into barang(kode,nama,harga)" & _
" values('" & kode.Text & _
"','" & nama.Text & _
"' ,'" & harga.Text & "')"
Case 1
sql = "update barang set nama ='" & nama.Text & "', " & _
" harga ='" & harga.Text & "' " & _
" where kode ='" & kode.Text & "'"
Case 2
sql = "delete from barang where kode='" & kode.Text & "'"
End Select
MsgBox "pemrosesan RECORD database telah berhasil....!", vbInformation, "data barang"
db.BeginTrans
db.Execute sql, adCmdTable
db.CommitTrans
Adodc1.Refresh
Call hapus
kode.SetFocus
End Sub
Sub tampilbarang()
On Error Resume Next
kode.Text = rs!kode
nama.Text = rs!nama
harga.Text = rs!harga
End Sub
Private Sub Cmdproses_Click(Index As Integer)
Select Case Index
Case 0
Call hapus
kode.SetFocus
Case 1
If cmdproses(1).Caption = "&simpan" Then
Call prosesdb(0)
Else
Call prosesdb(1)
End If
Case 2
x = MsgBox("yakin RECORD barang akan di hapus...!", vbQuestion + vbYesNo, "barang")
If x = vbYes Then prosesdb 2
Call hapus
kode.SetFocus
Case 3
Call hapus
kode.SetFocus
Case 4
Unload Me
Case 5
Adodc1.Refresh
End Select
End Sub
Private Sub Form_Load()
Call opendb
Call hapus
End Sub
Private Sub kode_keypress(keyascii As Integer)
If keyascii = 13 Then
If kode.Text = "" Then
MsgBox "masukan kode barang..!", vbInformation, "barang"
kode.SetFocus
Exit Sub
End If
sql = "select * from barang where kode='" & kode.Text & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open sql, db, adopendymic, adLockOptimistic
If rs.RecordCount <> 0 Then
tampilbarang
Call rubahcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&edit"
kode.Enabled = False
Else
x = kode.Text
Call hapus
kode.Text = x
Call rubahcmd(Me, False, True, True, True)
cmdproses(1).Caption = "&simpan"
End If
nama.SetFocus
End If
End Sub
LISTING MODULE SERVER
Public db As New ADODB.Connection
Public rs As New ADODB.Recordset
Public rs2 As New ADODB.Recordset
Public sql As String
Sub opendb()
If db.State = adStateOpen Then db.Close
db.CursorLocation = adUseClient
db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\pertemuan X\test.mdb;Persist Security Info=False"
End Sub
Sub clearform(f As Form)
Dim ctl As Control
For Each ctl In f
If TypeOf ctl Is TextBox Then ctl.Text = ""
If TypeOf ctl Is ComboBox Then ctl.Text = ""
Next
End Sub
Sub center(f As Form)
f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4
End Sub
Sub rubahcmd(f As Form, l0 As Boolean, l1 As Boolean, l2 As Boolean, l3 As Boolean)
f.cmdproses(0).Enabled = l0
f.cmdproses(1).Enabled = l1
f.cmdproses(2).Enabled = l2
f.cmdproses(3).Enabled = l3
End Sub
Hasil Program