I am trying to set the text value of an 'edit' control text box with the SendMessage() function. I am able to set the text about 75% of the time but sometimes the function fails. Why would it work sometimes and fail others? I am always getting the correct window handle and am confused as to what else it could be? Here's my code:
attempt = 1
retry:
'Find open window textbox
temp_id = 0
temp_id = FindWindowEx(open_id, ByVal 0&, "ComboBoxEx32", vbNullString)
temp_id = FindWindowEx(temp_id, ByVal 0&, "ComboBox", vbNullString)
text_id = FindWindowEx(temp_id, ByVal 0&, "Edit", vbNullString)
'Select textbox and enter text then press open button
Call SendMessage(text_id, WM_LBUTTONDBLCLK, 0, 0)
Sleep 100
text = filename
Call SendMessage(text_id, WM_SETTEXT, 0&, ByVal text)
DoEvents
Sleep 100
If GetWindowTextLength(text_id) = 0 Then
If attempt < 3 Then
attempt = attempt + 1
GoTo retry
End If
End If
Related
I use the following approach sucessfully to copy the selected text from other applications.
The following works fine for Notepad:
Dim ThreadID1&
Dim ThreadID2&
'
' First need to get the thread responsible for this window,
' and the thread for the foreground window.
Dim lFore&
lFore = GetForegroundWindow()
Debug.Print "foreground: " & modWindow.WindowTitleFromHwnd(lFore)
ThreadID1 = GetWindowThreadProcessId(lFore, ByVal 0&)
'By sharing input state, threads share their concept of
' the active window
Call AttachThreadInput(ThreadID1, ThreadID2, True)
Dim guiInfo As GUITHREADINFO
guiInfo.cbSize = Len(guiInfo)
Dim lRet&
lRet = GetGUIThreadInfo(ThreadID1, guiInfo)
Debug.Assert guiInfo.hwndCaret <> 0
If guiInfo.hwndCaret = 0 Then
Debug.Print "lastdll error: " & Err.LastDLLError
Debug.Assert False
End If
Dim s$
s = GetCaretWindowText(guiInfo.hwndCaret, true)
Debug.Print "Text: " & s
Call AttachThreadInput(ThreadID1, ThreadID2, False)
The problem is that - if I use Chrome browser instead of Notepad - the following occurs:
guiInfo.hwndCaret = 0
However, GetGUIThreadInfo returns True, so there is no obvious error in my approach, I think.
What might be my mistake here?
We use classic native OS tooltips for clipped texts. However, if so-called large fonts are used in the OS
, our tooltip window appears as an empty window of a very small size (about 13x5 pixels). See it magnified below - it is near the cursor:
Is it a known bug? If so, how to solve this problem?
Below is the code of the method used to initialize a tooltip:
Public Function Create(ByVal ParentHwnd As Long) As Boolean
Dim lWinStyle As Long
If m_lTTHwnd <> 0 Then
DestroyWindow m_lTTHwnd
End If
m_lParentHwnd = ParentHwnd
lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
m_lTTHwnd = CreateWindowExA(0&, _
TOOLTIPS_CLASS, _
vbNullString, _
lWinStyle, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
0&, _
0&, _
App.hInstance, _
0&)
'now set our tooltip info structure
Dim tiA As TOOLINFOA
Dim tiW As TOOLINFOW
If g_bIsNt Then
With tiW
.lSize = Len(tiW)
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
.hWnd = m_lParentHwnd
.lId = m_lParentHwnd '0
.hInstance = App.hInstance
.lpStr = StrPtr(mvarTipText)
End With
Else
With tiA
.lSize = Len(tiA)
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
.hWnd = m_lParentHwnd
.lId = m_lParentHwnd
.hInstance = App.hInstance
.lpStr = mvarTipText
End With
End If
'add the tooltip structure
If g_bIsNt Then
SendMessage m_lTTHwnd, TTM_ADDTOOLW, 0&, tiW
Else
SendMessage m_lTTHwnd, TTM_ADDTOOLA, 0&, tiA
End If
'if we want a title or we want an icon
If mvarTitle <> vbNullString Or mvarIcon <> igToolTipIconNone Then
If g_bIsNt Then
SendMessage m_lTTHwnd, TTM_SETTITLEW, mvarIcon, ByVal StrPtr(mvarTitle)
Else
SendMessage m_lTTHwnd, TTM_SETTITLEA, mvarIcon, ByVal mvarTitle
End If
End If
' set the time parameters
SendMessageByLongA m_lTTHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, mvarVisibleTime
SendMessageByLongA m_lTTHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, mvarDelayTime
'according to MSDN, we should set TTM_SETMAXTIPWIDTH to a positive value
'to enable multiline tooltips
SendMessageByLongA m_lTTHwnd, TTM_SETMAXTIPWIDTH, 0, 2147483647
End Function
Setting TTM_SETMAXTIPWIDTH to 100000 helped to solve the problem:
SendMessageByLongA m_lTTHwnd, TTM_SETMAXTIPWIDTH, 0, 100000
#JonathanPotter, thanks a million.
We have been using code that creates classical Win32 multiline tooltips in our legacy VB6 component for many years, since the times of Windows XP. It works fine in all latest versions of MS Windows (7, 8.1) except Windows 10. A parasitic horizontal gray line appears in the tooltip in this OS. The best demonstration of this problem is a tooltip window containing several lines of text (the main tip text is multiline and/or the tooltip has a bold title):
The correct tooltip should look like this (a screen from Windows 8.1):
Below is one more example of the same problem when the tooltip window does not have tile/icon but contains only multiline text:
This parasitic gray line is also present in a single-line tooltip - though it is not noticeable at first look:
What it could be? Is it a bug in Windows 10, or something has changed in the tooltip API?
Below is the code of the method used to initialize a tooltip:
Public Function Create(ByVal ParentHwnd As Long) As Boolean
Dim lWinStyle As Long
If m_lTTHwnd <> 0 Then
DestroyWindow m_lTTHwnd
End If
m_lParentHwnd = ParentHwnd
lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
m_lTTHwnd = CreateWindowExA(0&, _
TOOLTIPS_CLASS, _
vbNullString, _
lWinStyle, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
0&, _
0&, _
App.hInstance, _
0&)
'now set our tooltip info structure
Dim tiA As TOOLINFOA
Dim tiW As TOOLINFOW
If g_bIsNt Then
With tiW
.lSize = Len(tiW)
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
.hWnd = m_lParentHwnd
.lId = m_lParentHwnd '0
.hInstance = App.hInstance
.lpStr = StrPtr(mvarTipText)
End With
Else
With tiA
.lSize = Len(tiA)
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
.hWnd = m_lParentHwnd
.lId = m_lParentHwnd
.hInstance = App.hInstance
.lpStr = mvarTipText
End With
End If
'add the tooltip structure
If g_bIsNt Then
SendMessage m_lTTHwnd, TTM_ADDTOOLW, 0&, tiW
Else
SendMessage m_lTTHwnd, TTM_ADDTOOLA, 0&, tiA
End If
'if we want a title or we want an icon
If mvarTitle <> vbNullString Or mvarIcon <> igToolTipIconNone Then
If g_bIsNt Then
SendMessage m_lTTHwnd, TTM_SETTITLEW, mvarIcon, ByVal StrPtr(mvarTitle)
Else
SendMessage m_lTTHwnd, TTM_SETTITLEA, mvarIcon, ByVal mvarTitle
End If
End If
' set the time parameters
SendMessageByLongA m_lTTHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, mvarVisibleTime
SendMessageByLongA m_lTTHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, mvarDelayTime
'according to MSDN, we should set TTM_SETMAXTIPWIDTH to a positive value
'to enable multiline tooltips
SendMessageByLongA m_lTTHwnd, TTM_SETMAXTIPWIDTH, 0, 100000
End Function
To solve the problem, we should not set the hwnd field of the TOOLINFO structure. The corresponding part of the code should look like this:
'now set our tooltip info structure
Dim tiA As TOOLINFOA
Dim tiW As TOOLINFOW
If g_bIsNt Then
With tiW
.lSize = Len(tiW)
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
.lId = m_lParentHwnd
.hInstance = App.hInstance
.lpStr = StrPtr(mvarTipText)
End With
Else
With tiA
.lSize = Len(tiA)
.lFlags = TTF_SUBCLASS Or TTF_IDISHWND
.lId = m_lParentHwnd
.hInstance = App.hInstance
.lpStr = mvarTipText
End With
End If
I want to permanently hide the access window. I have a auto exe macro that hides the window initially but if the user ever clicks my database's icon on the task bar if appears behind my forms and is just rather annoying. I was wondering if there was a way to keep it down without having to copy past a hide window macro every where
The following will work on older versions of access (source: http://www.vbaexpress.com/kb/getarticle.php?kb_id=74):
Option Compare Database
Option Explicit
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Function fSetAccessWindow(nCmdShow As Long)
Dim loX As Long
Dim loForm As Form
On Error Resume Next
Set loForm = Screen.ActiveForm
If Err <> 0 Then
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If
If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then
MsgBox "Cannot minimize Access with " _
& (loForm.Caption + " ") _
& "form on screen"
ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then
MsgBox "Cannot hide Access with " _
& (loForm.Caption + " ") _
& "form on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
End If
fSetAccessWindow = (loX <> 0)
End Function
Just call fSetAccessWindow(0) to hide and fSetAccessWindow(1) to show. Alternatively, you could use fSetAccessWindow(2) and fSetAccessWindow(3) to show minimized/maximized. The application will be hidden from the taskbar too, preventing users from clicking it.
If it doesn't work with Access 2010, you could also try this: http://www.tek-tips.com/faqs.cfm?fid=2562
I need to get elevated credentials (to start a service) in a VB6 application, but only if the user needs to restart the service (I.e. I don't want to get elevated credentials whenever the application is started, only when the user selects restart). How can I do this in VB6?
Fairly easy, but the preferred way involves a new elevated process. This example uses itself run with a switch to know to perform the Service Start instead of normal operations:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 3060
ClientLeft = 45
ClientTop = 345
ClientWidth = 4560
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3060
ScaleWidth = 4560
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Start Service"
Height = 495
Left = 1448
TabIndex = 0
Top = 1283
Width = 1665
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const BCM_SETSHIELD As Long = &H160C&
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
ShellExecute hWnd, "runas", App.EXEName & ".exe", "-start", CurDir$(), vbNormalFocus
End Sub
Private Sub Form_Load()
If UCase$(Trim$(Command$())) = "-START" Then
Caption = "Starting Service"
Command1.Visible = False
'Service starting functionality goes here.
Else
Caption = "Service Starter"
'For Shield to work you must have a Common Controls v. 6
'manifest and call InitCommonControls before loading
'this form (i.e. preferably from Sub Main).
SendMessage Command1.hWnd, BCM_SETSHIELD, 0&, 1&
Command1.Visible = True
End If
End Sub
One solution is to use the COM elevation moniker http://msdn.microsoft.com/en-us/library/ms679687(VS.85).aspx.
This link should be useful if your target is VB6 http://www.vbforums.com/showthread.php?t=459643.
You'll need to call into the WinAPI - CoImpersonateClient, or LogonUser.
Just remember to lower your privileges afterwards, and be DARN careful what you do when elevated (e.g. don't do ANYthing with user input).
Another option, which I believe is preferable (if available), is to use a COM+ configured object. You can have the COM+ subsystem manage credentials, and just limit access to call the object as necessary. This has the benefit of creating and ACTUAL trust boundary between low-privileged code and high-privileged code.