POSTINGAN JAWABAN NO 2 ( EFRIAWAN )


Untuk kasus Lihat Disini : Kasus…

Listing Program Server :

MODUL

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:\logOnOff\SERVER\belajarserver\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

FORM1

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, “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 di hapus…!”, 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 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 “masukan 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, adLockOptimistic
If RS.RecordCount <> 0 Then
WS.SendData “RECORD-” & RS!nama & “/” & RS!harga
Else
WS.SendData “NOTHING-DATA”
End If

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
WS.SendData “Edit-xxx”
Adodc1.Refresh
Case “INSERT”
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData “INSERT-xxx”
Adodc1.Refresh
End Select
End Sub

MDIFORM1

Private Sub data_barang_Click()
Form1.Show
End Sub

Private Sub exit_Click()
End
End Sub

Listing Program Client :

MODUL

Public sql As String

Sub clearform(f As Form)
Dim clt As Control
For Each clt In f
If TypeOf clt Is TextBox Then clt.Text = “”
If TypeOf clt Is ComboBox Then clt.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

FORM1

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”
Call Hapus
kode.SetFocus
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
sql = “INSERT INTO barang(kode,nama,harga)” & _
“values(‘” & kode.Text & _
“‘,'” & nama.Text & _
“‘,'” & harga.Text & “‘)”

WS.SendData “INSERT-” & sql
Else
sql = “UPDATE barang set ” & _
“nama='” & nama.Text & _
“‘,harga='” & harga.Text & _
“‘ where kode='” & kode.Text & “‘”
WS.SendData “UPDATE-” & sql
End If
Case 2
X = MsgBox(“Yakin Record Barang Akan Dihapus…..!!!”, vbQuestion + vbYesNo, “Barang”)
If X = vbYes Then
WS.SendData “DELETE-” & kode.Text
End If
Call Hapus
kode.SetFocus
Case 3
Call Hapus
kode.SetFocus
Case 4
Unload Me
End Select
End Sub

Private Sub kode_keypress(keyAscii As Integer)
If keyAscii = 13 Then
If kode.Text = “” Then Exit Sub
WS.SendData “SEARCH-” & kode.Text
End If
End Sub

Sub mulaikoneksi()
ipserver = “127.0.0.1”
ipclient = WS.LocalIP
WS.Connect ipserver, 1000
End Sub

Private Sub Form_Load()
Call Hapus
mulaikoneksi
End Sub

Private Sub form_Queryunload(cancel As Integer, unloadmode As Integer)
DoEvents
End
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 “NOTHING”
X = kode.Text
Call Hapus
kode.Text = X
Call RubahCMD(Me, False, True, False, True)
cmdProses(1).Caption = “&Simpan”
nama.SetFocus

Case “RECORD”
xdata2 = Split(xdata1(1), “/”)
nama.Text = xdata2(0)
harga.Text = xdata2(1)
Call RubahCMD(Me, False, True, True, True)
cmdProses(1).Caption = “&Edit”
kode.Enabled = False
nama.SetFocus

Case “DEL”
MsgBox “Penhapusan Data Berhasil…..!!!”
Call Hapus

Case “EDIT”
MsgBox “Pengeditan Record Berhasil…..!!!”
Call Hapus

Case “INSERT”
MsgBox “Penyimpanan Record Berhasil…..!!!”
Call Hapus
End Select
End Sub

Hasil/Tampilan Program :

Form Menu Data Barang

Form Data Barang Server

Form Data Barang Client

Download Program :
Klik Di Sini

Semoga Bermanfaat.

About efriawan

Qu dengan hidup ku, dan mereka dengan hidup merka sendiri . . . .

Posted on 29 Januari 2012, in Client Server, Quis, Visual Basic. Bookmark the permalink. Tinggalkan komentar.

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

%d blogger menyukai ini: