Sabtu, 28 Januari 2012
JAWABAN NO 2 (FERA YUNITA)

SERVER



MOULE

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

BERIKUT INI ADALAH FORM SERVER




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


BERIKUT INI ADALAH HASIL TAMPILAN SERVER


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=C:\Documents and Settings\Administrator\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

BERIKUT INI ADALAH FORM CLIENT

LISTING PROGRAM CLIENT

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

BERIKUT INI ADALAH FORM CLIENT
JAWABAN NO 2 (FERA YUNITA)

 

Tidak ada komentar:

Posting Komentar

 
;