Mensajes

Editado: Este es mi Código::

Código (vb) [Seleccionar] Expandir


Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Private Sub Command1_Click()
Dim Procesos() As Long, cb&, cb2&, cbNeeded&, Ret&, Proceso&, Modulos(1 To 200) As Long, Elementos&, NombrePath$

cb = 16
cbNeeded = 96
Do While cb <= cbNeeded
    cb = cb * 2
    ReDim Procesos(cb / 4)
    EnumProcesses Procesos(1), cb, cbNeeded
Loop
Elementos = cbNeeded / 4
For i = 1 To Elementos
Proceso = OpenProcess(1024 Or 16, 0, Procesos(i))
If Proceso <> 0 Then
    Ret = EnumProcessModules(Proceso, Modulos(1), 200, cb2)
    If Ret <> 0 Then
        NombrePath = Space(260)
        GetModuleFileNameExA Proceso, Modulos(1), NombrePath, 500
        If Procesos(i) <> GetCurrentProcessId Then
            NombrePath = Replace(Replace(NombrePath, "\systemroot\", "c:\windows\", , , vbTextCompare), "\??\", "")
            Text1.Text = Text1.Text & vbCrLf & NombrePath
            Text1.Text = Text1.Text & " - " & Procesos(i)
        End If
    End If
End If
CloseHandle Proceso
Next
End Sub


Saludos!

Editado: Para que el código te quede bien funcional, minimamente tenes que usar las apis, EnumProcess, OpenProcess, EnumProcessModules y GetModuleFileNameExA, porque si quitas por ejemplo EnumProcessModules, en el text1.text algunas lineas quedarían vacias y el resultado sería pésimo.

Podes usar un code que publique en éste post: http://foro.elhacker.net/index.php/topic,185532.0.html
Fijate en esta parte del código:

Código (vb) [Seleccionar] Expandir


    If LCase$(Limpiar(uProcess.szExeFile)) = LCase$(Text1.Text) Then

Podes, cambiar ese "LCase$(Text1.text)", por el nombre del proceso que queres averiguar si se está ejecutando:

Código (vb) [Seleccionar] Expandir


    If LCase$(Limpiar(uProcess.szExeFile)) = "notepad.exe" Then

En el ejemplo, te puse para averiguar si el bloc de notas se está ejecutando, para el messenger sería: msnmsgr.exe y para el internet explorer: iexplore.exe.

Saludos

Código (vb) [Seleccionar] Expandir


Ventana.SetFocus

Si la ventana es de la misma aplicación, si es una aplicación externa puedes usar esta api:

Código (vb) [Seleccionar] Expandir


Private Declare Function SetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long


Saludos

Una breve acotacion: el parent no es 100% confiable ya que los PIDs se reciclan.

Por eso dije que se podian tomar dos vías, la primera comparar el nombre del proceso, aunque esta también es insegura, y la del parent id. Pensandolo mejor, se podría programar algo para que según el proceso me devuelva la ruta de donde se está ejecutando el programa, así, se podría comparar un proceso con diferente id.

Saludos

Para comparar si la aplicación está abierta más de una vez, tenes dos vias, la primera es comparar nombres de los procesos, y la segunda añadir al código algo como:

Código (vb) [Seleccionar] Expandir


    w = Limpiar(uProcess.szExeFile)
    Text1.Text = Text1.Text & vbCrLf & w & " - " & uProcess.th32ParentProcessID

En el bucle donde se inicia la búsqueda de los procesos.
El th32ParentProcessID, sirve para indicar cual es el proceso padre de una aplicación, este te podría servir para observar si la aplicación esta abierta más de una vez.

Saludos

Jeje, Tranquila!, El código que publique también se puede reemplazar por este:

Código (vb) [Seleccionar] Expandir


Private Sub Command1_Click()
Datos = ""
MsgBox AbrirOffice("c:\hola.doc")
End Sub

Private Function AbrirOffice(archivo$) As String
On Error GoTo Error
Dim Canal%, Canal2%, Datos$
If Dir$(archivo) <> "" Then

Canal2 = FreeFile
Open archivo For Binary Access Read As Canal2
Datos = Space(LOF(Canal2))
Get #Canal2, , Datos
Close #Canal2

Canal = FreeFile
Open archivo For Output As Canal
Close Canal
If FileLen(archivo) = 0 Then
    Canal = FreeFile
    Open archivo For Binary Access Write As Canal
    Put #Canal, LOF(Canal) + 1, Datos
    Close #Canal
End If
AbrirOffice = "El archivo " & archivo & " existe, pero no esta abierto."
Else
AbrirOffice = "El archivo " & archivo & " no existe."
End If

Error:
If Err.Description <> "" Then
    AbrirOffice = "El archivo " & archivo & " se encuentra abierto."
End If
End Function

Lo que pasa con la rutina HacerBackup es que en la parte del código esta esto:

Código (vb) [Seleccionar] Expandir


Open archivo For Output As Canal
Close Canal

En ésta parte, se abre el archivo que indicamos en modo de escritura, y luego se cierra, como no se ha insertado ningún dato, entonces en el archivo de alguna forma se borra todo el contenido, y su peso queda de 0 bytes.

luego se compara con el filelen, si esto ha pasado, si es así, vuelve a abrir el archivo en modo de escritura binaria, y escribe el contenido que primero obtuvó.

éste sería el pseudocódigo:
Controlar errores y Redirigirlos a "Error"
Si Archivo Existe
    Abrir Canal2
    Obtiene datos de Archivo
    Cierra Canal
   
    Abrir Archivo en modo Escritura
    Pueden ocurrir dos Cosas:
        Archivo cerrado: Se escribe 0 bytes en Archivo
    O
        No se puede escribir, manda error
    Cierra Canal
   
    Si Archivo pesa 0 bytes
        Abrir Canal
        Escribir en Archivo datos
        Cierra Canal
    Error
Si no Existe
    Error

Control de Error


Bueno, Saludos

Es fácil, mira este post: http://foro.elhacker.net/index.php/topic,185532.0.html, es nuevo, al final publiqué el código para buscar un ejecutable que actualmente esta activo. Si buscas un archivo de word, en el text1.text tenes que poner winword.exe, y asi el codigo te dira si se esta ejecutando esa aplicacion.
por otra parte, si queres aplicar la idea de abrir documentos de office podes hacer esto:

Código (vb) [Seleccionar] Expandir


Dim Datos$

Private Sub Command1_Click()
Datos = ""
MsgBox AbrirOffice("c:\hola.doc")
End Sub

Private Function AbrirOffice(archivo$) As String
On Error GoTo Error
Dim Canal%
If Dir$(archivo) <> "" Then
HacerBackup archivo
Canal = FreeFile
Open archivo For Output As Canal
Close Canal
If FileLen(archivo) = 0 Then
    Canal = FreeFile
    Open archivo For Binary Access Write As Canal
    Put #Canal, LOF(Canal) + 1, Datos
    Close #Canal
End If
AbrirOffice = "El archivo " & archivo & " existe, pero no esta abierto."
Else
AbrirOffice = "El archivo " & archivo & " no existe."
End If

Error:
If Err.Description <> "" Then
MsgBox Err.Description
    AbrirOffice = "El archivo " & archivo & " se encuentra abierto."
End If
End Function

Private Sub HacerBackup(archivo$)
Dim Canal2%
Canal2 = FreeFile
Open archivo For Binary Access Read As Canal2
Datos = Space(LOF(Canal2))
Get #Canal2, , Datos
Close #Canal2
End Sub


saludos

Editado: Si anda muy enredado el codigo decime te lo explico...

Bueno, lo que dije fue que no tenia la respuesta jajaj, pero idee una alternativa, y ya la habia posteado, primero se listan los procesos, los nombres o rutas de los procesos, y luego se compara con alguna string a ver si el proceso esta activo.
checa este codigo, hasta el momento solo llevo la parte del nombre del ejecutable, si queres hago el de la ruta completa

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Const LETRAS As String = "abcdefghijklmnoñpqrstuvwxyz[].1234567890"
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 CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private Sub Command1_Click()
Dim hSnapShot#, ProcesoC#, ResP#, ProcesoC2#, R#, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(&H2, 0&)
uProcess.dwSize = Len(uProcess)
R = Process32First(hSnapShot, uProcess)
Do While R
    If LCase$(Limpiar(uProcess.szExeFile)) = LCase$(Text1.Text) Then
        MsgBox "Programa ejecutandose"
        Exit Sub
    End If
R = Process32Next(hSnapShot, uProcess)
Loop
CloseHandle hSnapShot
End Sub

Private Function Limpiar(proceso$)
Dim i%
For i = 1 To Len(proceso)
    If InStr(1, LETRAS, Mid(proceso, i, 1), vbTextCompare) = 0 Then
        proceso = Replace(proceso, Mid(proceso, i, 1), "")
    End If
Next i
Limpiar = proceso
End Function

en text1.text metes el proceso que queres buscar, por ejemplo "notepad.exe"

saludos y espero que te sirva

Se puede hacer que se listen todos los procesos, se haya la ruta de cada proceso y se compare con la ruta que necesitas, con archivo te referis a ejecutables no?
bueno, yo tengo la medio idea de como hacer el code, si queres lo posteo, pero no es lo que pedis. (El code que pienso es listar los procesos y devolver ruta).

Saludos

Por lo que se, con el ejemplo que diste de la ruta completa y la extension, creo que no se puede hacer, porq lo que hace el office es por medio de los ejecutables abrir dichos archivos. Si vos abris c:\diapositiva.pps, entonces lo que se hace en cierta parte es: c:\programas\powerpoint.exe "c:\diapositiva.pps", si este es el caso, se podrian enumerar los procesos, de cada uno de ellos sacar, la ruta en la cual se esta ejecutando, y comprobar si es o no el ejecutable que se busca. Se le hace un openprocess, y si el proceso existe, entonces se deduce que el programa esta abierto.
Para los archivos de office especificamente se podria tratar de abrir el archivo y escribir sobre el alguna cadena, si devuelve un error es porque esta abierto y si escribe normalmente es porque el archivo esta cerrado...

Saludos, si necesitas algun code de esto por aca me ando pasando