Sabtu, 28 Januari 2012

SOAL Nomor 2


Listing Program Server :

MODUL
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:\logOnOff\SERVER\belajarserver\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


FORM1
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, “barang”
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
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
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 “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, adOpenDynamic, 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, False, True)
cmdproses(1).Caption = “&Simpan”
End If
nama.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 barang 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!nama & “/” & RS!harga
Else
WS.SendData “NOTHING-DATA”
End If
Case “DELETE”
SQL = “DELETE * From barang ” & _
“where kode=’” & xData1(1) & “‘”
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Adodc1.Refresh
WS.SendData “DEL-xxx”
Case “UPDATE”
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData “Edit-xxx”
Adodc1.Refresh
Case “INSERT”
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData “INSERT-xxx”
Adodc1.Refresh
End Select
End Sub

MDIFORM1
Private Sub data_barang_Click()
Form1.Show
End Sub
Private Sub exit_Click()
End
End Sub

Listing Program Client :

MODUL
Public sql As String
Sub clearform(f As Form)
Dim clt As Control
For Each clt In f
If TypeOf clt Is TextBox Then clt.Text = “”
If TypeOf clt Is ComboBox Then clt.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

FORM1
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”
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, “Barang”)
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 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 = “192.168.10.1″
ipclient = WS.LocalIP
WS.Connect ipserver, 1000
End Sub
Private Sub Form_Load()
Call Hapus
mulaikoneksi
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”
nama.SetFocus
Case “RECORD”
xdata2 = Split(xdata1(1), “/”)
nama.Text = xdata2(0)
harga.Text = xdata2(1)
Call RubahCMD(Me, False, True, True, True)
cmdProses(1).Caption = “&Edit”
kode.Enabled = False
nama.SetFocus
Case “DEL”
MsgBox “Penhapusan Data Berhasil…..!!!”
Call Hapus
Case “EDIT”
MsgBox “Pengeditan Record Berhasil…..!!!”
Call Hapus
Case “INSERT”
MsgBox “Penyimpanan Record Berhasil…..!!!”
Call Hapus
End Select
End Sub

0 comments:

Posting Komentar

Twitter Delicious Facebook Digg Stumbleupon Favorites More