Ejecutar Exe con Funcion determinada

[seba123neo]

este modulo lo hizo cobein , aca lo pongo porque no encontre el proyecto para bajarlo...todos los creditos a el..

Código (vb) [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Module      : mReadCommandLine
' DateTime    : 26/12/2007 22:48
' Author      : Me and some others :D
' Mail        : cobein27@hotmail.com
' Purpose     : Read command line parameters from an external proc
' Requirements: None
'---------------------------------------------------------------------------------------
Option Explicit

Private Type OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As Long
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type

Private Type CLIENT_ID
    UniqueProcess As Long
    UniqueThread  As Long
End Type

Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * 260
End Type

Private Declare Function NtOpenProcess Lib "NTDLL.DLL" (ByRef ProcessHandle As Long, ByVal AccessMask As Long, ByRef ObjectAttributes As OBJECT_ATTRIBUTES, ByRef ClientID As CLIENT_ID) As Long
Private Declare Function NtClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Const TH32CS_SNAPPROCESS = &H2

Public Function ProcessCommandLine(ByVal lProcessId As Long) As String
    Dim tCLIENT_ID              As CLIENT_ID
    Dim tOBJECT_ATTRIBUTES      As OBJECT_ATTRIBUTES
    Dim lRet                    As Long
    Dim sData                   As String
    Dim lProcess                As Long
    Dim lAddress                As Long
    Dim lRead                   As Long
   
    tOBJECT_ATTRIBUTES.Length = Len(tOBJECT_ATTRIBUTES)
    tCLIENT_ID.UniqueProcess = lProcessId
   
    lRet = NtOpenProcess(lProcess, &H10, tOBJECT_ATTRIBUTES, tCLIENT_ID)
    If lProcess = 0 Then Exit Function

    lAddress = GetProcAddress(GetModuleHandle("kernel32"), "GetCommandLineA")
   
    Call CopyMemory(lAddress, ByVal lAddress + 1, &H4)
   
    If ReadProcessMemory(lProcess, ByVal lAddress, lAddress, 4, lRead) Then
        sData = String(260, vbNullChar)
        If ReadProcessMemory(lProcess, ByVal lAddress, ByVal sData, 260, lRead) Then
            ProcessCommandLine = Left(sData, InStr(sData, vbNullChar) - 1)
        End If
    End If

    Call NtClose(lProcess)
   
End Function


Public Function ObtenerPID(ByVal sEXE As String) As Long
    Dim bCopied As Long, lSnapShot As Long
    Dim sName As String
    Dim tPE As PROCESSENTRY32
   
    lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    If lSnapShot < 0 Then Exit Function
    tPE.dwSize = Len(tPE)
    bCopied = Process32First(lSnapShot, tPE)
    Do While bCopied
        sName = Left$(tPE.szExeFile, InStr(tPE.szExeFile, Chr(0)) - 1)
        sName = Mid(sName, InStrRev(sName, "\") + 1)
        If InStr(sName, Chr(0)) Then
          sName = Left(sName, InStr(sName, Chr(0)) - 1)
        End If
        bCopied = Process32Next(lSnapShot, tPE)
        If StrComp(sEXE, sName, vbTextCompare) = 0 Then
          ObtenerPID = tPE.th32ProcessID
          Exit Do
        End If
    Loop
End Function


eso obtiene los comandos...para hacer funcionarlo tenes que pasarle el PID del proceso que queres saber...para eso hay api's busca que hay en internet...

saludos.

[ranslsad]

eso obtiene los comandos...para hacer funcionarlo tenes que pasarle el PID del proceso que queres saber...para eso hay api's busca que hay en internet...

saludos.

Bueno gracias .. pero igual no supe utilizarlo.. por ahora
conseguir averiguar el PID del Exe con Este codigo:

En Modulo:

Código (vb) [Seleccionar] Expandir

Option Explicit
Public theid As Integer
Public Const NORMAL_PRIORITY_CLASS As Long = &H20

Public 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
Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Public Declare Function CreateProcess Lib "kernel32" Alias _
"CreateProcessA" (ByVal lpAppName 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

' Returns 0 when successful, process ID and handle are in ProcessInfo
Public Function StartProcess(ByRef sCommandLine As String, _
ByRef ProcessInfo As PROCESS_INFORMATION) As Long
Dim ret As Long
Dim sWokingDir As String
Dim Start As STARTUPINFO

If Len(sCommandLine) > 0 Then
' Initialize the STARTUPINFO structure:
Start.cb = Len(Start)
sWokingDir = App.Path

' Start the process
ret = CreateProcess(vbNullString, sCommandLine, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, sWokingDir, Start, ProcessInfo)
If ret <> 0 Then
' Success
StartProcess = 0
Else
' Failed to start process
Debug.Print "StartProcess failed: LastDllError = " & _
Err.LastDllError
StartProcess = 1
End If
End If
End Function

' Close process and thread handles, must be called when no longer needed
Public Sub ReleaseProcessData(ByRef ProcessInfo As PROCESS_INFORMATION)
If ProcessInfo.hProcess <> 0 Then
'CloseHandle ProcessInfo.hThread
'CloseHandle ProcessInfo.hProcess
'ProcessInfo.hProcess = 0
'ProcessInfo.hThread = 0
End If
End Sub

En Form:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Sub Command1_Click()
Dim ProcessInfo As PROCESS_INFORMATION

StartProcess "C:\Archivos de programa\Black Isle\BGII - SoA\baldur.exe", ProcessInfo
Text1.Text = "Process ID: " & ProcessInfo.dwProcessId
Text1.Text = Text1.Text & vbNewLine & "Process handle: " & ProcessInfo.hProcess

ReleaseProcessData ProcessInfo
End Sub


Con eso saco el ID del exe...
Y nose si soy un poco Ignorante o no me doy cuenta,
pero a tu codigo intente de llamarlo asi:

Código (vb) [Seleccionar] Expandir

Private Sub Command2_Click()
ProcessCommandLine(theid)
End Sub

Pero nada sucede... Quizas no se le llame asi o quizas si.. pero nose...

Yo en teoria lo que intento de conseguir es por ejemplo:
Ejecutar Baldurs Gate II Shadows Of Amn y que directamente al ejecutar el juego entre a una partida multijugador como ya dije antes estilo (Zone o el Nuevo IGZones)
Si alguien lo conoce seguro que saben a que me refiero(jugar age of empires en internet)

PD: llame a la funcion asi:

Código (vb) [Seleccionar] Expandir

MsgBox ProcessCommandLine(theid)
Mmm pero me muestra la direccion del Juego(Dir del Exe)
PD2: Me di cuenta que el archivo Baldur.exe es un launcher y el archivo BGMain.exe es el juego en Si... pero al intentar de ejecutar ese exe me tira el siguiente error:

Quizas haya que ejecutar ese exe con un parametro.. ahora me queda averiguar como averiguarlo hehe.
PD3: Si voy a la carpeta y hago doble click sobre el archivo BGMain.exe.. si se abre...
PD4: Bueno he ejecutado el BGMain.exe normal, he conseguido su PID y he hecho un timer con la siguiente funcion:

Código (vb) [Seleccionar] Expandir

List1.AddItem ProcessCommandLine(theid)
la cual funcionaba mientras yo en el juego toqueteaba botones y eso.. pero no muestra nada...
No se como hacer funcionar este codigo 

Desde ya, gracias y sepan disculpar mi ignorancia

Salu2

Ranslsad

[seba123neo]

ahi edite el post anterior y agrege para obtener el PID de un proceso segun su nombre...y lo unico que tendrias que hacer es:

Código (vb) [Seleccionar] Expandir

MsgBox ProcessCommandLine(ObtenerPID("calc.exe"))

saludos.

[BlackZeroX]

OTra forma aparte de la que te proporsionaron es sustituir el EXE de tu juego por un EXE que le haga de intermediario es decir algo asi:

Modulo:

Código (vb) [Seleccionar] Expandir


Sub Main()
    Dim RutEXE As String, RutEXEParam As String
    ' Un Fix si App.patch devuelve \ al final, claro ejemplo C:\ u otra unidad.
    RutEXE = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
    RutEXEParam = RutEXE & "APP.exe " & Command$
    Open RutEXE & "Log_Parametros.log" For Binary As 1
        Seek 1, LOF(1) + 1
        Put 1, , RutEXEParam & vbNewLine
    Close 1
    Shell RutEXEParam, vbNormalFocus
End Sub


Es facil compila este codigo con el mismo nombre y en dado caso extensión si es requerido por el exe a ver sus parametros directamente

El Archivo que es lanzado habitualmente es un EXE cambiale el nombre a App.exe y este que has compilado ponlo en su lugar, todo ira normal como si nada solo que ese exe intermediario registrara TODOS los parametros antes de ejecutar el eXE Original pedido por tu launcher. es a prueba de error.¡!

[ranslsad]

OTra forma aparte de la que te proporsionaron es sustituir el EXE de tu juego por un EXE que le haga de intermediario es decir algo asi:

Modulo:

Código (vb) [Seleccionar] Expandir


Sub Main()
    Dim RutEXE As String, RutEXEParam As String
    ' Un Fix si App.patch devuelve \ al final, claro ejemplo C:\ u otra unidad.
    RutEXE = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
    RutEXEParam = RutEXE & "APP.exe " & Command$
    Open RutEXE & "Log_Parametros.log" For Binary As 1
        Seek 1, LOF(1) + 1
        Put 1, , RutEXEParam & vbNewLine
    Close 1
    Shell RutEXEParam, vbNormalFocus
End Sub


Es facil compila este codigo con el mismo nombre y en dado caso extensión si es requerido por el exe a ver sus parametros directamente

El Archivo que es lanzado habitualmente es un EXE cambiale el nombre a App.exe y este que has compilado ponlo en su lugar, todo ira normal como si nada solo que ese exe intermediario registrara TODOS los parametros antes de ejecutar el eXE Original pedido por tu launcher. es a prueba de error.¡!

Bueno les comento como hice todo....
Primero baje el GameSpy que tiene los comandos para tal juego =)
Luego utilice el codigo de ░▒▓BlackZeroҖ▓▒░ [Te amo ] que es la caña!!
Y ya tengo el comando!!!!

Gracias a todos!!!!!

Salu2

Ranslsad