Data Form Server Dan Client Beserta Listing Programnya

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 Dihapus.", 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 Command1_Click()

    Adodc1.Refresh

End Sub

Sub MulaiServer()

    WS.LocalPort = 1000

    WS.Listen

End Sub

Private Sub Form_Load()

    Call OPENDB

    Call Hapus

    MulaiServer

End Sub

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"

    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 Kode_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then

        If Kode.Text = "" Then

            MsgBox "Masukkan 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

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 "INSERT"

       

        Case "EDIT"

       

        Case "DELETE"

       

    End Select

End Sub

"Module1 Server"

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:\WSDB\WSDB-SERVER\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 Program Client"

Dim IPServer As String

Sub Hapus()
    Kode.Enabled = True
    ClearFORM Me
    Call RubahCMD(Me, True, False, False, False)
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"
    Db.BeginTrans
    Db.Execute SQL, adCmdTable
    Db.CommitTrans
    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

        Else
           
        End If
    Case 2
        X = MsgBox("Yakin Record Barang Akan Dihapus.", vbQuestion + vbYesNo, "Barang")
        If X = vbYes Then
       
        End If
        Call Hapus
        Kode.SetFocus
    Case 3
        Call Hapus
        Kode.SetFocus
    Case 4
        Unload Me
End Select
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 Kode_Keypress(Keyascii As Integer)
    If Keyascii = 13 Then
        If Kode.Text = "" Then Exit Sub
       
        WS.SendData "SEARCH-" & Kode.Text
    End If
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
        End Select
End Sub

"Module2 Client"

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.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