Data Buku Berbasis Client-Server

Kali ini saya akan share data buku dengan menggunakan visual basic 6.0.
Menggunakan database Ms.access 2003,
kabel UTP untuk menghubungkan kedua komputer,
komponen winsock,
dan menggunakan ADOBC untuk koneksinya.

Berikut adalah listing programnya:

Listing program server :

Form Login

Private Sub Form_Load()
    Call hapus
   
End Sub
Sub hapus()
    user.Text = ""
    pass.Text = ""
   
End Sub

Private Sub keluar_Click()
    Unload Me
   
End Sub

Private Sub masuk_Click()
    If user.Text = "wulan" And pass.Text = "wulan" Then
        menu.Show
        ElseIf user.Text = "wewen" And pass.Text = "wewen" Then
            menu.Show
        ElseIf user.Text = "desi" And pass.Text = "desi" Then
            menu.Show
        ElseIf user.Text = "leni" And pass.Text = "leni" Then
            menu.Show
        ElseIf user.Text = "rahma" And pass.Text = "rahma" Then
            menu.Show
        ElseIf user.Text = "ayu" And pass.Text = "ayu" Then
            menu.Show
        ElseIf user.Text = "siti" And pass.Text = "siti" Then
            menu.Show
        Unload Me
    Else
        MsgBox "Password Anda Salah!!!", vbInformation, "info"
        Call hapus
        user.SetFocus
    End If

End Sub

Private Sub pass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If user.Text = "wulan" And pass.Text = "wulan" Then
            menu.Show
            Unload Me
        Else
            MsgBox "Password Anda Salah!!!"
            Call hapus
            user.SetFocus
        End If
    End If
           
End Sub

Private Sub user_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If user.Text = "" Then
            MsgBox "Username belum diisi!!!"
        Else
            pass.SetFocus
        End If
    End If
   
End Sub

Menu Utama

Private Sub f1_Click()
    Form_buku.Show
End Sub

Private Sub f2_Click()
    Form_login.Show
End Sub

Private Sub f4_Click()
    End
End Sub

Form Buku

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 tablebuku(kode,judul,pengarang)" & _
            "values('" & kode.Text & _
            "','" & judul.Text & _
            "','" & pengarang.Text & "')"
        Case 1
            SQL = "UPDATE tablebuku set judul='" & judul.Text & "'," & _
            "pengarang='" & pengarang.Text & "' " & _
            "where kode='" & kode.Text & "'"
        Case 2
            SQL = "DELETE FROM tablebuku 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 tampilbuku()
    On Error Resume Next
    kode.Text = RS!kode
    judul.Text = RS!judul
    pengarang.Text = RS!pengarang
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 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 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 buku!", vbInformation, "buku"
            kode.SetFocus
            Exit Sub
        End If
        SQL = "SELECT*FROM tablebuku WHERE kode='" & kode.Text & "'"
        If RS.State = adStateOpen Then RS.Close
        RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
        If RS.RecordCount <> 0 Then
            tampilbuku
            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
        judul.SetFocus
    End If
End Sub
Sub mulaiserver()
    Ws.LocalPort = 1500
    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 tablebuku 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!judul & "/" & RS!pengarang
            Else
                Ws.SendData "NOTHING-DATA"
            End If
        Case "DELETE"
            SQL = "Delete * from tablebuku" & _
                "where kode='" & xData1(1) & "'"
                Db.BeginTrans
                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

Module :

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:\apache\mysql\data\DbBuku\buku.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:

Form login :
Private Sub Form_Load()
    Call hapus
   
End Sub
Sub hapus()
    user.Text = ""
    pass.Text = ""
   
End Sub

Private Sub keluar_Click()
    Unload Me
   
End Sub


Private Sub login_Click()
    If user.Text = "wulan" And pass.Text = "wulan" Then
            Menu.Show
        ElseIf user.Text = "wewen" And pass.Text = "wewen" Then
            Menu.Show
        ElseIf user.Text = "desi" And pass.Text = "desi" Then
            Menu.Show
        ElseIf user.Text = "leni" And pass.Text = "leni" Then
            Menu.Show
        ElseIf user.Text = "rahma" And pass.Text = "rahma" Then
            Menu.Show
        ElseIf user.Text = "ayu" And pass.Text = "ayu" Then
            Menu.Show
        ElseIf user.Text = "siti" And pass.Text = "siti" Then
            Menu.Show
            Unload Me
        Else
            MsgBox "Password Anda Salah!!!", vbInformation, "info"
            Call hapus
            user.SetFocus
    End If

End Sub

Private Sub pass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If user.Text = "wulan" And pass.Text = "wulan" Then
            Menu.Show
            Unload Me
        Else
            MsgBox "Password Anda Salah!!!"
            Call hapus
            user.SetFocus
   
    End If
 End If
End Sub
Private Sub user_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If user.Text = "" Then
            MsgBox "Username belum diisi!!!"
        Else
            pass.SetFocus
        End If
    End If
   
End Sub

Menu utama :

Private Sub f1_Click()
    Frm_Buku.Show
   
End Sub

Private Sub f3_Click()
    End
   
End Sub

Form buku :

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 tablebuku(kode,judul,pengarang)" & _
                "values('" & Kode.Text & _
                "','" & Judul.Text & _
                "','" & Pengarang.Text & "')"
       
        Case 1
            SQL = "UPDATE tablebuku SET judul='" & Judul.Text & "'," & _
                "pengarang='" & Pengarang.Text & "' " & _
                "where kode='" & Kode.Text & "'"
               
         Case 2
                SQL = "DELETE FORM tablebuku WHERE kode='" & Kode.Text & "' "
       End Select
       MsgBox "Pemrosesan RECORD Database telah berhasil...:)!", vbInformation, "Data buku"
       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 tablebuku (kode,judul,pengarang)" & _
                    "values('" & Kode.Text & _
                    "','" & Judul.Text & _
                    "','" & Pengarang.Text & "')"
                WS.SendData "INSERT- " & SQL
           
            Else
                SQL = "UPDATE tablebuku set " & _
                    "judul='" & Judul.Text & _
                    "',pengarang='" & Pengarang.Text & _
                    "' where kode='" & Kode.Text & "'"
                WS.SendData "UPDATE-" & SQL
               
            End If
           
        Case 2
            x = MsgBox("Yakin RECORD tablebuku akan Dihapus..:(!", vbQuestion + vbYesNo, "tablebuku")
            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 = "192.168.10.1"
    IPClient = WS.LocalIP
    WS.Connect IPServer, 1500
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"
            Judul.SetFocus
           
        Case "RECORD"
            xData2 = Split(xData1(1), "/")
            Judul.Text = xData2(0)
            Pengarang.Text = xData2(1)
            Call RubahCMD(Me, False, True, True, True)
            Cmdproses(1).Caption = "&Edit"
            Kode.Enabled = False
            Judul.SetFocus
           
        Case "DEL"
            MsgBox "Penghapusan Data Berhasil !!!"
            Call hapus
           
        Case "EDIT"
            MsgBox "Pengeditan Record Berhasil !!!"
            Call hapus
           
        Case "INSERT"
            MsgBox "Penginsertan Berhasil !!!!"
            Call hapus
           
        End Select
End Sub

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