can VB call external programs?
Sorry, I read your question wrong....try this.
Christopher Pisano
----------------
Dim DemoDirectory$
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFFFFFF ' Infinite timeout
Private Const DEBUG_PROCESS = &H1
Private Const DEBUG_ONLY_THIS_PROCESS = &H2
Private Const CREATE_SUSPENDED = &H4
Private Const DETACHED_PROCESS = &H8
Private Const CREATE_NEW_CONSOLE = &H10
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const REALTIME_PRIORITY_CLASS = &H100
Private Const CREATE_NEW_PROCESS_GROUP = &H200
Private Const CREATE_NO_WINDOW = &H8000000
Private Const WAIT_FAILED = -1&
Private Const WAIT_OBJECT_0 = 0
Private Const WAIT_ABANDONED = &H80&
Private Const WAIT_ABANDONED_0 = &H80&
Private Const WAIT_TIMEOUT = &H102&
Private Const SW_SHOW = 5
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
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 Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal
dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal
hHandle As Long, ByVal dwMilliseconds As Long) As Long
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
Private Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess
As Long, ByVal dwMilliseconds As Long) As Long
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
Private Sub cmdCreateProcess_Click()
Dim res&
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
sinfo.cb = Len(sinfo)
sinfo.lpReserved = vbNullString
sinfo.lpDesktop = vbNullString
sinfo.lpTitle = vbNullString
sinfo.dwFlags = 0
lblStatus(1).Caption = "Launching"
lblStatus(1).Refresh
res = CreateProcessBynum(DemoDirectory & "Shelled1.exe",
vbNullString, 0, 0, True, NORMAL_PRIORITY_CLASS, ByVal 0&,
vbNullString, sinfo, pinfo)
If res Then
lblStatus(1).Caption = "Launched"
WaitForTerm2 pinfo
End If
lblStatus(1).Caption = "Terminated"
End Sub
Private Sub cmdShell_Click()
Dim pid&
lblStatus(0).Caption = "Launching"
lblStatus(0).Refresh
pid = Shell(DemoDirectory & "Shelled1.exe", vbNormalFocus)
If pid <> 0 Then
lblStatus(0).Caption = "Launched"
lblStatus(0).Refresh
WaitForTerm1 pid
End If
lblStatus(0).Caption = "Terminated"
End Sub
' This wait routine freezes the application
' It's clearly not a good way to wait for process
' termination - though if you hid the application
' first it could be very effective.
Private Sub WaitForTerm1(pid&)
Dim phnd&
phnd = OpenProcess(SYNCHRONIZE, 0, pid)
If phnd <> 0 Then
lblStatus(0).Caption = "Waiting for termination"
lblStatus(0).Refresh
Call WaitForSingleObject(phnd, INFINITE)
Call CloseHandle(phnd)
End If
End Sub
' This wait routine allows other application events
' to be processed while waiting for the process to
' complete.
Private Sub WaitForTerm2(pinfo As PROCESS_INFORMATION)
Dim res&
' Let the process initialize
Call WaitForInputIdle(pinfo.hProcess, INFINITE)
' We don't need the thread handle
Call CloseHandle(pinfo.hThread)
' Disable the button to prevent reentrancy
cmdCreateProcess.Enabled = False
lblStatus(1).Caption = "Waiting for termination"
lblStatus(1).Refresh
Do
res = WaitForSingleObject(pinfo.hProcess, 0)
If res <> WAIT_TIMEOUT Then
' No timeout, app is terminated
Exit Do
End If
DoEvents
Loop While True
cmdCreateProcess.Enabled = True
' Kill the last handle of the process
Call CloseHandle(pinfo.hProcess)
End Sub
Private Sub cmdShell2_Click()
Dim pid&
Dim obj As Object
lblStatus(2).Caption = "Launching"
lblStatus(2).Refresh
pid = Shell(DemoDirectory & "Shelled1.exe", vbNormalFocus)
If pid <> 0 Then
Set obj = CreateObject("dwWatcher.dwAppWatch")
obj.SetAppWatch pid
obj.SetAppCallback Me
lblStatus(2).Caption = "Waiting for termination"
cmdShell2.Enabled = False
End If
End Sub
Private Sub cmdShellExecute_Click()
Dim res&
Dim obj As Object
res& = ShellExecute(hwnd, "open", DemoDirectory & "Shelled1.exe",
vbNullString, CurDir$, SW_SHOW)
If res < 32 Then
MsgBox "Unable to shell applicatin"
End If
End Sub
Public Sub dwAppTerminated(obj As Object)
lblStatus(2).Caption = "Terminated"
cmdShell2.Enabled = True
End Sub
Private Sub Form_Load()
DemoDirectory = InputBox$("Enter path of directory containing
Shelled1.exe", , "d:\zdbook3\sourcev5\ch14\")
End Sub
