Kuis Online

Nama : YUDO HARTANTO
NPM :0902339
Kelas : MI-S-0911

 Jawaban Soal Kuis Hari Jum'at no.2 dari kasus kuis online.,


FORM SERVER :

Listing Program SERVER :

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 Command1_Click()
Adodc1.Refresh
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 "INSERT"
        Case "EDIT"
        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
        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=F:\pak mes\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




FORM CLIENT :

Listing Program Client :




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 = "127.0.0.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
         SQL = "INSERT INTO Barang(Kode,Nama,Harga) " & _
        "values('" & kode.Text & _
        "','" & nama.Text & _
        "','" & harga.Text & "')"
        WS.SendData "INSERT-" & SQL
        Else
            SQL = "UPDATE Barang Set " & _
                "nama='" & nama.Text & _
                "',harga='" & harga.Text & _
                "' where kode = '" & kode.Text & "'"
            WS.SendData "UPDATE-" & SQL
        End If
        Call Hapus
        kode.SetFocus
    Case 2
        X = MsgBox("Yakin RECORD Barang Akan Dihapus.....!", vbQuestion + vbYesNo, "Barang")
        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 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, "-")
xData2 = Split(xData1(1), "/")

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 "INSERT"
        MsgBox "Penyimpanan Berhasil!"
        Call Hapus
    Case "DEL"
        MsgBox "Penghapusan Data Berhasil!"
        Call Hapus
    Case "EDIT"
        MsgBox "Pengeditan Record 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