Mesaj Kutusu Hakkında

1 2
01/09/2018, 01:38

mehmetdemiral

O zaman metin kutusunun giriş maskesine tırnaklar olmadan "Password" yazın.
01/09/2018, 10:00

notrino

(01/09/2018, 01:38)mehmetdemiral yazdı: O zaman metin kutusunun giriş maskesine tırnaklar olmadan "Password" yazın.

Mehmet Bey,

Açılan kutu, bir mesaj kutusu. (İlk mesajda detaylar var) Oradaki metin alanına girilen verinin **** şeklindeki görünümü söz konusuydu. Yani herhangi bir tabloda açılmış bir alanın, formdaki karşılığı olan metin kutusu değil bu. Dolayısıyla bahsettiğiniz şekilde giriş maskesi uygulayabileceğim bir alan değil burası. Yine de farklı ve basit bir öneriniz varsa tabiki önerilere açığım. Teşekkürler ilginize..
01/09/2018, 11:46

mehmetdemiral

Ozan'ın paylaştığı koddan daha basit bir kod yok bildiğim kadarıyla. Aşağıda benim kod arşivimden başka bir öneri yapayım size de, yukardakine razı gelirsiniz belki
Kod:
Bu modülü oluşturmak yeterli


'////////////////////////////////////////////////////////////////////

'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////
'API functions to be used

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

'Constants to be used in our API functions
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    'A window has been activated

       RetVal = GetClassName(wParam, strClassName, lngBuffer)

       If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox

           'This changes the edit control so that it display the password character *.
           'You can change the Asc("*") as you please.
           SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
       End If

   End If

   'This line will ensure that any other hooks that may be in place are
   'called correctly.
   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  'Hope someone can use it!

Public Function TEST()
Dim strAdminPWord As String
strAdminPWord = InputBoxDK("İşlem yapmanız için ŞİFRE girmelisiniz.", "ŞİFRE GİRİŞ UYARISI")


If strAdminPWord = "password" Then
   MsgBox "ŞİFRE doğru. ", vbOKOnly, "GEÇERLİ ŞİFRE GİRİŞİ"
   
Else
   MsgBox ("Hatalı ŞİFRE girdiniz!")
  ' Exit Sub
End If
End Function


kodun çalışması için de,ilgili formunuzun YÜKLENDİĞİNDE olay yordamına ya da bir buton denetiminde kullanılacaksa TIKLANDIĞINDA olay yordamına,

Call TEST

ifadesini yazmak gerekmektedir.kod içerisindeki "password" ifadesin yer alan password yerine hangi şifreyi vermek istiyorsanız o ifade ile değiştiriniz
1 2