Listing Progaram 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.", vbOKOnly, "Nama")

        txtUserName.SetFocus

        Exit Sub

    End If

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

        Call MsgBox("Password Harus di isi.", vbOKOnly, "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

 

Option Explicit

Public UserName As String

Public DatabasePath As String

Public cn As ADODB.Connection

 Module Login

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

Module Client

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

Listing Program Client

Dim IPServer As String

Sub hapus()

NIDN.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 Dosen(NIDN, Nama, Tempat,Tanggal,Pendidikan,Bagian,Status)" & _

                    "values('" & NIDN.Text & _

                    "','" & NAMA.Text & _

                    "','" & TEMPAT.Text & _

                    "','" & TANGGAL.Text & _

                    "','" & PENDIDIKAN.Text & _

                    "','" & BAGIAN.Text & _

                    "','" & STATUS.Text & "')"

    Case 1

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

        " Tempat = '" & TEMPAT.Text & "' " & _

        " Tanggal = '" & TANGGAL.Text & "' " & _

        " Pendidikan = '" & PENDIDIKAN.Text & "' " & _

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

        " Status = '" & STATUS.Text & "' " & _

        "where NIDN ='" & NIDN.Text & "'"

Case 2

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

        If x = vbYes Then

        WS.SendData "DELETE-" & Kode.Text

       

        End If

        Call hapus

        Kode.SetFocus

    Case 3

        Call hapus

        Kode.SetFocus

    Case 4

        Unload Me

    End Select

End Sub

Sub tampilDosen()

On Error Resume Next

NIDN.Text = Rs!NIDN

NAMA.Text = Rs!NAMA

TEMPAT.Text = Rs!TEMPAT

TANGGAL.Text = Rs!TANGGAL

PENDIDIKAN.Text = Rs!PENDIDIKAN

BAGIAN.Text = Rs!BAGIAN

STATUS.Text = Rs!STATUS

End Sub

Private Sub CMDproses_click(index As Integer)

Select Case index

    Case 0

    Call hapus

    NIDN.SetFocus

    Case 1

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

    Call ProsesDB(0)

        Else

        Call ProsesDB(1)

        End If

    Case 2

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

    If x = vbYes Then ProsesDB 2

    Call hapus

    NIDN.SetFocus

    Case 3

    Call hapus

    NIDN.SetFocus

    Case 5

    Adodc1.Refresh

    Case 4

    Unload Me

End Select

End Sub

Private Sub form_load()

Call hapus

MulaiKoneksi

    BAGIAN.AddItem "HRD"

    BAGIAN.AddItem "Humas"

    BAGIAN.AddItem "Keuangan"

   

    PENDIDIKAN.AddItem "Diploma III"

    PENDIDIKAN.AddItem "Strata I"

    PENDIDIKAN.AddItem "Strata II"

   

    STATUS.AddItem "Menikah"

    STATUS.AddItem "Belum MENIKAH"

End Sub

Private Sub NIDN_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If NIDN.Text = "" Then Exit Sub

WS.SendData "SEARCH-" & NIDN.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 = NIDN.Text

Call hapus

NIDN.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)

TEMPAT.Text = xData2(1)

TANGGAL.Text = xData2(2)

PENDIDIKAN.Text = xData2(3)

BAGIAN.Text = xData2(4)

STATUS.Text = xData2(5)

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

CmdProses(1).Caption = "&Edit"

NIDN.Enabled = False

NAMA.SetFocus

Case "DEL"

MsgBox "penghapusan data berhasil !"

Call hapus

Case "EDIT"

MsgBox "pengeditan record berhasil !"

Call hapus

End Select

End Sub

Microsoft acsess dbDosen