求助!让别的应用程序在自己的窗体中运行！

Question

想做一个程序，让别的应用程序在自己的窗体中运行，从网上找到了别人做的源码：runinmyform，现在已经做出了效果，windows自带的计算器 记事本 纸牌这种应用都已经测试过了，都可以让这些程序运行在我的窗体里。可是有如下问题：
1、某些应用程序还是会跳出父窗体
2、带登录框的程序，登录框是在我的窗体里的，但是登录以后的窗体又跳出去了，比如qq，哪位高人来解决下...
调用代码    pid = Shell("notepad.exe", vbNormalFocus)
    If pid = 0 Then
        MsgBox "Error starting program"
        Exit Sub
    End If    Notepad_Hwnd& = InstanceToWnd(pid)
    Notepad_OldParent& = SetParent(Notepad_Hwnd&, Me.hWnd模块代码Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long
    Dim test_pid As Long
    Dim test_thread_id As Long    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)    ' Loop until we find the target or we run out
    ' of windows.
    Do While test_hwnd <> 0
        ' See if this window has a parent. If not,
        ' it is a top-level window.
        If GetParent(test_hwnd) = 0 Then
            ' This is a top-level window. See if
            ' it has the target instance handle.
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)            If test_pid = target_pid Then
                ' This is the target.
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If        ' Examine the next window.
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

Answer 1

带登录框的程序，登录框和主界面是2个窗体,登陆后也要取主界面的Hwnd,再SetParent

Answer 2

使用Shell运行可执行文件，再使用FindWIndow找到该可执行文件窗体的句柄，再使用SetParent设置为当前进程的子窗体

Answer 3

'创建一个新的工程，包含窗体Form1
'再添加一个MDIForm1（多文档窗体），把Form1设置为其子窗体
'在Form1中加入一个Command1按钮
'在Form1窗体中加入如下代码Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub Command1_Click()
    Dim lngP As Long
    Shell "C:\WINDOWS\system32\calc.exe", vbNormalFocus
    lngP = FindWindow(vbNullString, "计算器")
    lngP = SetParent(lngP, MDIForm1.hWnd)
End Sub

Answer 4

谢谢，我是按照你的方法做的啊，可是有些应用程序不行，windows自带的程序都可以很好的达到效果

Answer 5

调用代码Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
    Dim pid As Long
    Dim buf As String
    Dim buf_len As Long
    Dim styles As Long
    pid = Shell("notepad.exe", vbNormalFocus)
    If pid = 0 Then
        MsgBox "Error starting program"
        Exit Sub
    End If
    Notepad_Hwnd& = InstanceToWnd(pid)
    
    
    Notepad_OldParent& = SetParent(Notepad_Hwnd&, Me.hWnd)
End Sub模块代码Option ExplicitPublic Const GW_HWNDNEXT = 2Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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 SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long' Return the window handle for an instance handle.
Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long
    Dim test_pid As Long
    Dim test_thread_id As Long    ' Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)    ' Loop until we find the target or we run out
    ' of windows.
    Do While test_hwnd <> 0
        ' See if this window has a parent. If not,
        ' it is a top-level window.
        If GetParent(test_hwnd) = 0 Then
            ' This is a top-level window. See if
            ' it has the target instance handle.
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)            If test_pid = target_pid Then
                ' This is the target.
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If        ' Examine the next window.
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

Answer 6

Veron_04，谢谢你，用 findwindow确实很好的解决了我的第一个问题

Answer 7

再问下，我有一个程序反应慢，shell之后立刻findwindow返回0，等等就返回句柄了，现在是用循环做了延时，有没有好方法，能判断应用程序是否已经启动完毕？或者说我先隐藏，然后感觉启动完了再显示

Answer 8

用Timer或循环等待，判断返回不为0再说
这样的问题也问？太没技术含量了

Answer 9

如果你是用Shell打开的可执行文件，那么它会返回该可执行文件运行后的进程，要使用FindWindow成功查找句柄，那就的判断Shell是否执行完毕。简单的说，如下：
'创建一个新的工程，包含窗体Form1
'再添加一个MDIForm1（多文档窗体），把Form1设置为其子窗体
'在Form1中加入一个Command1按钮
'在Form1窗体中加入如下代码Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub Command1_Click()
    Dim lngP As Long
    lngP = Shell("C:\WINDOWS\system32\calc.exe", vbNormalFocus) 'lngP为运行后进程的PID，成功执行后lngP是大于0的
    If lngP <> 0 Then
        lngP = FindWindow(vbNullString, "计算器")
        lngP = SetParent(lngP, MDIForm1.hwnd)
    End If
End Sub

Answer 10

Veron_04，14楼那种是不行的，shell成功的话返回就不是0，但是这时候findWindow返回的仍然是0，可以打开一个反应慢的试试

Answer 11

多谢dbcontrols点醒了俺，第一个问题圆满解决，谢谢大家，第二个问题我还在考虑，关于这两个问题，有好想法的都来说说，周三来上班的时候再加分，周三结贴，再次感谢

Answer 12

最后的调用代码Dim lngP As Long
    Dim pid As Long
  
    ChDir ("C:\Program Files\AlphaPro")
    pid = Shell("C:\Program Files\AlphaPro\alphapro.exe", vbNormalFocus)
    Dim t1     As Long
    Dim t2     As Long
    t1 = timeGetTime
    While (t2 - t1 < 5 * 1000)
            t2 = timeGetTime
            lngP = FindWindow(vbNullString, "AlphaPro M v10.56")
            If lngP > 0 Then
            lngP = SetParent(lngP, Me.hwnd)
            End If
    Wend