InputBox da şifrenin **** şeklinde yazması?

[kadirdaylight]

Arkadaşlar InpuBox ekli olan bi dosyam var ve buraya şifre yazarken şifrenin **** şekilnde görülmesini istiyorum kodlarına ulaşamadım acaba InputBox a böle bi müsahale edmiyormuyuz?

 

[Korhan Ayhan]

Selamlar,

Ekteki dosyayı incelermisiniz. Çalışma Sn. Ivan F. Moala 'ya aittir.

ŞİFRE = 12345

Not: Eklediğim linkteki dosyalar silindiği için dosya bu mesaja eklenmiştir.

 

[kadirdaylight]

Sonuç bulunamadı diyor

 

[Korhan Ayhan]

Selamlar,

Linki yeniledim incelermisiniz.

 

[kadirdaylight]

Çok teşekkür ederim..

 

[parametre]

Üzgünüz, sonuç bulunamadı. Lütfen tekrar deneyiniz. diyor link neden aceba

 

[hamitcan]

Aşağıdaki kodu inceleyin.

Option Explicit

''/////////////////////////////////////////////////////////////////
''//  25 May 2003 //
''// Amended Ivan F Moala
''/////////////////////////////////////////////////////////////////

Public Declare Function GetActiveWindow _
    Lib "user32" () _
As Long

Public Declare Function FindWindowEx _
    Lib "user32" _
        Alias "FindWindowExA" ( _
            ByVal hWnd1 As Long, _
            ByVal hWnd2 As Long, _
            ByVal lpsz1 As String, _
            ByVal lpsz2 As String) _
As Long

Public Declare Function SendMessage _
    Lib "user32" _
        Alias "SendMessageA" ( _
            ByVal hwnd As Long, _
            ByVal wMsg As Long, _
            ByVal wParam As Long, _
            lParam As Any) _
As Long

Public Declare Function SetTimer _
    Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nIDEvent As Long, _
        ByVal uElapse As Long, _
        ByVal lpTimerFunc As Long) _
As Long

Public Declare Function KillTimer _
    Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal nIDEvent As Long) _
As Long

Public Declare Function GetForegroundWindow _
    Lib "user32" () _
As Long


Private Const nIDE As Long = &H100
Private Const EM_SETPASSWORDCHAR = &HCC

Private hdlEditBox As Long
Private Fgrndhdl As Long

Public Function TimerFunc( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal nEvent As Long, _
    ByVal nSecs As Long) As Long
  
    Dim hdlwndAct As Long
    
    '// Do we have a handle to the EditBox
    If hdlEditBox > 0 Then Exit Function
  
    '// Get the handle to the ActiveWindow
    hdlwndAct = GetActiveWindow()
  
    '// Get the Editbox handle
    hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
  
    '// Set the password character for the InputBox
    SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0

End Function

Public Function InPutBoxPwd(fPrompt As String, _
    Optional fTitle As String, _
    Optional fDefault As String, _
    Optional fXpos As Long, _
    Optional fYpos As Long, _
    Optional fHelpfile As String, _
    Optional fContext As Long) As String
    
    Dim sInput As String
    
    '// Initialize
    hdlEditBox = 0
    Fgrndhdl = GetForegroundWindow
    '// Windows-Timer
    SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc
    
    '// Main InputBox
    If fXpos Then
        sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos, fHelpfile, fContext)
    Else
        sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)
    End If
    
    '// Kill the correct Timer
    KillTimer Fgrndhdl, nIDE
    '// Pass result
    InPutBoxPwd = sInput
    
End Function

'////////////////////////////////////////////////////
'// This is The main routine
'// where we test it
'////////////////////////////////////////////////////

Sub GetPassWord()
Dim x As String

x = InPutBoxPwd("Please enter password", "Sentry")
If x = vbNullString Then
    MsgBox "User Cancelled"
Else
    MsgBox "User entered " & x
End If

End Sub

 

[Korhan Ayhan]

Selamlar,

Örnek dosya #2 nolu mesaja eklenmiştir. İncelermisiniz.

 

[Civan Jack]

Şifrenin yanlış olduğunu söylüyor Korhan bey

 

[Korhan Ayhan]

