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
Langganan:
Postingan (Atom)