listing program:
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
hasil program:
listing program:
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
hasil program:
Tidak ada komentar:
Posting Komentar