Server

server

Listing Progam Server

Sub hapus()

NIK.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 Karyawan(NIK, Nama, Jabatan,Golongan,Bagian)" & _

                    "values('" & NIK.Text & _

                    "','" & NAMA.Text & _

                    "','" & JABATAN.Text & _

                    "','" & GOLONGAN.Text & _

                    "','" & BAGIAN.Text & "')"

    Case 1

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

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

        " golongan = '" & GOLONGAN.Text & "' " & _

        " Bagian = '" & BAGIAN.Text & "' " & _

        "where NIK ='" & NIK.Text & "'"

    Case 2

    SQL = "DELETE FROM karyawan WHERE NIK='" & NIK.Text & "'"

End Select

MsgBox "Pemorosesan record Database telah Berhasil...!", vbInformation, "Data karyawan"

Db.BeginTrans

Db.Execute SQL, adCmdTable

Db.CommitTrans

Call hapus

Adodc1.Refresh

NIK.SetFocus

End Sub

Sub tampilKaryawan()

On Error Resume Next

NIK.Text = Rs!NIK

NAMA.Text = Rs!NAMA

JABATAN.Text = Rs!JABATAN

GOLONGAN.Text = Rs!GOLONGAN

BAGIAN.Text = Rs!BAGIAN

End Sub

Private Sub CMDproses_click(index As Integer)

Select Case index

    Case 0

    Call hapus

    NIK.SetFocus

    Case 1

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

    Call ProsesDB(0)

        Else

        Call ProsesDB(1)

        End If

    Case 2

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

    If x = vbYes Then ProsesDB 2

    Call hapus

    NIK.SetFocus

    Case 3

    Call hapus

    NIK.SetFocus

    Case 5

    Adodc1.Refresh

    Case 4

    Unload Me

End Select

End Sub

Private Sub Command1_Click()

Adodc1.Refresh

End Sub

Private Sub form_load()

Call OPENDB

Call hapus

MulaiServer

   

    BAGIAN.AddItem "Kepala dinas"

    BAGIAN.AddItem "Sekretariat"

    JABATAN.AddItem "Struktural"

    JABATAN.AddItem "Fungsional"

    GOLONGAN.AddItem "4D"

    GOLONGAN.AddItem "3C"

End Sub

Private Sub NIK_keyPress(keyAscii As Integer)

    If keyAscii = 13 Then

        If NIK.Text = "" Then

        MsgBox "Masukkan NIK Jesmi!", vbInformation, "Jesmi"

        NIK.SetFocus

        If NIK.Text = "" Then

            MsgBox "NIK Harus 6 Digit!", vbInformation, "Jesmi"

            NIK.SetFocus

      End If

       

        Exit Sub

    End If

    SQL = "SELECT * FROM Karyawan WHERE NIK='" & NIK.Text & "'"

    If Rs.State = adStateOpen Then Rs.Close

    Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic

    If Rs.RecordCount <> 0 Then

        tampilKaryawan

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

        CmdProses(1).Caption = "&Edit"

        NIK.Enabled = False

    Else

        x = NIK.Text

        Call hapus

        NIK.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

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, vdString, bytesTotal

xData1 = Split(xKirim, "-")

    Select Case xData1(0)

        Case "SEARCH"

            SQL = "SELECT*FROM karyawan WHERE NIK='" & 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!JABATAN

            Else

                WS.SendData "NOTHING-xxx"

            End If

    Case "INSERT"

            Db.BeginTrans

            Db.Execute xData1(1), adCmdTable

            Db.CommitTrans

            WS.SendData "INSERT-xxx"

            Adodc1.Refresh

    Case "UPDATE"

            Db.BeginTrans

            Db.Execute xData1(1), adCmdTable

            Db.CommitTrans

            WS.SendData "EDIT-xxx"

            Adodc1.Refresh

    Case "DELETE"

            SQL = "Delete * from Karyawan " & _

    "where NIK='" & xData1(1) & "'"

    Db.BeginTrans

    Db.Execute SQL, adCmdTable

    Db.CommitTrans

    Adodc1.Refresh

    WS.SendData "DEL-xxx"

        End Select

End Sub

Modul Server

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:\Jesmi\dbKaryawan.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

Listing Program Login

' password version 1.0

' created by: Mr. Jake Rodriguez Pomperada, MAED-IT

' date : March 30, 2009 Monday

