Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: arturo940 en Julio 20, 2014, 05:03:28 am

Título: shellandwait ayuda, no recuerdo :(
Publicado por: arturo940 en Julio 20, 2014, 05:03:28 am
hace tiempo en visualbasic 6 usé un shellandwait con un modulo .bas y luego podia mandarlo a llamar con un simple shellanwait en el form, para poder ejecutar barios programas en secuencia uno tras otro...mas lo perdi junto con todo en mi pc :( y ahora que quiero retomar ese proyecto perdido nisiquiera se de donde lo tome. me ayudarian? lo que necesito es poder ejecutar un programa tras otro algo asi como:

shellandwait=("C:/windows/system32/calc.exe")
shellandwait=("C:/windows/system32/regedit.exe")
shellandwait=("etc...etc...")

tengan me paciencia, soy nuevo y soy aficionado a esto :(
de antemano gracias!
Título: Re:shellandwait ayuda, no recuerdo :(
Publicado por: coco en Julio 20, 2014, 09:09:10 pm
Lo mas sencillo es ejecutar tu aplicacion con "Shell" (metodo nativo de VB6). Si necesitas mas opciones, podes usar el API CreateProcess.
La idea de ambas funciones es ejecutar la aplicacion y obtener su PID (process id). Si devuelve 0 es que no se ejecutó.
Luego, llamar al API WaitForSingleObject, utilizando como parametros el PID y "INFINITE" (asi espera eternamente hasta que el mismo finalize).

te dejo aca parte de mi codigo, que seguramente te va a servir:
Código: (vb) [Seleccionar]
Option Explicit


Private Const INFINITE = &HFFFF
Private Const STARTF_USESHOWWINDOW = &H1

Private Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
End Enum

Private Const NORMAL_PRIORITY_CLASS = &H20

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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Function RunProcess(ByVal sFile As String, ByVal sArguments As String, ByVal sPath As String) As Long
    Dim pStartInfo  As STARTUPINFO
    Dim pProcInfo   As PROCESS_INFORMATION
    Dim pSec1       As SECURITY_ATTRIBUTES
    Dim pSec2       As SECURITY_ATTRIBUTES

    RunProcess = -1
   
    pSec1.nLength = Len(pSec1)
    pSec2.nLength = Len(pSec2)
   
    With pStartInfo
        .cb = Len(pStartInfo)
        .dwFlags = STARTF_USESHOWWINDOW
        .wShowWindow = 1
    End With
   
    If CreateProcessA(vbNullString, FixPath(sPath) & sFile & " " & sArguments, _
                      pSec1, pSec2, False, NORMAL_PRIORITY_CLASS, 0&, sPath, _
                      pStartInfo, pProcInfo) Then
                     
        RunProcess = pProcInfo.hProcess
    End If
End Function

Public Sub WaitInfinite(ByVal hHandle As Long)
    Call WaitForSingleObject(hHandle, INFINITE)
End Sub

Public Function ShellAndWait(ByVal sFile As String, ByVal sArguments As String, ByVal sPath As String) As Boolean
    Dim lPID    As Long

    lPID = RunProcess(sExec, sParams, sPath)
               
    If lPID = -1 Then
        Debug.Print "Error ejecutando el programa """ & sPath & sExec & """!"
        Exit Function
    End If

    Call WaitInfinite(lPID)

    ShellAndWait = True
End Function

luego, desde tu programa llamas a ShellAndWait con los parametros del archivo ejecutable, su ruta, y los parametros (este ultimo es opcional)

saludos
Título: Re:shellandwait ayuda, no recuerdo :(
Publicado por: arturo940 en Julio 21, 2014, 04:22:50 am
me serviría mucho un ejemplo, como y donde lo pongo? D: por favor...
Título: Re:shellandwait ayuda, no recuerdo :(
Publicado por: raul338 en Julio 21, 2014, 09:30:24 am
Una vez hice un codigo usando shellexecuteex, y usa los mismos parametros que el de coco: EXE, parametros, y lugar donde se va a ejecutar.

Código: (vb) [Seleccionar]
Private Declare Function ShellExecuteExA Lib "shell32" (lpExecInfo As SHELLEXECUTEINFO) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
 
Private Type SHELLEXECUTEINFO
  cbSize As Long
  fMask As Long
  hwnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type
 
Private Const SEE_MASK_FLAG_NO_UI = &H400
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_CLASSNAME = &H1
Private Const WAIT_TIMEOUT = &H102
Private Const SW_HIDE = 0
 
Public Sub ShellWait(ByVal sFile As String, ByVal sParams As String, ByVal sDir As String)
    Dim Retval As Long, ShExInfo As SHELLEXECUTEINFO
    With ShExInfo
        .cbSize = Len(ShExInfo)
        .fMask = 0 'SEE_MASK_FLAG_NO_UI Or SEE_MASK_CLASSNAME Or SEE_MASK_NOCLOSEPROCESS ' No recuerdo porque lo desactive...
       .hwnd = 0
        .lpVerb = "open"
        .lpFile = sFile
        .lpParameters = sParams
        .lpDirectory = sDir
        .nShow = SW_HIDE
    End With
 
    Retval = ShellExecuteExA(ShExInfo)
    If Retval = 0 Then
         ' Error... reportenlo a su modo xD
   Else
        Do
            DoEvents
        Loop Until WaitForSingleObject(ShExInfo.hProcess, 0) < WAIT_TIMEOUT
    End If
End Sub

Fuente y Ejemplo de lllamada (http://leandroascierto.com/foro/index.php?topic=1673.msg9448#msg9448)