Selamlar,

Hatalı dosyayı eklemişim. Dosyayı yeniledim. İncelermisiniz.

 

[Civan Jack]

Tamam Korhan bey, teşekkürler...
Yalnız inputbox ı auto_open yapabilir miyiz ?
Açılışta çıkabilir mi acaba ?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu örnek dosyanın "ThisWorkbook" bölümüne uygulayın. Dosyayı kaydedin. Kapatıp tekrar açın.

Option Explicit
 
Private Sub Workbook_Open()
    Dim ŞİFRE As Variant
    
    ŞİFRE = InputBoxDK("Lütfen şifrenizi giriniz.", "ŞİFRE-PAROLA")
    If ŞİFRE = "" Then End
    If ŞİFRE <> "12345" Then
        MsgBox "Hatalı şifre girişi!" & vbCrLf & "Dosya kapatılacaktır.", vbCritical, "Dikkat !"
        If Excel.Application.Windows.Count = 1 Then
        Application.Quit
        Else
        ThisWorkbook.Close
        End If
    Exit Sub
    End If
    
    MsgBox "Tebrikler!" & vbCrLf & "Girdiğiniz şifre doğru.", vbInformation
End Sub

 

[Civan Jack]

ŞİFRE = InputBoxDK("Lütfen şifrenizi giriniz.", "ŞİFRE-PAROLA")
Bu DK ne oluyor Korhan bey, onu silince çalıştı...

 

[Civan Jack]

Dosya açıldığında excel görünmemesi için değiştirdim.
Şimdi Şifre doğru girildiğinde excel açılıyor...

Option Explicit
 
Private Sub Workbook_Open()
    [COLOR="Red"]Application.Visible = False[/COLOR]
    
    Dim ŞİFRE As Variant
    
    ŞİFRE = InputBox("Lütfen şifrenizi giriniz.", "ŞİFRE-PAROLA")
    If ŞİFRE = "" Then End
    If ŞİFRE <> "1234" Then
        MsgBox "Hatalı şifre girişi!" & vbCrLf & "Dosya kapatılacaktır.", vbCritical, "Dikkat !"
        If Excel.Application.Windows.Count = 1 Then
        Application.Quit
        Else
        ThisWorkbook.Close
        End If
    Exit Sub
    End If
    
    MsgBox "Tebrikler!" & vbCrLf & "Girdiğiniz şifre doğru.", vbInformation
[COLOR="#ff0000"]    Application.Visible = True[/COLOR]
End Sub

 

[Korhan Ayhan]

Selamlar,

"DK" ile kişi özel bir Inputbox oluşturmuştur. Siz değer girdiğinizde girilen karakterler "*" yıldız şeklinde görünmektedir.

 

[Civan Jack]

Hmmm yalnız, kodu o şekilde yazdığımda DK yi gösteren bir hata çıkıyor ama..

 

[Korhan Ayhan]

Selamlar,

Eklemiş olduğum örnek dosyaya #12 nolu mesajda verdiğim kodu eklerseniz dosya açılışında çıkan kutucuğa yazdığınız karakterler "*" şeklinde maskelenerek görünecektir.

Eğer kodda geçen "DK" ibaresini silip dosyayı kaydedip kapatıp tekrar açarsanız girdiğiniz karakterlerin maskelenmediğini görürsünüz.

Burada amaç "InputBox" nesnesine girilen karakterleri API kullanarak "*" karakteri ile maskelemek.

 

[Civan Jack]

Korhan bey, evet dediğiniz doğru DK yi silip, kaydedip tekrar açtığığmda şifre maskelenmemiş oluyor.
Fakat, #12. mesajdaki kodları kopyalayıp ThisWorkBook kod sayfasına aynen yapıştırıyorum ve maalesef aşağıdaki hatayı veriyor ..

 

[Korhan Ayhan]

Selamlar,

#2 nolu mesajımdaki modül içindeki kodun tamamınıda kendi dosyanıza aktarmalısınız. Aksi halde hata mesajı alırsınız.

 

[Civan Jack]

Onu unutmuşum Korhan bey.
Denedim bir sorun yok. Sizi de yordum akşam akşam.
Çok teşekkürler.