AW: Password Sternchen!
27.06.2005 11:21:57
Jan
Option Explicit
Private Declare Function GetVbaProjekt Lib "vba332.dll" Alias "EbGetExecutingProj" (hVBA As Long) As Long
Private Declare Function GetFunktionsnummerString Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hVBA As Long, ByVal strFuncNameUnicode As String, strFunktionsnummer As String) As Long
Private Declare Function GetFunktionsnummerLong Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hVBA As Long, ByVal strFunktionsnummer As String, hlngFunction As Long) As Long
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 GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch 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 EM_SETPASSWORDCHAR = &HCC
Private Const GW_CHILD = 5
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private hlngTimerKennung As Long
Private Function PasswortHolen(Beschriftung As String) As String
Call TimerSetzen
PasswortHolen = InputBox(Beschriftung)
End Function
Private Sub Passwortchar()
Dim hwnd&, hwnd1&, lngRück&, Klasse$
Dim Stil As Long
hwnd = FindWindow("#32770", "Microsoft Excel")
hwnd1 = GetWindow(hwnd, GW_CHILD)
Do
Klasse = String(255, 0)
lngRück = GetClassName(hwnd1, Klasse, 250)
Klasse = Left$(Klasse, InStr(1, Klasse, _
Chr(0)) - 1)
If LCase(Klasse) = "edit" Then
SendMessageBynum hwnd1, _
EM_SETPASSWORDCHAR, 42, 0
End If
hwnd1 = GetWindow(hwnd1, GW_HWNDNEXT)
Loop While hwnd1 <> 0
End Sub
Private Sub TimerSetzen()
hlngTimerKennung = SetTimer(0, 0, 1000, AddressOf ApiTimer1)
If hlngTimerKennung = 0 Then MsgBox _
"Fehler beim Initialisieren des Timers"
End Sub
Private Sub TimerZerstören()
If hlngTimerKennung <> 0 Then KillTimer 0, hlngTimerKennung
End Sub
Private Sub ApiTimer1(ByVal hwndOwner&, _
ByVal lngWindowMessage&, ByVal hlngRückTimerKennung&, ByVal lngTickCount&)
TimerZerstören
Passwortchar
End Sub
Private Function GetFuncAdress&(strFunktion$)
Dim hVBA&, lngRück&, strFunktionsnummer$
Dim hlngFunction&, strFuncNameUnicode$
strFuncNameUnicode = StrConv(strFunktion, vbUnicode)
GetVbaProjekt hVBA
If hVBA <> 0 Then
lngRück = GetFunktionsnummerString(hVBA, strFuncNameUnicode, strFunktionsnummer)
If lngRück = 0 Then
lngRück = GetFunktionsnummerLong(hVBA, strFunktionsnummer, hlngFunction)
If lngRück = 0 Then GetFuncAdress = hlngFunction
End If
End If
End Function
Sub mach_es()
[a1] = PasswortHolen("Geben Sie das Passwort ein...")
End Sub
mfg Jan