I'm trying to find a method to identify a Open File Dialog and send a message to the "file name" field. Afterwards it needs to send an "Enter" key or "Open" command to the button.
I'm doing this in VB, but I'm sure I can cope if someone can help in C# as well.
I've been digging through the API this entire day and came up with a couple of possibilities but I am unfamiliar with how to implement this in DotNet4.
I used to work with API in VB6 but it seems like things are a bit different now.
If someone could provide me with a small example I'd be grateful.
Some of the API I've looked at is FindWindow and FindWindowEx.
Edit:
I found some code that is worth looking at. This code needs to be used inside a module.
I will post more as I find more answers.
Imports System.Runtime.InteropServices
Imports System.Text
Module modEnumWindows
Private windowList As New ArrayList
Private errMessage As String
Public Delegate Function MyDelegateCallBack(ByVal hwnd As Integer, ByVal lParam As Integer) As Boolean
Declare Function EnumWindows Lib "user32" (ByVal x As MyDelegateCallBack, ByVal y As Integer) As Integer
Declare Auto Function GetClassName Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal lpClassName As System.Text.StringBuilder, _
ByVal nMaxCount As Integer) As Integer
Declare Auto Function GetWindowText Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal lpClassName As System.Text.StringBuilder, _
ByVal nMaxCount As Integer) As Integer
Private Function EnumWindowProc(ByVal hwnd As Integer, ByVal lParam As Integer) As Boolean
'working vars
Dim sTitle As New StringBuilder(255)
Dim sClass As New StringBuilder(255)
Try
Call GetClassName(hwnd, sClass, 255)
Call GetWindowText(hwnd, sTitle, 255)
windowList.Add(sClass.ToString & ", " & hwnd & ", " & sTitle.ToString)
Catch ex As Exception
errMessage = ex.Message
EnumWindowProc = False
Exit Function
End Try
EnumWindowProc = True
End Function
Public Function getWindowList(ByRef wList As ArrayList, Optional ByVal errorMessage As String = "") As Boolean
windowList.Clear()
Try
Dim del As MyDelegateCallBack
del = New MyDelegateCallBack(AddressOf EnumWindowProc)
EnumWindows(del, 0)
getWindowList = True
Catch ex As Exception
getWindowList = False
errorMessage = errMessage
Exit Function
End Try
'wList.Clear()
wList = windowList
End Function
End Module
By using this you'll be able to identify the Window Text, HWND and Class. Hope this helps people a bit. The next step for me will be to identify the field I wish to send the data to.
Related
I've got an add-in that processes and then moves certain incoming emails. The only unfortunate consequence of this is that the "new mail envelope" on the taskbar:
remains lit when there isn't any mail for the user to look at.
There's a VBA solution to this issue here: http://www.outlookcode.com/d/code/clearenvicon.htm
It doesn't seem easily portable to VB though - after clearing up what were to me the obvious changes suggested I end up with:
Module RemoveNotification
' Code sample by Outlook MVP "Neo"
' Removes the New Mail icon from the Windows system tray,
' and resets Outlook's new mail notification engine.
' Tested against Outlook 2000 (IMO) and Outlook 2002 (POP Account)
' Send questions and comments to neo#mvps.org
' WARNING: Due to the use of AddressOf, code must
' go into a module and not ThisOutlookSession or
' a class module
' Entry Point is RemoveNewMailIcon.
Public Const WUM_RESETNOTIFICATION As Long = &H407
'Required Public constants, types & declares
'for the Shell_Notify API method
Public Const NIM_ADD As Long = &H0
Public Const NIM_MODIFY As Long = &H1
Public Const NIM_DELETE As Long = &H2
Public Const NIF_ICON As Long = &H2 'adding an ICON
Public Const NIF_TIP As Long = &H4 'adding a TIP
Public Const NIF_MESSAGE As Long = &H1 'want return messages
' Structure needed for Shell_Notify API
Structure NOTIFYICONDATA
Dim cbSize As Long
Dim hwnd As Long
Dim uID As Long
Dim uFlags As Long
Dim uCallbackMessage As Long
Dim hIcon As Long
Dim szTip As String * 64
End Structure
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long,
ByVal wParam As Integer, ByVal lParam As Any) As Long
Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long,
ByVal lpClassName As String,
ByVal nMaxCount As Long) As Long
Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" _
(ByVal hwnd As Long) As Long
Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long,
ByVal lpString As String,
ByVal cch As Long) As Long
Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long,
ByVal lParam As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long,
lpData As NOTIFYICONDATA) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
' This is the entry point that makes it happen
Sub RemoveNewMailIcon()
EnumWindows AddressOf EnumWindowProc, 0
End Sub
Public Function EnumWindowProc(ByVal hwnd As Long,
ByVal lParam As Long) As Long
'Do stuff here with hwnd
Dim sClass As String
Dim sIDType As String
Dim sTitle As String
Dim hResult As Long
sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
If sTitle = "rctrl_renwnd32" Then
hResult = KillNewMailIcon(hwnd)
End If
If hResult Then
EnumWindowProc = False
' Reset the new mail notification engine
Call SendMessage(hwnd, WUM_RESETNOTIFICATION, 0&, 0&)
Else
EnumWindowProc = True
End If
End Function
Private Function GetWindowIdentification(ByVal hwnd As Long,
sIDType As String,
sClass As String) As String
Dim nSize As Long
Dim sTitle As String
'get the size of the string required
'to hold the window title
nSize = GetWindowTextLength(hwnd)
'if the return is 0, there is no title
If nSize > 0 Then
sTitle = Space$(nSize + 1)
Call GetWindowText(hwnd, sTitle, nSize + 1)
sIDType = "title"
sClass = Space$(64)
Call GetClassName(hwnd, sClass, 64)
Else
'no title, so get the class name instead
sTitle = Space$(64)
Call GetClassName(hwnd, sTitle, 64)
sClass = sTitle
sIDType = "class"
End If
GetWindowIdentification = TrimNull(sTitle)
End Function
Private Function TrimNull(startstr As String) As String
Dim pos As Integer
pos = InStr(startstr, Chr$(0))
If pos Then
TrimNull = Left(startstr, pos - 1)
Exit Function
End If
'if this far, there was
'no Chr$(0), so return the string
TrimNull = startstr
End Function
Private Function KillNewMailIcon(ByVal hwnd As Long) As Boolean
Dim pShell_Notify As NOTIFYICONDATA
Dim hResult As Long
'setup the Shell_Notify structure
pShell_Notify.cbSize = Len(pShell_Notify)
pShell_Notify.hwnd = hwnd
pShell_Notify.uID = 0
' Remove it from the system tray and catch result
hResult = Shell_NotifyIcon(NIM_DELETE, pShell_Notify)
If (hResult) Then
KillNewMailIcon = True
Else
KillNewMailIcon = False
End If
End Function
End Module
Which gives the below errors & warnings:
Severity Code Description Line
Error BC30205 End of statement expected. 35
Error BC30800 Method arguments must be enclosed in parentheses. 73
Error BC30828 'As Any' is not supported in 'Declare' statements. 40
Error BC30581 'AddressOf' expression cannot be converted to 'Long' because 'Long' is not a delegate type. 73
Error BC30277 Type character '$' does not match declared data type 'Char'. 129
Warning BC42104 Variable 'sIDType' is used before it has been assigned a value. A null reference exception could result at runtime. 85
Warning BC42104 Variable 'sClass' is used before it has been assigned a value. A null reference exception could result at runtime. 85
Warning BC42109 Variable 'pShell_Notify' is used before it has been assigned a value. A null reference exception could result at runtime. Make sure the structure or all the reference members are initialized before use 145
I am currently trying to find a way to check whether a window is open or not using Findwindow Function. I am able to find the window if i know the entire name of the window. In the below code i know that the name of the window is "win32api - Notepad" so i can easily find the window however i want to know whether it is possible to identify the window if i know only part name like "win32*".
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub runapplication()
hwnd = FindWindow(vbNullString, "win32api - Notepad")
MsgBox (hwnd)
End Sub
One way you can do this is with the EnumWindows API function. Since it operates via a callback function, you'll need to cache both the criteria and the results somewhere that has scope beyond the calling function:
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
ByVal param As Long) As Long
Public Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Const MAX_LEN = 260
Public results As Dictionary
Public criteria As String
Public Sub Example()
criteria = "win32*"
Set results = New Dictionary
Call EnumWindows(AddressOf EnumWindowCallback, &H0)
Dim result As Variant
For Each result In results.Keys
Debug.Print result & " - " & results(result)
Next result
End Sub
Public Function EnumWindowCallback(ByVal hwnd As Long, ByVal param As Long) As Long
Dim retValue As Long
Dim buffer As String
If IsWindowVisible(hwnd) Then
buffer = Space$(MAX_LEN)
retValue = GetWindowText(hwnd, buffer, Len(buffer))
If retValue Then
If buffer Like criteria Then
results.Add hwnd, Left$(buffer, retValue)
End If
End If
End If
EnumWindowCallback = 1
End Function
The below code worked for me. Just Declared IsWindowVisible Function and Added Microsoft scripting runtime library to my project.
Public Declare Function EnumWindows Lib "User32" (ByVal lpEnumFunc As Long, _
ByVal param As Long) As Long
Public Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long
Public Const MAX_LEN = 260
Public results As Dictionary
Public criteria As String
Public Sub Example()
criteria = "win32"
Set results = New Dictionary
Call EnumWindows(AddressOf EnumWindowCallback, &H0)
Dim result As Variant
For Each result In results.Keys
Debug.Print result & " - " & results(result)
Next result
End Sub
Public Function EnumWindowCallback(ByVal hWnd As Long, ByVal param As Long) As Long
Dim retValue As Long
Dim buffer As String
If IsWindowVisible(hWnd) Then
buffer = Space$(MAX_LEN)
retValue = GetWindowText(hWnd, buffer, Len(buffer))
If retValue Then
If InStr(1, buffer, criteria, vbTextCompare) > 0 Then
results.Add hWnd, Left$(buffer, retValue)
End If
End If
End If
EnumWindowCallback = 1
End Function
I have written a program that is to find a box in another program and set focus to it. Once this is done it will sendkeys and save to this box.
I am using Findwindow and FindwindowEx to locate the box, but I have a bit of an issue.
if you notice the windows are the same all the way down to the first TPanel. Now after that there are 3Tpanel Classes.
After 3Tpanel Classes there are multiple TttgEdit Classes.
How do I teach the program which Classes I want to select?
Here is my code thus far.
Delcare
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As IntPtr) As Long
Private Declare Auto Function FindWindow Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32.dll" ( _
ByVal hwndParent As IntPtr, _
ByVal hwndChildAfter As IntPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String _
) As IntPtr
Source
Dim hWnd As IntPtr = FindWindow("TRunprgForm", Nothing)
If hWnd.Equals(IntPtr.Zero) Then
Return
End If
cb1.Checked = True
'--------------------instert here
Dim hWndChild1 As IntPtr = _
FindWindowEx(hWnd, IntPtr.Zero, "TmisinvForm", Nothing)
If hWndChild1.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild2 As IntPtr = _
FindWindowEx(hWndChild1, IntPtr.Zero, "TScrollBox", Nothing)
If hWndChild2.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild3 As IntPtr = _
FindWindowEx(hWndChild2, IntPtr.Zero, "TPageControl", Nothing)
If hWndChild3.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild4 As IntPtr = _
FindWindowEx(hWndChild3, IntPtr.Zero, "TTabSheet", Nothing)
If hWndChild4.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild5 As IntPtr = _
FindWindowEx(hWndChild4, IntPtr.Zero, "TttgCenterPanel", Nothing)
If hWndChild5.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild6 As IntPtr = _
FindWindowEx(hWndChild5, IntPtr.Zero, "TPanel", Nothing)
If hWndChild6.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndEdit As IntPtr = _
FindWindowEx(hWndChild6, IntPtr.Zero, "TttgDBEdit", Nothing)
If hWndEdit.Equals(IntPtr.Zero) Then
Return
End If
SetForegroundWindow(hWndEdit)
The numbers on the left hand side, hWnd, They change every time the screen is closed and opened, so I cant use them as a static number. Any help would be awesome.
It looks like you want the second TPanel under the TttgCenterPanel.
In order to do that, you can find the first TPanel (you already did this), and after that, find the TPanel that is a descendant of TttgCenterPanel, and comes after the first TPanel. You need to pass hwndChild5 into the hwndChildAfter of FindWindowEx`.
' .... all the stuff you did before
Dim hWndChild5 As IntPtr = _
FindWindowEx(hWndChild4, IntPtr.Zero, "TttgCenterPanel", Nothing)
If hWndChild5.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild6 As IntPtr = _
FindWindowEx(hWndChild5, IntPtr.Zero, "TPanel", Nothing)
If hWndChild6.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndChild6Second As IntPtr = _
FindWindowEx(hWndChild5, hWndChild6, "TPanel", Nothing)
If hWndChild6Second.Equals(IntPtr.Zero) Then
Return
End If
Dim hWndEdit As IntPtr = _
FindWindowEx(hWndChild6Second, IntPtr.Zero, "TttgDBEdit", Nothing)
If hWndEdit.Equals(IntPtr.Zero) Then
Return
End If
SetForegroundWindow(hWndEdit)
From the MSDN documentation of FindWindowEx:
hwndChildAfter [in, optional]
Type: HWND
A handle to a child window. The search begins with the next child window in the Z order. The child window must be a direct child window of hwndParent, not just a descendant window.
If hwndChildAfter is NULL, the search begins with the first child window of hwndParent.
This approach will work if you are trying to find the second TPanel. If they are in random order each time, this will fail.
the purpose is to send a message from an vb.net application to another application using winapi sendmessage. I cannot get it to work. Your help is greatly appreciated
This is what I have, but it does not seems to work
Public Class WinAPI
Private hwnd As Integer
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As IntPtr
'FindWindowByClass
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal zero As IntPtr) As IntPtr
'FindWindowByCaption
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal zero As IntPtr, _
ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function SendMessage Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByRef lParam As COPYDATASTRUCT) As Boolean
Public Const WM_COPYDATA As Integer = &H4A
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Dim dwData As Long
Dim cbData As Long
Dim lpData As IntPtr
End Structure
Public Sub SendToeSignal(ByVal strMessage As String)
hwnd = FindWindow(vbNullString, "eSignalSink")
' hwnd = FindWindow("eSignalSink", "vbNullString")
Dim DataStruct As New COPYDATASTRUCT
' strMessage = "1" & "," & strMessage & Chr(0) & vbCr 'Null terminated & carriage return
strMessage = "1" & "," & strMessage & vbCr 'Null terminated & carriage return
DataStruct.dwData = 1
DataStruct.cbData = strMessage.Length * Marshal.SystemDefaultCharSize
DataStruct.lpData = Marshal.StringToCoTaskMemAuto(strMessage)
SendMessage(hwnd, WM_COPYDATA, 0, DataStruct)
Marshal.FreeCoTaskMem(DataStruct.lpData)
End Sub
End Class
It looks like you have a VB6 style definition of your COPYDATASTRUCT try this instead.
From above PInvoke link:
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Public dwData As IntPtr
Public cdData As Integer
Public lpData As IntPtr
End Structure
First of all do yourself a favor and enable Option Strict expecially when you are working with API functions. You are sending a structure between your applications and will need to make sure you can retrieve it at the receiving application. I made some changes to your example code and it does work, receiving the data in a test program that the main Form is named TestApp.
Your example with modifications
Option Strict On
Imports System.Runtime.InteropServices
Public Class Form1
Public Sub New()
' This call is required by the designer.
InitializeComponent()
Dim myWinAPI As WinAPI = New WinAPI
myWinAPI.SendToeSignal("Hello World")
' Add any initialization after the InitializeComponent() call.
End Sub
End Class
Public Class WinAPI
Private hwnd As IntPtr
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As IntPtr
'FindWindowByClass
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal lpClassName As String, _
ByVal zero As IntPtr) As IntPtr
'FindWindowByCaption
Private Declare Auto Function FindWindow Lib "user32" _
(ByVal zero As IntPtr, _
ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function SendMessage Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal Msg As Integer, _
ByVal wParam As IntPtr, _
ByRef lParam As COPYDATASTRUCT) As Boolean
Public Const WM_COPYDATA As Integer = &H4A
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Dim dwData As IntPtr
Dim cbData As Integer
Dim lpData As IntPtr
End Structure
Public Sub SendToeSignal(ByVal strMessage As String)
hwnd = FindWindow(IntPtr.Zero, "TestApp")
Dim DataStruct As New COPYDATASTRUCT
strMessage = "1" & "," & strMessage & vbCr 'Null terminated & carriage return
DataStruct.dwData = CType(1, IntPtr)
DataStruct.cbData = strMessage.Length * Marshal.SystemDefaultCharSize
DataStruct.lpData = Marshal.StringToCoTaskMemAuto(strMessage)
SendMessage(hwnd, WM_COPYDATA, IntPtr.Zero, DataStruct)
Marshal.FreeCoTaskMem(DataStruct.lpData)
End Sub
Public Sub New()
End Sub
End Class
Receiving Application
Imports System.Runtime.InteropServices
Imports System.Text
Public Class Form1
<StructLayout(LayoutKind.Sequential)> _
Structure COPYDATASTRUCT
Dim dwData As IntPtr
Dim cbData As Integer
Dim lpData As IntPtr
End Structure
Public Const WM_COPYDATA As Integer = &H4A
Dim split() As String = New String() {",", " "}
Dim myData() As String
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_COPYDATA Then
Dim CD As COPYDATASTRUCT = DirectCast(m.GetLParam(GetType(COPYDATASTRUCT)), COPYDATASTRUCT)
Dim B As Byte() = New Byte(CD.cbData - 1) {}
Dim lpData As IntPtr = CD.lpData
Marshal.Copy(lpData, B, 0, CD.cbData)
Dim strData As String = Encoding.[Default].GetString(B)
myData = strData.Split(split, StringSplitOptions.None)
End If
End Sub
End Class
Thanks for the first example that almost worked for my application.
The receiver application need the string in ANSI ( WinAmp ) so I had to change the line:
DataStruct.lpData = Marshal.StringToCoTaskMemAuto(strMessage)
to
DataStruct.lpData = Marshal.StringToCoTaskMemAnsi(strMessage)
Besides that it worked like a charm, first example that got the pointers correctly for x64 - x32. Just wish I found this first in my 24 hr quest
Win 10. Visualstudio2017 vb.net
I thought this would be simple, but it is proving quite difficult. Any advice or ideas would be appretiated.
I have a form in Excel that if a certain button is pressed I need the user to enter a password before the code for that button is run.
I could just use a inputbox, but that will allow anyone else to see the password when it is typed in. So I want to use a second form with a textbox and set it's PasswordChar parameter to *
Here is the problem. I want to use code like this
if checkPassword("Please enter your password") = False then exit sub
checkPassword is a function that takes a string as a parameter. This function opens a form and puts the message in to a lable. The user should enter the password and click OK.
the sub btnOK_Click() should check the password is correct and then force the function that opened the form to return True if the password was OK or False is the password was incorrect.
I just cant work out how to force the function to return. I have tried setting a global variable to either True or False when the user click OK and then unloading the form. This makes the Function return, but it also resets all the global variables set by the form.
Here is my function that calls the form
Function checkPassword(message As String) As Boolean
frmPassword.Show
frmPassword.passwordMsg.Caption = message
'passwordStatus is a global variable
If passwordStatus = True Then checkPassword = True Else checkPassword = False
End Function
Here is the sub linked to the forms OK button:
Private Sub passwordok_Click()
If Me.passwordtext.Text = "password" Then
passwordStatus = True
Else
passwordStatus = False
End If
Unload Me
End Sub
I could just use a inputbox, but that will allow anyone else to see the password when it is typed in. So I want to use a second form with a textbox and set it's PasswordChar parameter to *
Here is something from my database.
DISCLAIMER: I DIDN'T WRITE THIS AND I DON'T REMEMBER WHO WROTE THIS
USAGE:
Private Sub passwordok_Click()
Dim Prompt, password As String
Prompt = "Please enter your password."
password = InputBoxDK(Prompt)
MsgBox password '<~~ Do whatever you want to do with this
End Sub
IN A MODULE
Option Explicit
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
'A window has been activated
If lngCode = HCBT_ACTIVATE Then
RetVal = GetClassName(wParam, strClassName, lngBuffer)
'Class name of the Inputbox
If Left$(strClassName, RetVal) = "#32770" Then
'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
SNAPSHOT
Returning a value from a dialog is a common task & pretty simple to do.
The simplest pattern is to put the function in the dialog form itself and have that function show its host form modally.
Private passwordStatus As Boolean
Function checkPassword(message As String) As Boolean
'//setup the form
Me.passwordMsg.Caption = message
'//show the form modally, this will not return until the form is unloaded
'//i.e. when the button is clicked; so values in private variable are still valid
Me.Show vbModal
'//form is unloaded (via unload me or a close) return the value;
checkPassword = passwordStatus
End Function
Private Sub passwordok_Click()
passwordStatus = Me.passwordtext.Text = "password"
Unload Me
End Sub
Used as
passworkOk = frmPassword.checkPassword("enter your blabla")