Masda_cEmOeT: DATA PEGAWAI SERVER - CLIENT DENGAN PROGRAM VB

1. INPUT SERVER

1. DATABASE M.ACCESS

Sebelum kita merancang program DataPegawai terlebih dahulu buat dulu databasenya dari M.access seperti dibawah ini :

2. INPUT SERVER DATA PEGAWAI

Setelah databasenya selesai, rancang Form vb seperti diabawah ini.

Listing program server

Sub Hapus()

Nip.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(Nip,Nama,Gol,jeniskel,jabatan)" & _

"values('" & Nip.Text & _

"','" & Nama.Text & _

"','" & Gol.Text & _

"','" & JenisKel.Text & _

"','" & Jabatan.Text & "')"

Case 1

SQL = "UPDATE Pegawai SET Nama='" & Nama.Text & "'," & _

"Gol='" & Gol.Text & "'," & _

"Jeniskel='" & JenisKel.Text & "'," & _

"Jabatan='" & Jabatan.Text & "' " & _

"where Nip='" & Nip.Text & "'"

Case 2

SQL = "DELETE FROM Pegawai WHERE Nip='" & Nip.Text & "'"

End Select

MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Data Pegawai"

DB.BeginTrans

DB.Execute SQL, adCmdTable

DB.CommitTrans

Call Hapus

Adodc1.Refresh

Nip.SetFocus

End Sub

Sub TampilPegawai()

On Error Resume Next

Nip.Text = RS!Nip

Nama.Text = RS!Nama

Gol.Text = RS!Gol

JenisKel.Text = RS!JenisKel

Jabatan.Text = RS!Jabatan

End Sub

Private Sub CmdProses_Click(Index As Integer)

Select Case Index

Case 0

Call Hapus

Nip.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 Dihapus...!", vbQuestion + vbYesNo, "Pegawai")

If x = vbYes Then ProsesDB 2

Call Hapus

Nip.SetFocus

Case 3

Call Hapus

Nip.SetFocus

Case 4

Unload Me

End Select

End Sub

Private Sub Form_Load()

Call OPENDB

Call Hapus

MulaiServer

End Sub

Private Sub Nip_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If Nip.Text = "" Then

MsgBox "Masukkan Nip Pegawai...!", vbInformation, "Pegawai"

Nip.SetFocus

Exit Sub

End If

SQL = "SELECT * FROM Pegawai WHERE Nip='" & Nip.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"

Nip.Enabled = False

Else

x = Nip.Text

Call Hapus

Nip.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 Pegawai WHERE Nip='" & 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!Gol & "/" & RS!JnsKelamin & "/" & RS!Jabatan

Else

ws.SendData "NOTHING-DATA"

End If

Case "INSERT"

DB.BeginTrans

DB.Execute xData1(1), adCmdTable

DB.CommitTrans

ws.SendData "INSERT-xxx"

Adodc1.Refresh

Case "EDIT"

DB.BeginTrans

DB.Execute xData1(1), adCmdTable

DB.CommitTrans

ws.SendData "EDIT-xxx"

Adodc1.Refresh

Case "DELETE"

SQL = "DELETE FROM Pegawai" & -"where Nip='" & xData1(1) & "'"

DB.Execute SQL, adCmdTable

ws.SendData "DEL-SUKSES"

End Select

End Sub

DATABASES LOGIN

Setelah programnnya selesai, buatlah form login nya, namun sebelum itu buatlah terlebih dahulu databases nya dengan M.ACCESS SEPERTI DIBAWAH :

3. FORM LOGIN

Setelah database dibuat, rancang form login nya seperti ini :

LISTING PROGRAM LOGIN

Dim i As Byte

Private Sub CommandOK_Click()

Select Case Index

Case 0

PanggilMENU

Case 1

End

End Select

End Sub

Private Sub Form_Load()

NamaUser.Text = ""

PasswordUser.Text = ""

i = 1

End Sub

Sub PanggilMENU()

If NamaUser.Text = "MASDAULI" And PasswordUser.Text = "DAMANIK" Then

MsgBox "Semoga sukses..." & vbCrLf & _

"DATA PEGAWAI MAS_TI" & vbCrLf & _

"" & vbCrLf & _

"PEGAWAI YANG MASIH AKTIP", vbInformation + vbOKOnly, "Passsword"

Unload Me

Form_menu.Show

Else

If i > 2 Then

MsgBox "Maaf...!" & vbCrLf & _

"Anda tidak berhak menggunakan program ini !", vbInformation + vbOKOnly, "Password"

End

Else

MsgBox "Maaf...!" & vbCrLf & _

"Password anda SALAH", vbInformation + vbOKOnly, "Password"

