On Sat, 31 Jul 2004 20:23:41 -0400,
no**@comcast.net wrote:
OK, feel free to call me a complete dumb ass... I have tried start
an app using CreateProcess, but this does not give the handle to the
application. It does, however, give the dwProcessID, dwThreadId,
hThread, and hProcess. I tried to use the dwProcessID and OpenProcess
API to get the handle from the PIDL, but this didn't work.
So, I launch PC Anywhere using ShellExecute, then enable a timer I
have on the main form. After 1 second, it gets the handle of the top
most window (should be PC Anywhere) using the GetForgroundWindow API.
The handle is stored in a global variable (hdlPCAnywhere), so if the
user presses the button again for PC Anywhere, the sub routine sees
this variable's value is not 0 and calls the ShowWindow(hldPCAnywhere,
9) API.
This works, but I think there is a better way - any ideas? I thought
there was a way to launch an app from VB and get the apps handle as a
return value of the call.
There is. You will find all you need in here:
Option Explicit
' J French - 27th Nov 2003 / 1st Aug 2004
' Shell and Re-Parent
' hacked from MS and KPD
' Add Two Command Buttons
Private Declare Function MoveWindow _
Lib "user32" _
(ByVal hwnd As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As Long, _
ByVal lpWindowName As Long) As Long
Private Declare Function GetWindow _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetParent _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent _
Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Private Declare Function LockWindowUpdate _
Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long
Private Declare Function Putfocus _
Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) As Long
Private Declare Function WaitForInputIdle _
Lib "user32.dll" _
(ByVal hProcess As Long, _
ByVal dwMilliseconds As Long) As Long
Private Const STARTF_FORCEONFEEDBACK As Long = &H40
Private Const GW_HWNDFIRST As Long = 0
Private Const GW_HWNDNEXT = 2
'Private Const WM_QUIT As Long = &H12
Private Const WM_CLOSE = &H10
Private Const WM_SYSCOMMAND As Long = &H112
Private Const SC_CLOSE As Long = &HF060&
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function CreateProcessA _
Lib "kernel32" _
(ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
ByVal lpProcessAttributes As Long, _
ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject _
Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Dim mWnd As Long
Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long, _
test_pid As Long, _
test_thread_id As Long
'Find the first window top level window
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
test_hwnd = GetWindow(test_hwnd, GW_HWNDFIRST)
Do While test_hwnd <> 0
'Check if the window isn't a child (??)
If GetParent(test_hwnd) = 0 Then
'Get the window's thread
test_thread_id = GetWindowThreadProcessId(test_hwnd, _
test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
'retrieve the next window
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Public Function ExecCmd(cmdline$) As Long
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim Ret&
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
start.dwFlags = STARTF_FORCEONFEEDBACK
' Start the shelled application:
Ret& = CreateProcessA(vbNullString, cmdline$, _
0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, _
0&, vbNullString, _
start, proc)
' --- let it start - this seems important
Call WaitForInputIdle(proc.hProcess, 500)
' we should check the result of this
If Ret Then
ExecCmd = InstanceToWnd(proc.dwProcessID)
Me.Print Ret, ExecCmd
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
End If
End Function
Private Sub Command1_Click()
'KPD-Team 1999
'URL:
http://www.allapi.net/
'E-Mail:
KP*****@Allapi.net
' ---
Me.AutoRedraw = True
'Lock the window update
LockWindowUpdate GetDesktopWindow
'Execute notepad.Exe
mWnd = ExecCmd("notepad.exe")
'If mWnd = 0 Then MsgBox "Error starting the app"
Me.Print Str$(mWnd)
' Set the notepad's parent
If mWnd Then
SetParent mWnd, Me.hwnd
' -
Me.ScaleMode = vbPixels
Call MoveWindow(mWnd, 0, 0, _
Me.ScaleWidth, _
Me.ScaleHeight, 1)
' Put the focus on notepad
Putfocus mWnd
End If
' Unlock window update
LockWindowUpdate False
End Sub
Private Sub Command2_Click()
Call SendMessage(mWnd, WM_CLOSE, 0, ByVal 0&)
'Call SendMessage(mWnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&)
End Sub
Private Sub Form_Load()
Command1.Caption = "Start Notepad"
Command2.Caption = "Close Notepad"
End Sub
