QUIS Hal.9 Program Server(yuhaeny.blogspot)

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, "data barang"
    db.BeginTrans
    db.Execute sql, adCmdTable
    db.CommitTrans
    Adodc1.Refresh
    Call hapus
    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
    Case 5
        Adodc1.Refresh
    End Select
  
End Sub



Private Sub Form_Load()
    Call opendb
    Call hapus
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, adopendymic, 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, True, True)
            cmdproses(1).Caption = "&simpan"
        End If
        nama.SetFocus
    End If
  
End Sub


LISTING MODUL 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:\pertemuan X\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




Akan muncul seperti Di bawah ini.......

Jawaban QUIS No.3(yuhaeny.blogspot)

 Listingnya......

Dim ClientIndex As Byte
Dim cRequest As Integer
Dim cData As String
Dim i As Integer
Dim iGD As Integer

Sub MulaiServer()
        WS(0).LocalPort = 3000
        WS(0).Listen
        cRequest = 1
        ClientIndex = 1
End Sub

Private Sub Form_Load()
        MulaiServer
        GD.Rows = 41
        For i = 1 To 40
            GD.Col = 0
            GD.Row = i
            GD.Text = i
        Next i
        iGD = 1
End Sub



Private Sub Timer1_Timer()
    For i = 1 To GD.Rows - 1
        GD.Row = i
        GD.Col = 4
        If GD.Text = "START" Then
            GD.Col = 3
            GD.Text = Time
        End If
    Next i
End Sub

Private Sub WS_ConnectionRequest(index As Integer, ByVal requestID As Long)
        Load WS(cRequest)
        WS(cRequest).Close
        WS(cRequest).Accept requestID
        cRequest = cRequest + 1 '
End Sub

Private Sub WS_DataArrival(index As Integer, ByVal bytesTotal As Long)
        WS(index).GetData cData, vbString, bytesTotal
        Call CekData(index)
      
End Sub

Sub CekData(index)
    On Error Resume Next
        Dim kata() As String
        kata = Split(cData, "-")
        Select Case kata(0)
        Case "START"
                        GD.Row = iGD
                        GD.Col = 1
                        GD.Text = kata(1) 'WS(index).RemoteHostIP
                        GD.Col = 2
                        GD.Text = Time
                        GD.Col = 4
                        GD.Text = "START"
                        GD.Col = 5
                        GD.Text = kata(2)
                        iGD = iGD + 1
        Case "STOP"
            For i = 1 To GD.Rows - 1
                GD.Row = i
                GD.Col = 1
                If GD.Text = kata(1) Then
                    GD.Col = 4
                    GD.Text = "STOP"
                End If
            Next i
        End Select
End Sub
      
Private Sub WS_Error(index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
        WS(index).Close
End Sub

Dan akan muncul seperti di bawah ini.......