|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Windows)
|
|
 |
Título da Dica: Como executar outro processo sincronamente "com elegância"
|
 |
|
|
|
Postada em 9/9/2003 por Ð@®l@n
Muitos de vocês já devem conhecer o exemplo clássico de como rodar um outro programa (processo) de dentro de seu programa de forma síncrona, isto é, de modo que o seu programa só continue a execução quando o programa que você inicializou termine (artigo Q129796 da Microsoft).
Porém, vocés também devem ter notado um pequeno problema "estético" quando usamos essa abordagem: o programa "pai" (o que inicializou o outro programa) realmente pára. Pára de tal forma que nem as mensagens de pintura são processadas... O que acontece, então? Se o usuário mexer a janela do programa "filho", as janelas do programa "pai" vão, pouco a pouco, ficando horrivelmente mal pintadas.
Bem, aqui está uma solução para esse problema. Essa parte do código pode ir em um módulo .bas:
Option Explicit
Private Declare Function CreateProcess 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, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, _
pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, _
ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" ( _
lpMsg As MSG) As Long
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const INFINITE As Long = &HFFFF&
Private Const WAIT_OBJECT_0 As Long = &H0&
Private Const QS_PAINT As Long = &H20&
Private Const WM_PAINT As Long = &HF&
Private Const PM_REMOVE As Long = &H1&
Private Const STILL_ACTIVE As Long = &H103&
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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Sub RodarProcessoSincrono( _
ByVal vstrExecutavel As String, _
Optional ByVal vstrParametros As String, _
Optional ByVal vstrDirCorrente As String)
Dim lngRetorno As Long
Dim udtSUI As STARTUPINFO
Dim udtPI As PROCESS_INFORMATION
udtSUI.cb = Len(udtSUI)
lngRetorno = CreateProcess(vstrExecutavel, vstrParametros, _
0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, _
vstrDirCorrente, udtSUI, udtPI)
' Verifica se ocorreu algum erro.
If lngRetorno = 0 Then
If Err.LastDllError = 2 Then
' The system cannot find the file specified.
MsgBox "Não foi possível encontrar o arquivo '" & _
vstrExecutavel & "'.", vbInformation
End If
Exit Sub
End If
' O handle do thread principal do processo já
' pode ser fechado, já que não vamos usá-lo.
lngRetorno = CloseHandle(udtPI.hThread)
Dim lngExitCode As Long
Dim udtMsg As MSG
Do
' A função 'MsgWaitForMultipleObjects' pára a execução da
' aplicação até que o objeto indicado (no caso, um outro
' processo) sinalize (no caso do processo, até que ele seja
' finalizado), ou, que a aplicação receba alguma mensagem
' de pintura de janelas ('WM_PAINT'). Se o processo finalizar,
' a função retornará 'WAIT_OBJECT_0 + 1'.
Do Until MsgWaitForMultipleObjects(1&, udtPI.hProcess, _
0&, INFINITE, QS_PAINT) <> WAIT_OBJECT_0 + 1
' A aplicação recebeu uma mensagem de pintura, então, aqui é
' feita uma simulação do loop de mensagens da aplicação,
' tratando apenas da mensagem 'WM_PAINT', para evitar que a
' tela fique toda "zuada".
Do While PeekMessage(udtMsg, 0&, WM_PAINT, WM_PAINT, PM_REMOVE)
Call DispatchMessage(udtMsg)
Loop
Loop
' Pra se certificar de que o processo realmente
' já foi finalizado.
Call GetExitCodeProcess(udtPI.hProcess, lngExitCode)
Loop While lngExitCode = STILL_ACTIVE
lngRetorno = CloseHandle(udtPI.hProcess)
End Sub
Você pode, então, utilizar a rotina dessa forma:
Private Sub Form_Click()
Call RodarProcessoSincrono("C:\Windows\Notepad.exe", _
" Tips.txt", "C:\Windows")
End Sub
Autor: Lobo
|
|
|
|
|
