Followers

Diberdayakan oleh Blogger.
RSS

Cara Membuat Program Pegawai dengan Menggunakan Jaringan

02.35 |


 Program Server
  • Buat database dengan nama database kepegawaian.mdb, dan tabel pegawai seperti di bawah ini

field
nip,nama,golongan,bagian

 Dan tabel pemakai,seperti di bawah ini

field
username,pass

  • Buka Visual Basic 6.0,
  • Desain FrmLogin 

Lalu ketik programnya :
Private Sub CmdKeluar_Click()
Unload Me
End Sub

Private Sub cmdsubmit_Click()
If username.Text = "isna" And pass.Text = "1234" Then
    Me.Hide
    menu.Show
Else
    MsgBox "Maaf! Username dan Password yang anda masukkan salah", vbInformation, "pemakai"
End If
End Sub

 ‘Pada properties,passwordchar ketik “*” agar passwordnya tidak terbaca

  • klik kanan project,pilih add-form
  • desain tampilannya


  • Ketikkan pada modul program
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= " & App.Path & _
"\kepegawaian.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

  • ketikkan pada program

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,golongan,jabatan,bagian)" & _
"values('" & nip.Text & _
"','" & nama.Text & _
"','" & golongan.Text & _
"','" & jabatan.Text & _
"','" & bagian.Text & "')"

Case 1
sql = "update pegawai set nama='" & nama.Text & "'," & _
"golongan= '" & golongan.Text & "'," & _
"jabatan= '" & jabatan.Text & "'," & _
"bagian= '" & bagian.Text & "'" & _
"where nip='" & nip.Text & "'"

Case 2
sql = "delete from pegawai where nip='" & nip.Text & "'"
End Select
 MsgBox "Pemrosesan 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
golongan.Text = rs!golongan
jabatan.Text = rs!jabatan
bagian.Text = rs!bagian

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!golongan & "/" & rs!jabatan & "/" & rs!bagian
            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 "DELETE"
            sql = " Delete * from pegawai " & _
                " where nip = '" & 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
    End Select
End Sub

  • buat menu 


  • ketikkan pada program
Private Sub Keluar_Click()
Unload Me
End Sub

Private Sub Pegawai_Click()
FrmPegawai.Show
End Sub


Program Client
  • Desain FrmLogin 



Lalu ketik programnya :
Private Sub CmdKeluar_Click()
Unload Me
End Sub

Private Sub cmdsubmit_Click()
If username.Text = "siska" And pass.Text = "1234" Then
    Me.Hide
    menu.Show
Else
    MsgBox "Maaf! Username dan Password yang anda masukkan salah", vbInformation, "pemakai"
End If
End Sub

 ‘Pada properties,passwordchar ketik “*” agar passwordnya tidak terbaca

  • klik kanan project,pilih add-form
  • desain tampilannya



  • Ketikkan pada modul
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 = ""
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

  • ketikkan pada program

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,golongan,jabatan, bagian)" & _
        "values('" & Nip.Text & _
        "','" & Nama.Text & _
        "','" & golongan.Text & _
        "','" & jabatan.Text & _
        "','" & bagian.Text & "')"
    Case 1
        SQL = "UPDATE barang Set nama='" & Nama.Text & "'," & _
            "Golongan='" & golongan.Text & "'," & _
            "Jabatan='" & jabatan.Text & "'," & _
            "Bagian='" & bagian.Text & "'," & _
            "where Nip='" & Nip.Text & "'"
    Case 2
        SQL = " DELETE * FROM barang WHERE Nip='" & Nip.Text & "'"
    End Select
    MsgBox "Pemrosesan RECORD Database telah berhasil....!", vbInformation, "Data pegawai"
    Call Hapus
    Nip.SetFocus
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 Nip_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If Nip.Text = "" Then Exit Sub
  WS.SendData "SEARCH-" & Nip.Text
End If
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,Golongan,Jabatan, Bagian)" & _
            "Nama='" & Nama.Text & _
            "',Golongan='" & golongan.Text & _
            "',Jabatan='" & jabatan.Text & _
            "',Bagian='" & bagian.Text & _
            "'Where Nip='" & Nip.Text & "'"
            WS.SendData "INSERT-" & SQL
Else
        SQL = "UPDATE pegawai set " & _
            "Nama='" & Nama.Text & _
            "',Golongan='" & golongan.Text & _
            "',Jabatan='" & jabatan.Text & _
            "',Bagian='" & bagian.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 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, "-")
xData2 = Split(xData1(1), "/")

Select Case xData1(0)
    Case "NOTHING"
        X = Nip.Text
        Call Hapus
        Nip.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)
        golongan.Text = xData2(1)
        jabatan.Text = xData2(2)
        bagian.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
    Case "INSERT"
        MsgBox "Penginputan Data Record Berhasil!"
        Call Hapus
    End Select
End Sub

  • buat tampilan menu


  • ketik pada program menunya
Private Sub Keluar_Click()
Unload Me
End Sub

Private Sub Pegawai_Click()
FrmPegawai.Show
End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS
Diposting oleh Isna Wirdayani

0 komentar:

Posting Komentar

Langganan: Posting Komentar (Atom)