' tool : Visual Basic 6.0

' email : jakerpomperada@yahoo.com

' location : purok pag-asa, barangay alijis 6100 bacolod city, negros

'            occidental philippines

Option Explicit

Dim WrongLogin As Integer

Dim rs As ADODB.Recordset

Private Sub Command1_Click()

On Error GoTo errhandler

   

    If WrongLogin = 2 Then

        Call MsgBox("kamu sudah 3 kali gagal. silahkan keluar!!!", vbOKOnly, "Sorry")

        End

    End If

   

    WrongLogin = WrongLogin + 1

    Form1.txt_try.Text = Str(WrongLogin)

   

    If UCase(txtUserName.Text) = "" Or IsNull(txtUserName.Text) = True Then

        Call MsgBox("Nama Harus di isi.", horas, "Nama")

        txtUserName.SetFocus

        Exit Sub

    End If

    If UCase(txtPassword.Text) = "" Or IsNull(txtPassword.Text) = True Then

        Call MsgBox("Password Harus di isi.", budidarma, "Password")

        txtPassword.SetFocus

        Exit Sub

    End If

   

    Open_cn

   

    Set rs = New ADODB.Recordset

    rs.Open ("Select * from Login Where UserName= '" & UCase(txtUserName.Text) & "'"), cn, adOpenStatic, adLockOptimistic, _

        adCmdText

   

  

        If UCase(txtPassword.Text) <> rs.Fields("password") Then

            Call MsgBox("Incorrect Password", vbOKOnly, "Login Error")

            txtPassword.Text = ""

            txtPassword.SetFocus

            Exit Sub

        Else

            'Correct!

            UserName = UCase(txtUserName.Text) 'May need in the future project

            MsgBox ("Correct Login.  This is where you open another form and close this one.")

            'This is where you open a new form and close frmLogin

            'Example:

           

            'frmMain.show

            'unload me

        End If

    Close_cn

    Exit Sub

errhandler:

    Call MsgBox("Incorrect Username", vbOKOnly, "Login Error")

    txtUserName.Text = ""

    txtPassword.Text = ""

    txtUserName.SetFocus

    Exit Sub

   

   

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

Form1.Show

Form1.txtUserName.SetFocus

WrongLogin = 0

End Sub

Private Sub Txtusername_KeyPress(KeyAscii As Integer)

   If KeyAscii = 13 Then

   Form1.txtPassword.SetFocus

   End If

End Sub

Private Sub Txtpassword_KeyPress(KeyAscii As Integer)

 If KeyAscii = 13 Then

   Form1.Command1.SetFocus

   End If

End Sub

Modul

Option Explicit

Public UserName As String

Public DatabasePath As String

Public cn As ADODB.Connection

Public Sub Open_cn()

        Set cn = New ADODB.Connection

        cn.CursorLocation = adUseClient

        cn.Provider = "Microsoft.Jet.OLEDB.4.0"

        cn.Properties("Data Source") = App.Path & "\login.mdb"

        cn.Open

End Sub

Public Sub Close_cn()

   

     cn.Close

     Set cn = Nothing

   

End Sub

Listing Program Client

Dim IPServer As String

Sub Hapus()

    NIK.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 karyawan(NIK,Nama,Golongan,Jabatan,Bagian)" & _

                "values('" & NIK.Text & _

                "','" & Nama.Text & _

                "','" & Gol.Text & _

                "','" & Bagian.Text & _

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

        Case 1

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

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

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

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

                "where NIK='" & NIK.Text & "'"

        Case 2

            SQL = "DELETE FROM Karyawan WHERE NIK='" & NIK.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 Karyawan(Nip,Nama,Gol,Jeniskelamin,Jabatan)" & _

        "values('" & NIK.Text & _

        "','" & Nama.Text & _

        "','" & Gol.Text & _

        "','" & Bagian.Text & _

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

        WS.SendData "INSERT-" & SQL

        

    Else

        SQL = "UPDATE karyawan set " & _

            "nama= '" & Nama.Text & _

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

            "' where NIK='" & NIK.Text & "'"

        WS.SendData "UPDATE-" & SQL

       

    End If

    Case 2

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

        If x = vbYes Then

        WS.SendData "DELETE-" & NIK.Text

       

        End If

        Call Hapus

        NIK.SetFocus

    Case 3

        Call Hapus

        NIK.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 = NIK.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)

    Bagian.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