Jawaban Soal No 3 (EMRIADI)

Listing Program Client

Dim ipserver As String

Dim xpakai As String

Dim xdata1() As String

Dim xdata2() As String

Dim xpesan As String

Dim xkirim As String

Dim user As String

Private Sub Command1_Click()

    WS.SendData "START-" & user & "-ILHAM REZEKI"

    ipserver = "127.0.0.1"

    ipclient = WS.LocalIP

    WS.Connect ipserver, 3000

End Sub

Private Sub Command2_Click()

    WS.SendData "STOP" & user

End Sub

Private Sub Form_Load()

    Me.Caption = "CLIENT IP: " & WS.LocalIP

    ipserver = "192.168.11.1"

    user = WS.LocalIP

    WS.Connect ipserver, 3000

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)

WS.GetData xkirim, vbString, bytestotal

Call checkdata

End Sub

Sub checkdata()

xdata1 = Split(xkirim, "-")

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

    Select Case xdata1(0)

    Case "PAKAI"

        pakai.Value = xdata2(0)

    End Select

End Sub

Listing Program Server

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

Jawaban Soal No 2 (EMRIADI)

MODULE PROGRAM 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=E:\belajar server part2\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 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

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 Cmdrefresh_Click()

Cmdrefresh.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 "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, adLockBatchOptimistic

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

    Case "UPDATE"

    Db.BeginTrans

    Db.Execute xdata1(1), adCmdTable

    Db.CommitTrans

    WS.SendData "EDIT-xxx"

    Adodc1.Refresh

    End Select

End Sub

HASIL PROGRAMNYA