Jawaban no 2 (vivi sri afrianty.simatupang)

Form 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:\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 Program:
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 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 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 "INSERT"
       
        Case "EDIT"
       
        Case "DELETE"
       
    End Select
End Sub

Form Client:

Listing Modul :


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 :

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

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 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 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 = vbYesNo 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 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 "Penghapusan Data Berhasil!"
        Call Hapus
    Case "EDIT"
        MsgBox "Pengeditan Record Berhasil!"
        Call Hapus
    End Select
End Sub

Tugas Program Client

TABEL FROM LOGIN

Listing Program:

Private Sub Masuk_Click()

If username.Text = "vidi" And pass.Text = "444444" Then

    Me.Hide

    MDIForm1.Show

Else

    MsgBox "Maaf Kata Sandi yang Anda Masukkan Salah!", vbInformation, "pemakai"

End If

End Sub

TABEL FORM MAHASISWA

Listing Program:

Dim IPServer As String

Sub hapus()

nama.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('" & nama.Text & _

"','" & alamat.Text & _

"','" & jeniskelamin.Text & _

"','" & tempatlahir.Text & _

"','" & tanggallahir.Text & _

"','" & agama.Text & _

"','" & asalsekolah.Text & _

"','" & notelepon.Text & "')"

Case 1

SQL = "UPDATE nama SET alamat='" & alamat.Text & "'," & _

"jeniskelamin='" & jeniskelamin.Text & "' " & _

"tempatlahir='" & tempatlahir.Text & "' " & _

"tanggallahir='" & tanggallahir.Text & "' " & _

"agama='" & agama.Text & "' " & _

"asalsekolah='" & asalsekolah.Text & "' " & _

"notelepon='" & notelepon.Text & "' " & _

"where nama='" & nama.Text & "'"

Case 2

SQL = "DELETE FROM nama WHERE nama='" & nama.Text & "'"

End Select

MsgBox "pemrosesan RECORD database telah berhasil...!", vbInformation, "nama"

Call hapus

nama.SetFocus

End Sub

Private Sub cmdproses_Click(Index As Integer)

Select Case Index

Case 0

Call hapus

nama.SetFocus

Case 1

If cmdproses(1).Caption = " &Simpan" Then

SQL = "INSERT INTO nama(nama,alamat,jeniskelamin,tempatlahir,tanggallahir,agama,asalsekolah,notelepon)" & _

"values('" & nama.Text & _

"','" & alamat.Text & _

"','" & jeniskelamin.Text & _

"','" & tempatlahir.Text & _

"','" & tanggallahir.Text & _

"','" & agama.Text & _

"','" & asalsekolah.Text & _

"','" & notelepon.Text & "')"

ws.SendData "UPDATE-" & SQL

Else

SQL = "UPDATE nama SET alamat = '" & alamat.Text & "'," & _

"' , jeniskelamin = '" & jeniskelamin.Text & _

"' , tempatlahir= '" & tempatlahir.Text & _

"' , tenggallahir= '" & tanggallahir.Text & _

"' , agama= '" & agama.Text & _

"' , asalsekolah= '" & asalsekolah.Text & _

"' , notelepon= '" & notelepon.Text & _

"' where nama= '" & nama.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-" & nama.Text

End If

Call hapus

nama.SetFocus

Case 3

Call hapus

nama.SetFocus

Case 4

Unload Me

End Select

End Sub

Private Sub Form_Load()

Call hapus

mulaikoneksi

End Sub

Private Sub nama_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If nama.Text = "" Then Exit Sub

ws.SendData "SEARCH-" & nama.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 = nama.Text

 Call hapus

 nama.Text = X

 Call rubahCMD(Me, False, True, False, True)

 cmdproses(1).Caption = "&Simpan"

 alamat.SetFocus

 Case "RECORD"

 xdata2 = Split(xdata1(1), "/")

 alamat.Text = xdata2(0)

 jeniskelamin.Text = xdata2(1)

 tempatlahir.Text = xdata2(2)

 tanggallahir.Text = xdata2(3)

 Call rubahCMD(Me, False, True, True, True)

 cmdproses(1).Caption = "&Edit"

 nama.Enabled = False

 alamat.SetFocus

 Case "DEL"

 MsgBox "penghapusan data berhasil!"

 Call hapus

 Case "EDIT"

 MsgBox "Pengeditan Record berhasil!"

 Call hapus

 End Select

End Sub

TABEL FORM MENU:

Listing Program:

Private Sub Keluar_Click()

Unload Me

End Sub

Private Sub Mahasiswa_Click()

frmmahasiswa.Show

End Sub

MODUL:

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

_Hal yang paling di benci

• Menunggu dan tidak suka dibohongin.

_Keinginan saya

Ingin membuat kedua orang tua saya bangga pada saya.Karena insyaallah sebentar lagi saya mau menyusun skripsi.Mudah-mudahan semuanya diberi kemudahan jalannya oleh allah dan saya mampu menghadapinya sampai wisuda tiba.Karena itu bagian terpenting buat saya dalam menjalani hidup saya kedepannya.Semua itu buat ayah,ibu dan orang-orang yang menyayangi saya,karena mereka adalah motivasi terbesar dalam hidup saya.Terutama ibu saya,karena doa dari orang tua kita adalah kunci sukses kita dalam menjalani hidup ini. 

_Cinta

Cinta pada orang tua,sahabat,kekasih.Buat saya banyak cara kita menunjukkan rasa cinta pada orang-orang yang kita sayangi.salah satunya untuk tidak mengkhianati mereka."Jagalah hati agar tidak menyakiti.Jika ia sudah melukai,alangkah susah untuk baik kembali.Sesungguhnya,jika hati tidak memiliki rasa cinta,ia laksana kaca pecah yang sulit diperbaiki".Jadilah motivasi untuk cinta yang kita miliki,Sedih,senang,kecewa,sakit hati,itu biasa dalam cinta.Jadi belajarlah dari kegagalan-kegagalan yang kita alami,karena itu membuat kita menjadi pribadi yang lebih dewasa.

_Hobby Saya

• Saya sangat menyukai olah raga,terutama olah raga bola voli.Walaupun saya tidak pintar tapi saya bisa dan pernah masuk di Club Tovo bola voli di medan.Saya pernah mengikuti beberapa pertandingan.Dan sampai sekarang voli adalah salah satu aktifitas saya.Buat saya olah raga voli sudah menjadi bagian dalam hidup saya.Selain itu olah raga juga sangat baik buat kesehatan kita.

"Tentang Saya"

       Saya Vivi sri afrianty simatupang,cewek kelahiran Medan 28 April 1988.Saya mahasiswa di salah satu perguruan tinggi swasta di medan tepatnya di STMIK BUDI DARMA.Saya mengambil D3 jurusan Manajemen Informatika dan sekarang saya sudah semester lima.Tinggi besar adalah ciri fisik saya.Kata orang saya ramah dan penuh perhatian.Walaupun saya anak tunggal tapi ke dua orang tua saya tidak pernah memanjakan saya.Mereka selalu mengajarkan saya tentang banyak hal,terutama dalam menjalani hidup saya ke depannya.Jadi buat saya keluarga adalah harta yang paling berharga dalam hidup saya karena keluarga dan orang yang menyayangi saya adalah motivasi saya dalam kuliah maupun kehidupan saya.