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