JAWABAN NOMOR 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=D:\a\Soal no 2\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 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


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=D:\a\Soal no 2\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



good luck..............