Membuat Password

Membuat program aplikasi yang aman, tentunya kita membutuhkan password. disaat mengimput password di text tentunya kita tidak inginkan orang lain melihat password yang kita masukan. berikut ini saya uraikan bagaimana memasukan password dengan menampilkan tanda bintang (*).

Di dalam code dibawah ini di suatu form kita siapkan komponen dibawah ini:

1. Component Timer 2 Buah di form
2. Component Label2 untuk menampilkan timer
3. Component TextBox1
4. Component Command

Code Form1

Option Explicit
Dim ter As Booleana
Private Sub Command1_Click()
    ter = False
    DisableCtrlAltDelete (False)
    Unload Form1
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Timer1.Enabled = False
        Timer2.Enabled = True
        Text1.Enabled = True
    End If
End Sub
Private Sub Form_Load()
    DisableCtrlAltDelete (True)
    ter = True
End Sub
Private Sub Form_LostFocus()
    Form1.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
    If ter = True Then
        Cancel = 5
    Else
    End If
End Sub
Private Sub Timer1_Timer()
    Form1.SetFocus
    Label2.Caption = 5
End Sub
Private Sub Timer2_Timer()
    Label2.Caption = Val(Label2.Caption) - 1 & " Waktu untuk memasukan password."
    Text1.SetFocus
    If Text1.Text = "mouse" Then
        ter = False
        Timer2.Enabled = False
        Timer1.Enabled = False
        Label2.Caption = "5"
        MsgBox "Password diterima, prgram bisa ditutup sekarang."
        Text1.Enabled = False
        Command1.Enabled = True
    End If
    If Val(Label2.Caption) = 0 Then
        Timer1.Enabled = True
        Timer2.Enabled = False
        Text1.Text = ""
        Text1.Enabled = False
        Command1.Enabled = False
    End If
End Sub

Code Module

'Used for DisableCtrlAltDelete
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
'Used for ExitWindows
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
'Used for AlwaysOnTop
Const FLAGS = 3
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Public SetTop As Boolean
Private Declare Function SetWindowPos Lib "user32" (ByVal h%, ByVal hb%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
Sub ExitWindows(ExitMode As String)
 Select Case ExitMode
 Case Is = "shutdown"
     ter = ExitWindowsEx(EWX_SHUTDOWN, 0)
 Case Is = "reboot"
     ter = ExitWindowsEx(EWX_REBOOT Or EXW_FORCE, 0)
 Case Else
    MsgBox ("Error in ExitWindows call")
 End Select
 End Sub
Sub AlwaysOnTop(FormName As Form, bOnTop As Boolean)
'Set form selalu di atas
Dim Success As Integer
If bOnTop = False Then
    Success% = SetWindowPos(FormName.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
    Success% = SetWindowPos(FormName.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Sub
Sub Center(FormName As Form)
 'Center Forms...
 Move (Screen.Width - FormName.Width) \ 2, (Screen.Height - FormName.Height) \ 2
End Sub
Sub DisableCtrlAltDelete(bDisabled As Boolean)
    Dim X As Long
    X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
Sub OpenApp(File As String)
    X = Shell(File)
End Sub