Sternchen bei Passwort
Albert
ich verwende diesen ellenlangen Code zum Erzeugen von Sternchen bei Passwörtern.
Option Explicit
Private Declare Function SetTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wCmd 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 SendMessageBynum& Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
Private Const gcClassnameMSDialog = "#32770"
Private Const gcClassnameMSExcel = "XLMAIN"
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const GW_CHILD = 5&
Private Const GW_HWNDFIRST = 0&
Private Const GW_HWNDNEXT = 2&
Private strSearchCaption As String
Public Function fncPassword(strText As String, strCaption) As String
strSearchCaption = strCaption
Call prcSetTimer
fncPassword = InputBox(strText, strCaption)
End Function
Private Sub Passwordchar()
Dim lnghWnd As Long, lnghWnd1 As Long
Dim strClass As String
lnghWnd = FindWindow(gcClassnameMSDialog, strSearchCaption)
lnghWnd1 = GetWindow(lnghWnd, GW_CHILD)
Do
strClass = String(255, 0)
GetClassName lnghWnd1, strClass, 250
strClass = Left$(strClass, InStr(1, strClass, Chr(0)) - 1)
If LCase$(strClass) = "edit" Then SendMessageBynum lnghWnd1, _
EM_SETPASSWORDCHAR, 42, 0
lnghWnd1 = GetWindow(lnghWnd1, GW_HWNDNEXT)
Loop While lnghWnd1 0
End Sub
Private Sub prcSetTimer()
SetTimer FindWindow(gcClassnameMSExcel, vbNullString), 0, _
1000, AddressOf prcTimer
End Sub
Private Sub prcKillTimer()
KillTimer FindWindow(gcClassnameMSExcel, vbNullString), 0
End Sub
Private Sub prcTimer(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Call prcKillTimer
Call Passwordchar
End Sub
Mfg
Albert