Private Sub Komut0_Click()
    If BicimInputBox("Lütfen bir şifre girin", "Şifre gerekli") = 123456 Then
        MsgBox "Tamam"
    Else
        MsgBox "Tamam Değil"
    End If
End Sub

'**** PAROLA ***********
Option Compare Database
Option Explicit
' Tanım:
' Bu modül, gelişmiş bir Giriş Kutusu işlevi sağlamak üzere tasarlanmıştır.
' yıldız işaretiyle şifre girişi. oluşturmak için Windows API çağrılarından yararlanır.
' Bir Giriş Kutusunun aktivasyonunu engelleyen ve değiştiren kanca prosedürü
' bir şifre alanı gibi davranmak.
' BicimInputBox işlevi kullanıcıdan parola istemek için kullanılabilir
' ve kullanıcının girişini maskelenmiş bir dize olarak döndürür. Test alt yordamı şunları sağlar:
' Bu fonksiyonun nasıl çağrılacağına dair bir örnek.
' Sabit kodlanmış sınıf adı "#32770" Windows'taki iletişim kutularını tanımlamak için kullanılır,
' Giriş Kutusu dahil, böylece parola maskeleme karakteri ayarlanabilir.
' Kullanımı:
' Gerekli bilgi istemi ve isteğe bağlı başlıkla BicimInputBox işlevini çağırın
' Bir şifre Giriş Kutusu görüntülemek için. Döndürülen dizeyi kodunuzda gerektiği gibi kullanın.
 
#If VBA7 And Win64 Then
  ' Kanca bilgisini zincirdeki bir sonraki işleyiciye iletir
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    ' Belirtilen modül için bir tanıtıcı elde eder
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
   ' Mesajları izlemek için bir Windows kancası ayarlar
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    ' Windows kancasını çözer
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    ' Davranışını kontrol ederek bir diyalog öğesine bir mesaj gönderir
    Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
   ' Bir pencerenin sınıf adını alır
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
   ' Geçerli iş parçacığının tanımlayıcısını alır
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
    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 hhk 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
#End If
#If VBA7 And Win64 Then
    ' Kancayı yönetme kolu
    Private hHook As LongPtr
#Else
    Private hHook As Long
#End If
' Parola maskeleme karakterini ayarlama kodu
Private Const EM_SETPASSWORDCHAR As Long = &HCC
' Windows kancalarını ve mesajlarını işlemek için sabitler
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const HC_ACTION As Long = 0
' Amaç: Bir Giriş Kutusunun (veya iletişim kutusunun) etkinleştirilmesini engeller ve parola girişini yıldız işaretleriyle maskeleyecek şekilde değiştirir.
' Paramlar:
' - lngCode: Kanca kodunu belirtir
' - wParam: Pencerenin tanımlayıcısını belirtir
' - lParam: Mesajla ilgili ek bilgi (kanca koduna bağlıdır)
' Döndürür: Eğer lngCode HC_ACTION'dan küçükse zincirdeki bir sonraki kancanın döndürdüğü değer, aksi takdirde belirli bir değer döndürmez.
#If VBA7 And Win64 Then
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As LongPtr, ByVal lParam As Long) As LongPtr
#Else
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
    On Error GoTo Err_Handler
    Dim RetVal As Long                    ' GetClassName'in dönüş değerini tutar
    Dim lngBuffer As Long                ' Sınıf adını tutacak arabelleğin boyutu
    Dim strClassName As String      ' Sınıf adını almak için arabellek
   ' Kanca kodu HC_ACTION'dan küçükse sonraki kancayı çağırın
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
   ' Pencerenin sınıf adı için bir arabellek hazırlayın
    strClassName = String$(256, " ")
    lngBuffer = 255
   ' Kanca çağrısının pencere aktivasyonuna karşılık gelip gelmediğini kontrol edin
    If lngCode = HCBT_ACTIVATE Then
        ' Etkinleştirilen pencerenin sınıf adını alın
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        ' Sınıf adı bir iletişim kutusuna karşılık geliyorsa (sınıf adı "#32770" Windows'taki iletişim kutuları için standarttır),
        ' Parola maskeleme karakterini ayarlayın. Bu kontrol, Giriş Kutusu penceresinin tanımlanmasına yardımcı olur.
        If Left$(strClassName, RetVal) = "#32770" Then
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If
   ' Zincirdeki bir sonraki kancayı çağırarak işleme devam edin
    CallNextHookEx hHook, lngCode, wParam, lParam
Exit_Err_Handler:
    Exit Function
Err_Handler:
    MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf & "Procedure: NewProc", vbCritical + vbOKOnly, "NewProc - Error"
    Resume Exit_Err_Handler
End Function
' Amaç: Giriş Kutusu davranışını değiştirmek için bir Windows kancası kullanarak maskelenmiş parola girişi olan bir Giriş Kutusu görüntülemek.
' Paramlar:
' - İstem: Giriş Kutusunun içinde görünen metin dizesi istemi.
' - Başlık (İsteğe Bağlı): Giriş Kutusunun başlık çubuğunda görünen metin dizesi.
' Döndürür: Kullanıcının inputBox'tan maskelenmiş bir dize olarak girişi.
Public Function BicimInputBox(ByVal Prompt As String, Optional ByVal Title As String = vbNullString) As String
    On Error GoTo Err_Handler
    #If VBA7 And Win64 Then
        Dim lngModHwnd As LongPtr  ' Prosedürün bulunduğu modüle gidin
    #Else
        Dim lngModHwnd As Long     ' Prosedürün bulunduğu modüle gidin
    #End If
    Dim lngThreadID As Long         ' Geçerli iş parçacığının tanımlayıcısı
   ' Kanca prosedürünün kurulacağı mevcut iş parçacığı kimliğini alın
    lngThreadID = GetCurrentThreadId
    ' Bağlanacak prosedürü içeren modülün modül tanıtıcısını alın
    lngModHwnd = GetModuleHandle(vbNullString)
    ' Giriş Kutusunun kancasını NewProc işlevine işaret ederek ayarlayın
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
   ' Giriş kutusunu parola maskelemeyle yakalayarak belirtilen bilgi istemi ve başlıkla görüntüleyin
    BicimInputBox = InputBox(Prompt, Title)
   ' Girişi yakaladıktan sonra kancayı çıkarın, normal Giriş Kutusu davranışını geri yükleyin
    UnhookWindowsHookEx hHook
Exit_Err_Handler:
    Exit Function
Err_Handler:
    MsgBox "Hata Numumarası: " & Err.Number & vbCrLf & "Hata Açıklaması: " & Err.Description & vbCrLf & "Prosedür: InputBiçimi", vbCritical + vbOKOnly, "Biçimlendirilmiş Giriş Kutusu - Hata"
    Resume Exit_Err_Handler
End Function