Followers

Diberdayakan oleh Blogger.
RSS

Cara Membuat Program Pegawai Melalui Server-Client

Cara Membuat Program Pegawai dengan Menggunakan Jaringan

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


 Dan tabel pemakai,seperti di bawah ini
 


  • Buka Visual Basic 6.0,
  • Desain FrmLogin seperti di bawah ini

 

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 programnya seperti di bawah ini

 

  • 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 seperti di bawa ini
  • ketikkan pada program
Private Sub Keluar_Click()
Unload Me
End Sub

Private Sub Pegawai_Click()
FrmPegawai.Show
End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

0 komentar:

Posting Komentar