Kamis, 19 Januari 2012

PROJECT FORM MOBIL SERVER

HASIL FORM CLIENT

PROJECT FORM MOBIL SERVER

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!BhnBakar
Else
WS.SendData "NOTHING-DATA"
End If
Case "INSERT"
DB.BeginTrans
DB.Execute xData1(1), adCmdTable
DB.CommitTrans
WS.SendData "INSERT-xxx"
Adodc1.Refresh
Case "EDIT"
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.Execute SQL, adCmdTable
WS.SendData "DEL-SUKSES"
End Select
End Sub

PROJECT LOGIN SERVER

Dim i As Byte

Private Sub CommandOK_Click()
Select Case Index
Case 0
PanggilMENU
Case 1
End
End Select
End Sub

Private Sub Form_Load()
NamaUser.Text = ""
PasswordUser.Text = ""
i = 1
End Sub

Sub PanggilMENU()
If NamaUser.Text = "EDI SURANTA" And PasswordUser.Text = "SITEPU" Then
MsgBox "SELAMAT MENGGUNAKAN..." & vbCrLf & _
"Sistem Informasi Data Mobil Pribadi Saya" & vbCrLf & _
"" & vbCrLf & _
"(C)opy Right by EDI SURANTA SITEPU JANUARI 2012", vbInformation + vbOKOnly, "Passsword"
Unload Me
FrmMenu.Show
Else
If i > 2 Then
MsgBox "Maaf...!" & vbCrLf & _
"Anda tidak berhak menggunakan program ini !", vbInformation + vbOKOnly, "Password"
End
Else
MsgBox "Maaf...!" & vbCrLf & _
"Password anda SALAH", vbInformation + vbOKOnly, "Password"
End If
NamaUser.Text = ""
PasswordUser.Text = ""
NamaUser.SetFocus
i = i + 1
End If
End Sub

Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub NamaUser_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If NamaUser.Text = "" Then Exit Sub
PasswordUser.SetFocus
End If
End Sub

Private Sub PasswordUser_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If PasswordUser.Text = "" Then Exit Sub
CommandOK.SetFocus
End If
End Sub

PROJECT MENU UTAMA SERVER

Private Sub Form_Load()

End Sub

Private Sub mnF1_Click()
FrmMobil.Show
End Sub

Private Sub mnKeluar_Click()
End
End Sub

PROJECT MODULE

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

PROJECT FORM MOBIL CLIENT

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 Barang(Kode,Nama,Harga)" & _
"values('" & Kode.Text & _
"','" & Nama.Text & _
"','" & Harga.Text & "')"
WS.SendData "INSERT-" & SQL
Else
SQL = "UPDATE barang set " & _
"nama= '" & Nama.Text & _
"',harga='" & Harga.Text & _
"' where kode='" & Kode.Text & "'"
WS.SendData "UPDATE-" & SQL
End If
Case 2
x = MsgBox("Yakin RECORD Barang 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