On Thu, 27 Nov 2003 10:33:37 +0100, "John Lauwers"
<no****@fictief.com> wrote:
J.Frech,
The Shellexecute API doesn't return a handle it returns a long which
represents the error code when the function fails.
No you get an InstanceHandle
- which may contain Error Codes
ShellExecuteEx (optionally) returns a hProcess
CreateProcess strikes me as the best solution
Here is something I have hacked together
Option Explicit
' J French - 27th Nov 2003
' Shell and Re-Parent
' hacked from MS and KPD
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
Const SW_SHOWNORMAL = 1
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 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 GetWindow _
Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd 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 DestroyWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function TerminateProcess _
Lib "kernel32" _
(ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function GetCurrentProcess _
Lib "kernel32" () As Long
Private Declare Function Putfocus _
Lib "user32" _
Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Const GW_HWNDNEXT = 2
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
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
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 the shelled application:
Ret& = CreateProcessA(vbNullString, cmdline$, _
0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, _
0&, vbNullString, _
start, proc)
' --- let it start - this seems important
Call WaitForSingleObject(proc.hProcess, 500)
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 windowupdate
LockWindowUpdate False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unload notepad
'DestroyWindow mWnd
'End this program
End Sub
