Form Login Dan Form Ganti Password

Password Tiga Kali Kesempatan

To the point....! Sebelum Anda membuat Form Login, Anda harus membuat database dan memiliki tabel kasir terlebih dahulu.

      
Program ini merupakan salah satu bentuk pengamanan data dengan kesempatan akses
yang dibatasi, jika user salah mengetik nama dan password tiga kali maka program akan
berakhir. Buatlah form seperti gambar berikut ini.

Listing Program

'definisikan string koneksi
    Dim conn As New ADODB.Connection
'definisikan recordset
    Dim RSKasir As ADODB.Recordset
    Dim A As Byte
    Dim B As Byte
   
Private Sub Koneksi()
'buat koneksi baruke database
    Set conn = New ADODB.Connection
'buat recordset baru untuk membaca tabel barang
    Set RSKasir = New ADODB.Recordset
'buka koneksi database dengan model DSN
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ App.Path & "\Master.mdb;Persist Security Info=False"
End Sub

Private Sub Form_Activate()
Text2.Enabled = False
End Sub
Private Sub Text1_KeyPress(Keyascii As Integer)
Keyascii = Asc(UCase(Chr(Keyascii)))
If Keyascii = 27 Then Unload Me
If Keyascii = 13 Then

    Call Koneksi
    RSKasir.Open "select * from kasir where namaksr='" & Text1 & "'", conn
    If RSKasir.EOF Then
        A = A + 1
        If 1 - A = 0 Then
            MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _
            "Nama '" & Text1 & "' tidak dikenal"
            Text1.Text = ""
            Text1.SetFocus
        ElseIf 2 - A = 0 Then
            MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _
            "Nama '" & Text1 & "' tidak dikenal"
            Text1.Text = ""
            Text1.SetFocus
        ElseIf 3 - A = 0 Then
            MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & "NamaKsr '" & _
            Text1 & "' tidak dikenal" & Chr(13) & "Kesempatan habis, Ulangi dari awal"
        End
    End If
Else
    Text1.Enabled = False
    Text2.Enabled = True
    Text2.SetFocus
End If
End If
End Sub
Private Sub Text2_KeyPress(Keyascii As Integer)
Keyascii = Asc(UCase(Chr(Keyascii)))
If Keyascii = 27 Then Unload Me
If Keyascii = 13 Then
    Call Koneksi
    RSKasir.Open "select * from kasir where namaksr='" & Text1 & "' and passwordksr='" & Text2 & "'", conn
    If RSKasir.EOF Then
    B = B + 1
    If 1 - B = 0 Then
        MsgBox "Kesempatan ke " & B & " Salah"
        Text2.Text = ""
        Text2.SetFocus
    ElseIf 2 - B = 0 Then
        MsgBox "Kesempatan ke " & B & " Salah"
        Text2.Text = ""
        Text2.SetFocus
    ElseIf 3 - B = 0 Then
        MsgBox "Kesempatan ke " & B & " Salah"
    End
End If
Else
   Text2.Enabled = False
    'TxtKode = RSKasir!PasswordKsr
   Me.Visible = False
   X = MsgBox("SELAMAT..! ANDA BERHASIL", vbYesNo, "Informasi")
   Unload Me
'Berhasil.Text1 = TxtNamaKsr
'Berhasil.Text2 = TxtPassword
'Berhasil.Text3 = TxtKode
End If
End If
End Sub

Program Ganti Password User

Listing Program

'definisikan string koneksi
    Dim conn As New ADODB.Connection
'definisikan recordset
    Dim RSKasir As ADODB.Recordset

Private Sub Koneksi()
'buat koneksi baruke database
    Set conn = New ADODB.Connection
'buat recordset baru untuk membaca tabel barang
    Set RSKasir = New ADODB.Recordset
'buka koneksi database dengan model DSN
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Master.mdb;Persist Security Info=False"
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call Koneksi
    RSKasir.Open "select * from kasir where namaksr='" & Text1 & "'", conn
    If Not RSKasir.EOF Then
        Text2.SetFocus
    Else
        MsgBox "nama kasir tidak terdaftar"
        Text1.SetFocus
        Text1 = ""
    End If
Else
    KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call Koneksi
    RSKasir.Open "select * from kasir where namaksr='" & Text1 & "' and passwordksr='" & Text2 & "'", conn
    If Not RSKasir.EOF Then
        Text3.SetFocus
    Else
        MsgBox "password salah "
        Text2.SetFocus
        Text2 = ""
    End If
Else
    KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Text3 = "" Then
        MsgBox "password baru belum dibuat"
        Text3.SetFocus
    Else
        Text4.SetFocus
    End If
Else
    KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Text4 <> Text3 Then
        MsgBox "password konfirmasi tidak sama"
        Text4.SetFocus
        Text4 = ""
    Else
        Pesan = MsgBox("yakin password akan diganti", vbYesNo)
        If Pesan = vbYes Then
            Dim editpwd As String
            editpwd = "update kasir set passwordksr='" & Text4 & "'where namaksr='" & Text1 & "' and passwordksr='" & Text2 & "'"
            conn.Execute editpwd
            Unload Me
        Else
            Unload Me
        End If
    End If
Else
    KeyAscii = Asc(UCase(Chr(KeyAscii)))
End If
End Sub

Untuk Download File pdf  Form Login Klik Disini
Untuk Download File pdf  Form Ganti Password Klik Disini

Sumber : konsultasivb.com