Module Client

Public SQL As String
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

Module Server

Source Code :
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=D:\WSDB\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

Form Client

Tampilan Form Login dan List Code-nya :

Source Code :
Dim IPServer As String
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 Mobil(Kode,Merk,Tipe,Jenis,Model,ThnPembuatan,IsiSilinder,Warna,BahanBakar)" & _
"values('" & Kode.Text & _
"','" & Merk.Text & _
"','" & Tipe.Text & _
"','" & Jenis.Text & _
"','" & Model.Text & _
"','" & ThnPembuatan.Text & _
"','" & IsiSilinder.Text & _
"','" & Warna.Text & _
"','" & BhnBakar.Text & "')"
Case 1
SQL = "UPDATE Mobil SET Merk='" & Merk.Text & "'," & _
"Tipe='" & Tipe.Text & "'," & _
"Jenis='" & Jenis.Text & "'," & _
"Model='" & Model.Text & "'," & _
"ThnPembuatan='" & ThnPembuatan.Text & "'," & _
"IsiSilinder='" & IsiSilinder.Text & "'," & _
"Warna='" & Warna.Text & "'," & _
"BahanBakar='" & BhnBakar.Text & "' " & _
"where Kode='" & Kode.Text & "'"
Case 2
SQL = "DELETE FROM Mobil WHERE Kode='" & Kode.Text & "'"
End Select
MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Barang"
Call Hapus
Kode.SetFocus
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
SQL = "INSERT INTO Mobil(Kode,Merk,Tipe,Jenis,Model,ThnPembuatan,IsiSilinder,Warna,BahanBakar)" & _
"values('" & Kode.Text & _
"','" & Merk.Text & _
"','" & Tipe.Text & _
"','" & Jenis.Text & _
"','" & Model.Text & _
"','" & ThnPembuatan.Text & _
"','" & IsiSilinder.Text & _
"','" & Warna.Text & _
"','" & BhnBakar.Text & "')"
WS.SendData "INSERT-" & SQL
Else
SQL = "UPDATE Mobil set " & _
"Merk='" & Merk.Text & _
"Tipe='" & Tipe.Text & _
"Jenis='" & Jenis.Text & _
"Model='" & Model.Text & _
"ThnPembuatan='" & ThnPembuatan.Text & _
"IsiSilinder='" & IsiSilinder.Text & _
"Warna='" & Warna.Text & _
"',BahanBakar='" & BhnBakar.Text & _
"' where kode='" & Kode.Text & "'"
WS.SendData "UPDATE-" & SQL
End If
Case 2
x = MsgBox("Yakin RECORD Mobil Akan Dihapus...!", vbQuestion + vbYesNo, "Mobil")
If x = vbYes Then
WS.SendData "DELETE-" & Kode.Text
End If
Call Hapus
Kode.SetFocus
Case 3
Call Hapus
Kode.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call Hapus
MulaiKoneksi
End Sub
Private Sub Kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Kode.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & Kode.Text
End If
End Sub
Sub MulaiKoneksi()
IPServer = "127.0.0.1"
IPClient = WS.LocalIP
WS.Connect IPServer, 1000
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
End
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim xKirim As String
Dim xData1() As String
Dim xData2() As String
WS.GetData xKirim, vbString, bytesTotal
xData1 = Split(xKirim, "-")
Select Case xData1(0)
Case "NOTHING"
x = Kode.Text
Call Hapus
Kode.Text = x
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = "&Simpan"
Merk.SetFocus
Case "RECORD"
xData2 = Split(xData1(1), "/")
Merk.Text = xData2(0)
Tipe.Text = xData2(1)
Jenis.Text = xData2(2)
Model.Text = xData2(3)
ThnPembuatan.Text = xData2(4)
IsiSilinder.Text = xData2(5)
Warna.Text = xData2(6)
BhnBakar.Text = xData2(7)
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
Kode.Enabled = False
Merk.SetFocus
Case "DEL"
MsgBox "Penghapusan Data Berhasil !"
Call Hapus
Case "EDIT"
MsgBox "Pengeditan Record Berhasil !"
Call Hapus
End Select
End Sub

Form Mobil

Tampilan Form Login dan List Code-nya :

