jawaban kuis no 2

kasus

server

 

listing 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

listing 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

client

listing 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


listing 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 = "127.0.0.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