Di bawah ini
listing programnya :
Sub hapus()
NRK.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 Pegawai(NRK,Nama_Pegawai,Alamat,Tempat_lahir,Tanggal_lahir,Agama,Jenis_Kelamin,Golongan)" & _
"values('" & NRK.Text & _
"','" & Nama_Pegawai.Text & _
"','" & Alamat.Text & _
"','" & Tempat_lahir.Text & _
"','" & Tanggal_lahir.Text & _
"','" & Agama.Text & _
"','" & Jenis_Kelamin.Text & _
"','" & Golongan.Text & "')"
Case 1
SQL = "UPDATE Pegawai set Nama_Pegawai='" & Nama_Pegawai.Text & "'," & _
"Alamat='" & Alamat.Text & "', " & _
"Tempat_lahir='" & Tempat_lahir.Text & "', " & _
"Tanggal_lahir='" & Tanggal_lahir.Text & "', " & _
"Agama='" & Agama.Text & "', " & _
"Jenis_Kelamin='" & Jenis_Kelamin.Text & "', " & _
"Golongan='" & Golongan.Text & "' " & _
"where NRK='" & NRK.Text & "'"
Case 2
SQL = "DELETE From Pegawai where NRK='" & NRK.Text & "'"
End Select
MsgBox "pemrosesan record database telah berhasil....!!", vbInformation, "Pegawai"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
NRK.SetFocus
End Sub
Sub tampilPegawai()
On Error Resume Next
NRK.Text = RS!NRK
Nama_Pegawai.Text = RS!Nama_Pegawai
Alamat.Text = RS!Alamat
Tempat_lahir.Text = RS!Tempat_lahir
Tanggal_lahir.Text = RS!Tanggal_lahir
Agama.Text = RS!Agama
Jenis_Kelamin.Text = RS!Jenis_Kelamin
Golongan.Text = RS!Golongan
End Sub
Private Sub cmdproses_click(Index As Integer)
Select Case Index
Case 0
Call hapus
NRK.SetFocus
Case 1
If cmdproses(1).Caption = "&Simpan" Then
Call prosesdb(0)
Else
Call prosesdb(1)
End If
Case 2
X = MsgBox("yakin record Pegawai akan di hapus...!", vbQuestion + vbYesNo, "Pegawai")
If X = vbYes Then prosesdb (2)
Call hapus
NRK.SetFocus
Case 3
Call hapus
NRK.SetFocus
Case 4
Unload Me
menu.Enabled = True
menu.SetFocus
End Select
End Sub
Private Sub Form_Load()
Call OPENDB
Call hapus
mulaiserver
End Sub
Private Sub NRK_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If NRK.Text = "" Then
MsgBox "masukan NRK Pegawai..!", vbInformation, "Pegawai"
NRK.SetFocus
Exit Sub
End If
SQL = "select*from Pegawai where NRK='" & NRK.Text & "'"
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
tampilPegawai
Call RubahCMD(Me, False, True, True, True)
cmdproses(1).Caption = "&Edit"
NRK.Enabled = False
Else
X = NRK.Text
Call hapus
NRK.Text = X
Call RubahCMD(Me, False, True, False, True)
cmdproses(1).Caption = "&Simpan"
End If
Nama_Pegawai.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 Pegawai where NRK='" & 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_Pegawai & "/" & RS!Alamat & "/" & RS!Tempat_lahir & "/" & RS!Tanggal_lahir & "/" & RS!Agama & "/" & RS!Jenis_Kelamin & "/" & RS!Golongan
Else
WS.SendData "NOTHING-DATA"
End If
Case "DELETE"
SQL = "DELETE * From Pegawai " & _
"where NRK='" & 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
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=E:\Pegawai\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
MENU UTAMA..
Private Sub mnuPegawai_Click()
frmmahasiswa.Show
End Sub
LISTING CLIENT
Sub Hapus()
NRK.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 tabel(NRK, Nama, alamat)" & _
"values('" & NRK.Text & _
"','" & nama.Text & _
"','" & alamat.Text & "')"
Case 1
SQL = "UPDATE tabel set Nama = '" & nama.Text & "'," & _
"alamat = '" & alamat.Text & "', " & _
"whereNRK = '" & NRK.Text & "'"
Case 2
SQL = "DELETE FROM tabel WHERENRK='" & NRK.Text & "'"
End Select
MsgBox "Pemrosesan Record Database telah berhasil...!", vbInformation, "Data tabel"
Call Hapus
NRK.SetFocus
End Sub
Private Sub cmdProses_Click(Index As Integer)
Select Case Index
Case 0
Call Hapus
NRK.SetFocus
Case 1
If cmdProses(1).Caption = "&Simpan" Then
SQL = "INSERT INTO tabel(NRK,nama,alamat,tempatlhr,tgllhr,agama,jeniskel,gol)" & _
"values('" & NRK.Text & _
"','" & nama.Text & _
"','" & alamat.Text & "')"
WS.SendData "INSERT-" & SQL
Else
SQL = "UPDATE tabel set " & _
"nama='" & nama.Text & _
"',alamat='" & alamat.Text & _
"' whereNRK='" & NRK.Text & "'"
WS.SendData "UPDATE-" & SQL
End If
Case 2
X = MsgBox("Yakin Record tabel Akan Dihapus.....!!!", vbQuestion + vbYesNo, "tabel")
If X = vbYes Then
WS.SendData "DELETE-" & NRK.Text
End If
Call Hapus
NRK.SetFocus
Case 3
Call Hapus
NRK.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub NRK_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
If NRK.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & NRK.Text
End If
End Sub
Sub mulaikoneksi()
ipserver = "192.168.10.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 = NRK.Text
Call Hapus
NRK.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)
alamat.Text = xdata2(1)
tempat_lahir.Text = xdata2(2)
tanggal_lahir.Text = xdata2(3)
agama.Text = xdata2(4)
jenis_kelamin.Text = xdata2(5)
golongan.Text = xdata2(6)
Call RubahCMD(Me, False, True, True, True)
cmdProses(1).Caption = "&Edit"
NRK.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
MODUL
Public Db As New ADODB.Connection
Public RS As New ADODB.Recordset
Public RS2 As New ADODB.Recordset
Public TCari As 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=\\Prive-394b938d6\andi & yudo\Server\belajarserver\Test.mdb;Persist Security Info=False"
End Sub
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 = ""
If TypeOf ctl Is MaskEdBox Then ctl.Mask = "##/##/####"
Next
End Sub
Sub center(f As Form)
f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4
End Sub
Public Sub Ketengah(ByVal Frm As Form)
Frm.Left = (menu.Width - Frm.Width) / 2
Frm.Top = (menu.Height - Frm.Height) / 2 - 500
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
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"
End Select
End Sub
MENU UTAMA
Private Sub mnupegawai_Click()
client.Show
End Sub
0 comments:
Post a Comment