CARA MEMBUAT PROGRAM BUKU DENGAN MENGGUNAKAN PROGRAM JARINGAN

Program Server

* Buat database dengan nama database dbbuku.mdb
* Buat tabel buku seperti di bawah ini
field : kdbuku, judul, pengarang, penerbit, tahun, edisi, harga, jumlah
* Dan tabel login, seperti di bawah ini
field : user, password
* Buka Visual Basic 6.0,
* Desain Formbuku, Login, MDIForm1


*Listing program pada Login :

Private Sub masuk_Click()
If user.Text = "manda" And password.Text = "1234" Then
MDIForm1.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "Silahkan masukkan password login", vbCritical, "info"
user.SetFocus
Else
MsgBox "password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub

Private Sub keluar_Click()
Unload Me
End Sub

Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub


*Listing tampilan menu (MDIForm1) :

Private Sub keluar_Click()
Unload Me
End Sub

Private Sub buku_Click()
Formbuku.Show
End Sub


*Listing pada modul program :

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=" & App.Path & _ "\dbbuku.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 pada Formbuku :

Sub hapus()
kdbuku.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 buku(kdbuku,judul,pengarang,penerbit,tahun,edisi,harga,jumlah)" & _
        "values('" & kdbuku.Text & _
        "','" & judul.Text & _
        "','" & pengarang.Text & _
        "','" & penerbit.Text & _
        "','" & tahun.Text & _
        "','" & edisi.Text & _
        "','" & harga.Text & _
        "','" & jumlah.Text & "')"
    Case 1
        SQL = "UPDATE buku SET judul='" & judul.Text & "'," & _
            "pengarang='" & pengarang.Text & "'" & _
            "penerbit='" & penerbit.Text & "'" & _
            "tahun='" & tahun.Text & "'" & _
            "edisi='" & edisi.Text & "'" & _
            "harga='" & harga.Text & "'" & _
            "jumlah='" & jumlah.Text & "'" & _
            "WHERE kdbuku='" & kdbuku.Text & "'"
    Case 2
        SQL = "DELETE  FROM buku WHERE kdbuku='" & kdbuku.Text & "'"
    End Select
   
MsgBox "Pemrosesan record Database telah berhasil....!!", vbInformation, "dbbuku"
    db.BeginTrans
    db.Execute SQL, adCmdTable
    db.CommitTrans
    Adodc1.Refresh
    Call hapus
    Adodc1.Refresh
    kdbuku.SetFocus

End Sub

Sub tampilbuku()
    On Error Resume Next
    kdbuku.Text = rs!kdbuku
    judul.Text = rs!judul
    pengarang.Text = rs!pengarang
    penerbit.Text = rs!penerbit
    tahun.Text = rs!tahun
    edisi.Text = rs!edisi
    harga.Text = rs!harga
    jumlah.Text = rs!jumlah
   
End Sub

Private Sub cmdproses_Click(Index As Integer)
Select Case Index
    Case 0
        Call hapus
        kdbuku.SetFocus
    Case 1
        If cmdproses(1).Caption = "&Simpan" Then
            Call prosesDB(0)
        Else
            Call prosesDB(1)
        End If
    Case 2
        X = MsgBox("yakin RECORD buku akan dihapus...!", vbQuestion + vbYesNo, "buku")
        If X = vbYes Then prosesDB 2
        Call hapus
        kdbuku.SetFocus
    Case 3
        Call hapus
        kdbuku.SetFocus
    Case 4
    Unload Me
End Select
       
End Sub

Private Sub Form_Load()
Call opendb
Call hapus
mulaiserver
End Sub

Private Sub kdbuku_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If kdbuku.Text = "" Then
        MsgBox "Masukkan kode buku!", vbInformation, "buku"
        kdbuku.SetFocus
        Exit Sub
End If
SQL = "SELECT * FROM buku WHERE kdbuku='" & kdbuku.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"
    kdbuku.Enabled = False

    Else
        X = kdbuku.Text
        Call hapus
        kdbuku.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 = 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 buku WHERE kdbuku='" & 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 & "/" & rs!penerbit & "/" & rs!tahun & "/" & rs!edisi & "/" & rs!harga & "/" & rs!jumlah
    Else
        ws.SendData "NOTHING-DATA"
    End If
   
    Case "INSERT"
    db.BeginTrans
    db.Execute xData1(1), adCmdTable
    db.CommitTrans
    Adodc1.Refresh
    ws.SendData "INSERT-XXX"

    Case "EDIT"
    db.BeginTrans
    db.Execute xData1(1), adCmdTable
    db.CommitTrans
    Adodc1.Refresh
    ws.SendData "EDIT-XXX"

    Case "DELETE"
    SQL = "DELETE * FROM buku WHERE kdbuku='" & xData1(1) & "'"
    db.BeginTrans
    db.Execute SQL, adCmdTable
    db.CommitTrans
    Adodc1.Refresh
    ws.SendData "DEL-XXX"

    End Select
