home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples4 / ch14 / launch.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  8.1 KB  |  227 lines
  1. VERSION 4.00
  2. Begin VB.Form frmLaunch 
  3.    Caption         =   "Launch Shelled1.exe"
  4.    ClientHeight    =   2880
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1515
  7.    ClientWidth     =   4140
  8.    Height          =   3285
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2880
  12.    ScaleWidth      =   4140
  13.    Top             =   1170
  14.    Width           =   4260
  15.    Begin VB.CommandButton cmdShell2 
  16.       Caption         =   "Shell with Callback"
  17.       Height          =   495
  18.       Left            =   240
  19.       TabIndex        =   6
  20.       Top             =   1560
  21.       Width           =   1755
  22.    End
  23.    Begin VB.CommandButton cmdShellExecute 
  24.       Caption         =   "Using ShellExecute"
  25.       Height          =   495
  26.       Left            =   240
  27.       TabIndex        =   3
  28.       Top             =   2220
  29.       Width           =   1755
  30.    End
  31.    Begin VB.CommandButton cmdCreateProcess 
  32.       Caption         =   "Using CreateProcess"
  33.       Height          =   495
  34.       Left            =   240
  35.       TabIndex        =   2
  36.       Top             =   900
  37.       Width           =   1755
  38.    End
  39.    Begin VB.CommandButton cmdShell 
  40.       Caption         =   "Using Shell"
  41.       Height          =   495
  42.       Left            =   240
  43.       TabIndex        =   0
  44.       Top             =   240
  45.       Width           =   1755
  46.    End
  47.    Begin VB.Label lblStatus 
  48.       Height          =   255
  49.       Index           =   2
  50.       Left            =   2100
  51.       TabIndex        =   5
  52.       Top             =   1680
  53.       Width           =   1875
  54.    End
  55.    Begin VB.Label lblStatus 
  56.       Height          =   255
  57.       Index           =   1
  58.       Left            =   2100
  59.       TabIndex        =   4
  60.       Top             =   1020
  61.       Width           =   1875
  62.    End
  63.    Begin VB.Label lblStatus 
  64.       Height          =   255
  65.       Index           =   0
  66.       Left            =   2100
  67.       TabIndex        =   1
  68.       Top             =   300
  69.       Width           =   1875
  70.    End
  71. Attribute VB_Name = "frmLaunch"
  72. Attribute VB_Creatable = False
  73. Attribute VB_Exposed = False
  74. Option Explicit
  75. ' Copyright 
  76.  1997 by Desaware Inc. All Rights Reserved
  77. Dim DemoDirectory$
  78. Private Const SYNCHRONIZE = &H100000
  79. Private Const INFINITE = &HFFFF           '  Infinite timeout
  80. Private Const DEBUG_PROCESS = &H1
  81. Private Const DEBUG_ONLY_THIS_PROCESS = &H2
  82. Private Const CREATE_SUSPENDED = &H4
  83. Private Const DETACHED_PROCESS = &H8
  84. Private Const CREATE_NEW_CONSOLE = &H10
  85. Private Const NORMAL_PRIORITY_CLASS = &H20
  86. Private Const IDLE_PRIORITY_CLASS = &H40
  87. Private Const HIGH_PRIORITY_CLASS = &H80
  88. Private Const REALTIME_PRIORITY_CLASS = &H100
  89. Private Const CREATE_NEW_PROCESS_GROUP = &H200
  90. Private Const CREATE_NO_WINDOW = &H8000000
  91. Private Const WAIT_FAILED = -1&
  92. Private Const WAIT_OBJECT_0 = 0
  93. Private Const WAIT_ABANDONED = &H80&
  94. Private Const WAIT_ABANDONED_0 = &H80&
  95. Private Const WAIT_TIMEOUT = &H102&
  96. Private Const SW_SHOW = 5
  97. Private Type PROCESS_INFORMATION
  98.         hProcess As Long
  99.         hThread As Long
  100.         dwProcessId As Long
  101.         dwThreadId As Long
  102. End Type
  103. Private Type STARTUPINFO
  104.         cb As Long
  105.         lpReserved As String
  106.         lpDesktop As String
  107.         lpTitle As String
  108.         dwX As Long
  109.         dwY As Long
  110.         dwXSize As Long
  111.         dwYSize As Long
  112.         dwXCountChars As Long
  113.         dwYCountChars As Long
  114.         dwFillAttribute As Long
  115.         dwFlags As Long
  116.         wShowWindow As Integer
  117.         cbReserved2 As Integer
  118.         lpReserved2 As Long
  119.         hStdInput As Long
  120.         hStdOutput As Long
  121.         hStdError As Long
  122. End Type
  123. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  124. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  125. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  126. Private Declare Function CreateProcessBynum Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  127. Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
  128. 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
  129. Private Sub cmdCreateProcess_Click()
  130.     Dim res&
  131.     Dim sinfo As STARTUPINFO
  132.     Dim pinfo As PROCESS_INFORMATION
  133.     sinfo.cb = Len(sinfo)
  134.     sinfo.lpReserved = vbNullString
  135.     sinfo.lpDesktop = vbNullString
  136.     sinfo.lpTitle = vbNullString
  137.     sinfo.dwFlags = 0
  138.     lblStatus(1).Caption = "Launching"
  139.     lblStatus(1).Refresh
  140.     res = CreateProcessBynum(DemoDirectory & "Shelled1.exe", vbNullString, 0, 0, True, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, sinfo, pinfo)
  141.     If res Then
  142.         lblStatus(1).Caption = "Launched"
  143.         WaitForTerm2 pinfo
  144.     End If
  145.     lblStatus(1).Caption = "Terminated"
  146. End Sub
  147. Private Sub cmdShell_Click()
  148.     Dim pid&
  149.     lblStatus(0).Caption = "Launching"
  150.     lblStatus(0).Refresh
  151.     pid = Shell(DemoDirectory & "Shelled1.exe", vbNormalFocus)
  152.     If pid <> 0 Then
  153.         lblStatus(0).Caption = "Launched"
  154.         lblStatus(0).Refresh
  155.         WaitForTerm1 pid
  156.     End If
  157.     lblStatus(0).Caption = "Terminated"
  158. End Sub
  159. ' This wait routine freezes the application
  160. ' It's clearly not a good way to wait for process
  161. ' termination - though if you hid the application
  162. ' first it could be very effective.
  163. Private Sub WaitForTerm1(pid&)
  164.     Dim phnd&
  165.     phnd = OpenProcess(SYNCHRONIZE, 0, pid)
  166.     If phnd <> 0 Then
  167.         lblStatus(0).Caption = "Waiting for termination"
  168.         lblStatus(0).Refresh
  169.         Call WaitForSingleObject(phnd, INFINITE)
  170.         Call CloseHandle(phnd)
  171.     End If
  172. End Sub
  173. ' This wait routine allows other application events
  174. ' to be processed while waiting for the process to
  175. ' complete.
  176. Private Sub WaitForTerm2(pinfo As PROCESS_INFORMATION)
  177.     Dim res&
  178.     ' Let the process initialize
  179.     Call WaitForInputIdle(pinfo.hProcess, INFINITE)
  180.     ' We don't need the thread handle
  181.     Call CloseHandle(pinfo.hThread)
  182.     ' Disable the button to prevent reentrancy
  183.     cmdCreateProcess.Enabled = False
  184.     lblStatus(1).Caption = "Waiting for termination"
  185.     lblStatus(1).Refresh
  186.     Do
  187.         res = WaitForSingleObject(pinfo.hProcess, 0)
  188.         If res <> WAIT_TIMEOUT Then
  189.             ' No timeout, app is terminated
  190.             Exit Do
  191.         End If
  192.         DoEvents
  193.     Loop While True
  194.     cmdCreateProcess.Enabled = True
  195.     ' Kill the last handle of the process
  196.     Call CloseHandle(pinfo.hProcess)
  197. End Sub
  198. Private Sub cmdShell2_Click()
  199.     Dim pid&
  200.     Dim obj As Object
  201.     lblStatus(2).Caption = "Launching"
  202.     lblStatus(2).Refresh
  203.     pid = Shell(DemoDirectory & "Shelled1.exe", vbNormalFocus)
  204.     If pid <> 0 Then
  205.         Set obj = CreateObject("dwWatcher.dwAppWatch")
  206.         obj.SetAppWatch pid
  207.         obj.SetAppCallback Me
  208.         lblStatus(2).Caption = "Waiting for termination"
  209.         cmdShell2.Enabled = False
  210.     End If
  211. End Sub
  212. Private Sub cmdShellExecute_Click()
  213.     Dim res&
  214.     Dim obj As Object
  215.     res& = ShellExecute(hwnd, "open", DemoDirectory & "Shelled1.exe", vbNullString, CurDir$, SW_SHOW)
  216.     If res < 32 Then
  217.         MsgBox "Unable to shell applicatin"
  218.     End If
  219. End Sub
  220. Public Sub dwAppTerminated(obj As Object)
  221.     lblStatus(2).Caption = "Terminated"
  222.     cmdShell2.Enabled = True
  223. End Sub
  224. Private Sub Form_Load()
  225.     DemoDirectory = InputBox$("Enter path of directory containing Shelled1.exe", , "d:\zdbook3\source\ch14\")
  226. End Sub
  227.