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