form1.frm

调用系统中其他的程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7395
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10785
   LinkTopic       =   "Form1"
   ScaleHeight     =   7395
   ScaleWidth      =   10785
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   6855
      Left            =   2520
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   6
      Text            =   "Form1.frx":0000
      Top             =   240
      Width           =   6615
   End
   Begin VB.FileListBox File1 
      Height          =   2970
      Left            =   120
      TabIndex        =   5
      Top             =   3720
      Width           =   2055
   End
   Begin VB.DirListBox Dir1 
      Height          =   2400
      Left            =   240
      TabIndex        =   4
      Top             =   1080
      Width           =   1935
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   240
      TabIndex        =   3
      Top             =   480
      Width           =   1455
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   495
      Left            =   9480
      TabIndex        =   2
      Top             =   6360
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "释放程序"
      Height          =   495
      Left            =   9480
      TabIndex        =   1
      Top             =   5760
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "调用程序"
      Height          =   495
      Left            =   9480
      TabIndex        =   0
      Top             =   5160
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

 Private oldparent&
 Private hwnd1&

Private Sub Dir1_Change()
File1.Path = Dir1.Path  '00000000000000000000000000000000000000000000000
End Sub

 Private Sub form_load()
 Drive1.Drive = App.Path
 Dir1.Path = App.Path
 End Sub
 
Private Sub drive1_change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub command1_click()
Dim myexe As Long
Dim newhwnd As Long
Dim newexe As Long
Dim myvalue As Long
myexe = Shell(File1.Path & "\" & File1.FileName, vbNormalFocus)
If myexe = 0 Then
  MsgBox "调用程序错误"
Exit Sub
End If
newhwnd = FindWindow(ByVal 0&, byval0&)
Do While newhwnd <> 0
   If GetParent(newhwnd) = 0 Then
     myvalue = GetWindowThreadProcessId(newhwnd, newexe)
     If newexe = myexe Then
         hwnd1& = newhwnd
         Exit Do
      End If
   End If
      newhwnd = GetWindow(newhwnd, GW_HWNDNEXT)
Loop
oldparent& = SetParent(hwnd1&, Me.hwnd)

End Sub
Private Sub command2_click()
  SetParent hwnd1&, oldparent&
  
End Sub
Private Sub command3_click()
End
End Sub