End Sub


Program Client


*Listing program pada Login :

Private Sub masuk_Click()
If user.Text = "siska" And password.Text = "1234" Then
MDIForm1.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "Silahkan masukkan password login", vbCritical, "info"
user.SetFocus
Else
MsgBox "password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub

Private Sub keluar_Click()
Unload Me
End Sub

Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub


*Listing pada modul program :

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


*Listing program pada Formbuku :

Dim IPServer As String
Sub hapus()
kdbuku.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 buku(kdbuku,judul,pengarang,penerbit,tahun,edisi,harga,jumlah)" & _
"values('" & kdbuku.Text & _
"','" & judul.Text & _
"','" & pengarang.Text & _
"','" & penerbit.Text & _
"','" & tahun.Text & _
"','" & edisi.Text & _
"','" & harga.Text & _
"','" & jumlah.Text & "')"
Case 1
SQL = "UPDATE buku SET judul='" & judul.Text & "'," & _
"pengarang='" & pengarang.Text & "' " & _
"penerbit='" & penerbit.Text & "' " & _
"tahun='" & tahun.Text & "' " & _
"edisi='" & edisi.Text & "' " & _
"harga='" & harga.Text & "' " & _
"jumlah='" & jumlah.Text & "' " & _
"where kdbuku='" & kdbuku.Text & "'"
Case 2
SQL = "DELETE FROM buku WHERE kdbuku='" & kdbuku.Text & "'"
End Select
MsgBox "pemrosesan RECORD database telah berhasil...!", vbInformation, "dbbuku"
Call hapus
kdbuku.SetFocus
End Sub

Private Sub cmdproses_Click(Index As Integer)
Select Case Index
Case 0
Call hapus
kdbuku.SetFocus
Case 1
If cmdproses(1).Caption = " &Simpan" Then
SQL = "INSERT INTO buku(kdbuku,judul,pengarang,penerbit,tahun,edisi,harga,jumlah)" & _
"values('" & kdbuku.Text & _
"','" & judul.Text & _
"','" & pengarang.Text & _
"','" & penerbit.Text & _
"','" & tahun.Text & _
"','" & edisi.Text & _
"','" & harga.Text & _
"','" & jumlah.Text & "')"
ws.SendData "UPDATE-" & SQL
Else
SQL = "UPDATE buku SET judul = '" & judul.Text & "'," & _
"' , pengarang = '" & pengarang.Text & _
"' , penerbit= '" & penerbit.Text & _
"' , tahun= '" & tahun.Text & _
"' , edisi= '" & edisi.Text & _
"' , harga= '" & harga.Text & _
"' , jumlah= '" & jumlah.Text & _
"' where kdbuku= '" & kdbuku.Text & "'"
ws.SendData "UPDATE-" & SQL
End If
Case 2
X = MsgBox("yakin RECORD buku akan dihapus...!", vbQuestion + vbYesNo, "buku")
If X = vbYes Then
ws.SendData "DELETE-" & kdbuku.Text
End If
Call hapus
kdbuku.SetFocus
Case 3
Call hapus
kdbuku.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call hapus
mulaikoneksi
End Sub
Private Sub kdbuku_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If kdbuku.Text = "" Then Exit Sub
ws.SendData "SEARCH-" & kdbuku.Text
End If
End Sub
Sub mulaikoneksi()
IPServer = "192.168.10.1"
IPClient = ws.LocalIP
ws.Connect IPServer, 1000
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
Dim xdata3() As String
Dim xdata4() As String
ws.GetData xkirim, vbString, bytesTotal
xdata1 = Split(xkirim, "-")
 Select Case xdata1(0)
 Case "NOTHING"
 X = kdbuku.Text
 Call hapus
 kdbuku.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)
 penerbit.Text = xdata2(1)
 harga.Text = xdata2(2)
 jumlah.Text = xdata2(3)

 Call rubahCMD(Me, False, True, True, True)
 cmdproses(1).Caption = "&Edit"
 kdbuku.Enabled = False
 judul.SetFocus

 Case "DEL"
 MsgBox "penghapusan data berhasil!"
 Call hapus

 Case "EDIT"
 MsgBox "Pengeditan Record berhasil!"
 Call hapus
 End Select
End Sub


*Listing tampilan menu (MDIForm1) :

Private Sub keluar_Click()
Unload Me
End Sub

Private Sub buku_Click()
Formbuku.Show
End Sub