soal no:2

SERVER

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=C:\Documents and Settings\Sony\My Documents\belajar server\test2.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

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

Sub hapus()

kode.Enabled = True

clearform Me

Call rubahcmd(Me, True, False, False, False)

cmdproses(1).Caption = " &Simpan"

End Sub

Private Sub Form_Load()

Call opendb

Call hapus

mulaiserver

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 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 = " delete * FROM barang " & _

    " where kode= '" & xData1(1) & "'"

    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

   End Select

End Sub

CLIENT

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=\\Sriwahyu-a562c3\vb2\vb\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

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

Sub hapus()

kode.Enabled = True

clearform Me

Call rubahcmd(Me, True, False, False, False)

cmdproses(1).Caption = " &Simpan"

End Sub

Private Sub Form_Load()

Call opendb

Call hapus

mulaiserver

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 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 = " delete * FROM barang " & _

    " where kode= '" & xData1(1) & "'"

    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

   End Select

End Sub

soal no:3(rafii arianto napitupulu)


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

WS.SendData "PAKAI-" & Pakai.Value & "/" & 3000

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 '

Timer1.Enabled = True

Timer2.Enabled = True

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)

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

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

BERIKUT ADALAH HASIL PROGRAM SERVER






   
   

   
   


   



LISTING PROGRAM CLIENT

Dim IPS As String

Dim user As String

Dim xpakai As String

Dim xkirim As String

Dim xData1() As String

Dim xData2() As String

Private Sub Form_Load()

IPS = "127.0.0.1"

user = ws.LocalIP

ws.Connect IPS, 3000

End Sub

Private Sub start_Click()

ws.SendData "START-" & user & "-SURYA NINGSIH"

End Sub

Private Sub stop_Click()

ws.SendData "STOP-" & user

End Sub

Private Sub Timer1_Timer()

mulai.Value = Format(Now, "HH:MM:SS")

Timer1.Enabled = True

End Sub

Private Sub Timer2_Timer()

pakai.Value = Format(Now, "HH:MM:SS")

Timer2.Enabled = True

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"

mulai.Value = xData2(0)

selesai.Value = xData2(1)

pakai.Value = xData2(2)

biaya.Text = (Val(Hour(pakai.Value) * 60) + Val(Minute(pakai.Value) * 50))

End Select

End Sub