Source Code :
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 Mobil(Kode,Merk,Tipe,Jenis,Model,ThnPembuatan,IsiSilinder,Warna,BahanBakar)" & _
"values('" & Kode.Text & _
"','" & Merk.Text & _
"','" & Tipe.Text & _
"','" & Jenis.Text & _
"','" & Model.Text & _
"','" & ThnPembuatan.Text & _
"','" & IsiSilinder.Text & _
"','" & Warna.Text & _
"','" & BhnBakar.Text & "')"
Case 1
SQL = "UPDATE Mobil SET Merk='" & Merk.Text & "'," & _
"Tipe='" & Tipe.Text & "'," & _
"Jenis='" & Jenis.Text & "'," & _
"Model='" & Model.Text & "'," & _
"ThnPembuatan='" & ThnPembuatan.Text & "'," & _
"IsiSilinder='" & IsiSilinder.Text & "'," & _
"Warna='" & Warna.Text & "'," & _
"BahanBakar='" & BhnBakar.Text & "' " & _
"where Kode='" & Kode.Text & "'"
Case 2
SQL = "DELETE FROM Mobil WHERE Kode='" & Kode.Text & "'"
End Select
MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Data Mobil"
DB.BeginTrans
DB.Execute SQL, adCmdTable
DB.CommitTrans
Call Hapus
Adodc1.Refresh
Kode.SetFocus
End Sub
Sub TampilMobil()
On Error Resume Next
Kode.Text = RS!Kode
Merk.Text = RS!Merk
Tipe.Text = RS!Tipe
Jenis.Text = RS!Jenis
Model.Text = RS!Model
ThnPembuatan.Text = RS!ThnPembuatan
IsiSilinder.Text = RS!IsiSilinder
Warna.Text = RS!Warna
BhnBakar.Text = RS!BahanBakar
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 Mobil Akan Dihapus...!", vbQuestion + vbYesNo, "Mobil")
If x = vbYes Then ProsesDB 2
Call Hapus
Kode.SetFocus
Case 3
Call Hapus
Kode.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call OPENDB
Call Hapus
MulaiServer
End Sub
Private Sub Kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Kode.Text = "" Then
MsgBox "Masukkan Kode Mobil...!", vbInformation, "Mobil"
Kode.SetFocus
Exit Sub
End If
SQL = "SELECT * FROM Mobil WHERE Kode='" & Kode.Text & "'"
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, DB, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
TampilMobil
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, False, True)
CmdProses(1).Caption = "&Simpan"
End If
Merk.SetFocus
End If
End Sub
Sub MulaiServer()
WS.LocalPort = 1000
WS.Listen
End Sub
Private Sub WS_ConnectionRequest(ByVal requestID As Long)
WS.Close
WS.Accept requestID
Me.Caption = "Server - Client" & WS.RemoteHostIP & "Connect"
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim xKirim As String
Dim xData1() As String
Dim xData2() As String
WS.GetData xKirim, vbString, bytesTotal
xData1 = Split(xKirim, "-")
Select Case xData1(0)
Case "SEARCH"
SQL = "SELECT*FROM Mobil WHERE Kode='" & xData1(1) & "'"
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, DB, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
WS.SendData "RECORD-" & RS!Merk & "/" & RS!Tipe & "/" & RS!Jenis & "/" & RS!Model & "/" & RS!ThnPembuatan & "/" & RS!IsiSilinder & "/" & RS!Warna & "/" & RS!BahanBakar
Else
WS.SendData "NOTHING-xxx"
End If
Case "INSERT"
DB.BeginTrans
DB.Execute xData1(1), adCmdTable
DB.CommitTrans
WS.SendData "INSERT-xxx"
Adodc1.Refresh
Case "UPDATE"
DB.BeginTrans
DB.Execute xData1(1), adCmdTable
DB.CommitTrans
WS.SendData "EDIT-xxx"
Adodc1.Refresh
Case "DELETE"
SQL = "DELETE FROM Mobil" & _
"where kode='" & xData1(1) & "'"
DB.BeginTrans
DB.Execute SQL, adCmdTable
DB.CommitTrans
Adodc1.Refresh
WS.SendData "DEL-SUKSES"
End Select
End Sub

Form Menu

Tampilan Form Login dan List Code-nya :

Source Code :

Private Sub mnF1_Click()
FrmMobil.Show
End Sub

Private Sub mnKeluar_Click()
If MsgBox("Anda Yakin Mau Keluar?", vbQuestion + vbYesNo, "Konfirmasi") = vbYes Then
End
End If
End Sub

Form Login

Tampilan Form Login dan List Code-nya :

Source Code :
Public conn As New ADODB.Connection
Public RS As New ADODB.Recordset
Private Sub commandok_Click()
If conn.State = 1 Then conn.Close
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & App.Path & "\login.mdb"

If RS.State = 1 Then RS.Close
RS.Open "select * from login where user= '" & Username.Text & "' And pass = '" & Password.Text & "'", conn, 3, 3
If Not RS.EOF Then
MsgBox "SELAMAT DATANG...!!!" & vbCrLf & _
"Sistem Informasi Penjualan Mobil PT.ManaTauLaku" & vbCrLf & _
"" & vbCrLf & _
"(C)opy Right by Jenson Sinaga Januari 2012", vbInformation + vbOKOnly, "Login Success"
Unload Me
FrmMenu.Show
Else
MsgBox "Data Usernama atau Password Anda Salah", vbCritical, "Login Failed"
Username.Text = ""
Password.Text = ""
Username.SetFocus
End If
End Sub
Private Sub Form_Load()
Username.Text = ""
Password.Text = ""
End Sub
Private Sub password_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Password.Text = "" Then Exit Sub
CommandOK.SetFocus
End If
End Sub
Private Sub username_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Username.Text = "" Then Exit Sub
Password.SetFocus
End If
End Sub