End If

NamaUser.Text = ""

PasswordUser.Text = ""

NamaUser.SetFocus

i = i + 1

End If

End Sub

Private Sub NamaUser_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If NamaUser.Text = "" Then Exit Sub

PasswordUser.SetFocus

End If

End Sub

Private Sub PasswordUser_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If PasswordUser.Text = "" Then Exit Sub

CommandOK.SetFocus

End If

End Sub

4. FORM MENU SERVER

kemudian setelah itu buat form menu

LISTING PROGRAM MENU

Private Sub F1_Click()

FormPegawai.Show

End Sub

Private Sub mnc_Click()

End

End Sub

MODULE DATA PEGAWAI

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:\MASDA\db1.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 = ""

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

2.INPUT CLIENT

1. FORM PEGAWAI

Project Form Pegawai

Dim IPServer As String

Sub Hapus()

Nip.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(Nip,Nama,Jeniskelamin,Jabatan)" & _

"values('" & Nip.Text & _

"','" & Nama.Text & _

"','" & Gol.Text & _

"','" & Jeniskelamin.Text & _

"','" & Jabatan.Text & "')"

Case 1

SQL = "UPDATE Pegawai SET Nama='" & Nama.Text & "'," & _

"Gol= '" & Gol.Text & "'," & _

"Jeniskelamin= '" & Jeniskelamin.Text & "'," & _

"Jabatan= '" & Jabatan.Text & "'," & _

"where Nip='" & Nip.Text & "'"

Case 2

SQL = "DELETE FROM Pewagai WHERE Nip='" & Nip.Text & "'"

End Select

MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Pegawai"

Call Hapus

Nip.SetFocus

End Sub

Private Sub CmdProses_Click(Index As Integer)

Select Case Index

Case 0

Call Hapus

Nip.SetFocus

Case 1

If CmdProses(1).Caption = "&Simpan" Then

SQL = "INSERT INTO Pegawai(Nip,Nama,Gol,Jeniskelamin,Jabatan)" & _

"values('" & Nip.Text & _

"','" & Nama.Text & _

"','" & Gol.Text & _

"','" & Jeniskelamin.Text & _

"','" & Jabatan.Text & "')"

WS.SendData "INSERT-" & SQL

Else

SQL = "UPDATE pegawai set " & _

"nama= '" & Nama.Text & _

"',jabatan='" & Jabatan.Text & _

"' where Nip='" & Nip.Text & "'"

WS.SendData "UPDATE-" & SQL

End If

Case 2

x = MsgBox("Yakin RECORD Pegawai Akan Dihapus...!", vbQuestion + vbYesNo, "Pegawai")

If x = vbYes Then

WS.SendData "DELETE-" & Nip.Text

End If

Call Hapus

Nip.SetFocus

Case 3

Call Hapus

Nip.SetFocus

Case 4

Unload Me

End Select

End Sub

Private Sub Form_Load()

Call Hapus

MulaiKoneksi

End Sub

Private Sub Kode_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If Nip.Text = "" Then Exit Sub

WS.SendData "SEARCH-" & Nip.Text

End If

End Sub

Sub MulaiKoneksi()

IPServer = "192.168.10.1"

IPClient = WS.LocalIP

WS.Connect IPServer, 1000

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 xkrim 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 = Nip.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)

Gol.Text = xData2(1)

Jeniskelamin.Text = xData2(2)

Jabatan.Text = xData2(3)

Call RubahCMD(Me, False, True, True, True)

CmdProses(1).Caption = "&Edit"

Nip.Enabled = False

Nama.SetFocus

Case "DEL"

MsgBox "penghapusan data berhasil !"

Call Hapus

Case "EDIT"

MsgBox "pengeditan record berhasil !"

Call Hapus

End Select

End Sub

2.FORM MENU

Project Form Menu Utama

Private Sub F1_Click()

Form1.Show

End Sub

Private Sub C_Click()

End

End Sub

Private Sub Form_Activate()

Text1 = Time

Text2 = Date

End Sub

3. Module

Public SQL As String

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 = ""

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

OUTPUT

Setelah di f5 maka program akan jalan, kemudian isikan username and password yg sudah anda buat sebelumnya.
jika password yang anda masukkan salah maka akan muncul " perintah password anda salah", dan sebaliknya jika benar akan tampil seperti dibawah ini.

lalu klik OK

maka akan tampil menu seperti ini

klik data pegawai maka akan muncul tampilan seperti ini, kemudian isikan NIP yg anda inginkan untuk memastikan apakah fungsi Command nya dah jalan, lalu enter, jika berhasil maka akan muncul tampilan "Pemrosesan record Database telah berhasil".
lalu klik OK.