Minggu, 29 Januari 2012

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





1 komentar: