Access - Finestra inserimento password

All'interno di un database di Access è comodo poter bloccare certe sezioni del database tramite password.

Per fare questo occorre creare un modulo in Visual Basic con all'interno queste righe di codice:

	Option Compare Database
	Option Explicit
	'////////////////////////////////////////////////////////////////////
	'Password masked inputbox
	'Allows you to hide characters entered in a VBA Inputbox.
	'
	'Code written by Daniel Klann
	'March 2003
	'////////////////////////////////////////////////////////////////////
	'Tradotto in italiano da Davide
	'https://davidetech.blogspot.com/
	'////////////////////////////////////////////////////////////////////
	'Funzioni API da utilizzare
	Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
	ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
	Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
	Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
	(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
	ByVal dwThreadId As Long) As Long
	Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
	Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
	(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
	ByVal wParam As Long, ByVal lParam As Long) As Long
	Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
	ByVal lpClassName As String, _
	ByVal nMaxCount As Long) As Long
	Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
	'Costanti da utilizzare nelle funzioni API
	Private Const EM_SETPASSWORDCHAR = &HCC
	Private Const WH_CBT = 5
	Private Const HCBT_ACTIVATE = 5
	Private Const HC_ACTION = 0
	Private hHook As Long
	Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
	Dim RetVal
	Dim strClassName As String, lngBuffer As Long
	If lngCode < HC_ACTION Then
	NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
	Exit Function
	End If
	strClassName = String$(256, " ")
	lngBuffer = 255
	If lngCode = HCBT_ACTIVATE Then 'Una finestra è stata attivata
	RetVal = GetClassName(wParam, strClassName, lngBuffer)
	If Left$(strClassName, RetVal) = "#32770" Then 'Nome della classe dell'Inputbox
	'Questo permette di modificare il testo in modo che visualizzi il carattere della password *.
	'si può cambiare carattere ("*") come preferisci.
	SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
	End If
	End If
	'Questa linea assicurerà che tutti gli altri ganci che possono essere in posizione siano
	'chiamati correttamente
	CallNextHookEx hHook, lngCode, wParam, lParam
	End Function
	Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
	Optional YPos, Optional HelpFile, Optional Context) As String
	Dim lngModHwnd As Long, lngThreadID As Long
	lngThreadID = GetCurrentThreadId
	lngModHwnd = GetModuleHandle(vbNullString)
	hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
	InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
	UnhookWindowsHookEx hHook
	End Function

view raw module_password.bas hosted with ❤ by GitHub

Poi occorre preparare l'interfaccia grafica in questo modo:
Creare una maschera principale che chiameremo Mascehra 1
Creare all'interno della Maschera 1 un pulsante

Creare una maschera secondaria che ciameremo Maschera 2, contenente i dati che vogliamo proteggere da password

All'interno della Maschera 1 cliccare sul pulsante e nella finestra delle proprietà cliccare sulla scheda Evento, cliccare poi sulla voce Su clic e selezionare Routine Evento.
Verrà aperto Visual Basic in modo da inserire il codice da associare al pulsante quando clicchiamo su di esso (Su clic).
Quindi inserire queste righe di codice all'interno della funzione nomepulsante_Click()

	Dim strAdminPWord As String
	Dim string1 As String
	Dim string2 As String
	Dim result
	Richiesta:
	strAdminPWord = InputBoxDK("Per accedere, inserisci la password dell'utente Amministratore", "Richiesta Password")
	string1 = strAdminPWord
	string2 = "miapassword" 'inserire la propria password
	result = StrComp(string1, string2, 0)
	If result = 0 Then
	DoCmd.OpenForm "Maschera 2", acNormal, "", "", , acNormal 'Al posto di Maschera 2 inserire il nome della propria
	'maschera da aprire dopo aver inserito la password
	ElseIf strAdminPWord = "" Or IsNull(strAdminPWord) = True Then
	Exit Sub
	'Visualizzazione di una finestra se è stata inserita una password non valida
	ElseIf MsgBox("Password non valida" & Chr(13) & Chr(10) & "Riprova!", vbCritical + vbYesNo, "Errore Password") = vbYes Then
	GoTo Richiesta
	Else
	Exit Sub
	End If

view raw Click_password.vba hosted with ❤ by GitHub

Ecco il risultato:


Download Project