FoxPro/Visual FoxPro - Funcion para saber si un FORM o EXE esta corriendo

Pruebenlo!!!!!!!!!!!!!!!
******************************************
Funcion: Is_Run
* Indica si un programa está en ejecución
* Parametros:
* tcprograma - Nombre del programa a comprobar
* Ejemplos:
* llret = Is_Run("GESTION.EXE")
* llret = Is_Run("GESTION")
* Retorno:
* .F. - El programa no está en ejecución
* .T. - El programa está en ejecución
* Notas:
* Si no se pone extensión, se asume EXE por defecto.
*
********************************************************************
* comprueba si consultamos el programa actual en ejecución
* y si se está corriendo solo una vez dice que no se esta ejecutando
* necesita VFP7 o superior
************************************************************
FUNCTION IS_RUN(tcprograma)

#DEFINE PROCESS_VM_READ 16
#DEFINE PROCESS_QUERY_INFORMATION 1024
#DEFINE DWORD 4

*--------------------------------------------------
* Declaración de Funciones API
*--------------------------------------------------
DECLARE INTEGER GetLastError IN kernel32
DECLARE INTEGER CloseHandle IN kernel32 INTEGER Handle
DECLARE INTEGER OpenProcess IN kernel32;
INTEGER dwDesiredAccessas, INTEGER bInheritHandle,;
INTEGER dwProcId
DECLARE INTEGER EnumProcesses IN psapi;
STRING @ lpidProcess, INTEGER cb,;
INTEGER @ cbNeeded
DECLARE INTEGER GetModuleBaseName IN psapi;
INTEGER hProcess, INTEGER hModule,;
STRING @ lpBaseName, INTEGER nSize
DECLARE INTEGER EnumProcessModules IN psapi;
INTEGER hProcess, STRING @ lphModule,;
INTEGER cb, INTEGER @ cbNeeded

LOCAL lcProcBuf, lnBufSize, lnProcessBufRet, lnProcNo, lnProcId,;
hProcess, lcModBuf, lnModBufRet, lcBasename, lcst, llret

LOCAL laprocesos(1,2), lcpbase

tcprograma = UPPER(tcprograma)
IF EMPTY(JUSTEXT(tcprograma))
tcprograma = tcprograma + ".EXE"
ENDIF

lnBufSize = 4096
lcProcBuf = Repli(Chr(0), lnBufSize)
lnProcessBufRet = 0

IF EnumProcesses (@lcProcBuf, lnBufSize, @lnProcessBufRet) = 0
? "Error code:", GetLastError()
RETURN
ENDIF

lcst = ""
FOR lnProcNo=1 TO lnProcessBufRet/DWORD
lnProcId = buf2dword(SUBSTR(lcProcBuf, (lnProcNo-1)*DWORD+1, DWORD))

hProcess = OpenProcess (PROCESS_QUERY_INFORMATION +;
PROCESS_VM_READ, 0, lnProcId)

IF hProcess > 0

lnBufSize = 4096
lcModBuf = Repli(Chr(0), lnBufSize)
lnModBufRet = 0

IF EnumProcessModules(hProcess,@lcModBuf,lnBufSize,@lnModBufRet) > 0

hModule = buf2dword(SUBSTR(lcModBuf,1, DWORD))

lcBasename = SPACE(250)
lnBufSize = GetModuleBaseName (hProcess, hModule,;
@lcBasename, Len(lcBasename))
lcBasename = UPPER(Left (lcBasename, lnBufSize))

lnpos = ASCAN(laprocesos,lcBasename,1,ALEN(laprocesos,1),1,8)

IF lnpos > 0
laprocesos(lnpos,2)=laprocesos(lnpos,2)+1
ELSE
laprocesos(ALEN(laprocesos,1),1)=lcBasename
laprocesos(ALEN(laprocesos,1),2)=1
DIMENSION laprocesos(ALEN(laprocesos,1)+1,2)
ENDIF

ENDIF
= CloseHandle (hProcess)
ENDIF
ENDFOR

DIMENSION laprocesos(ALEN(laprocesos,1)-1,2)
lnpos = ASCAN(laprocesos,tcprograma,1,ALEN(laprocesos,1),1,8)

IF lnpos>0
lcpbase = JUSTFNAME(SYS(16,0))
IF lcpbase=tcprograma
IF laprocesos(lnpos,2)>1
llret = .T.
ELSE
llret = .F.
ENDIF
ELSE
llret = .T.
ENDIF
ELSE
llret = .F.
ENDIF

RETURN llret
ENDFUNC

FUNCTION buf2dword (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
Asc(SUBSTR(lcBuffer, 4,1)) * 16777216
ENDFUNC

Gracias por la rutina funciono perfectamente

Aca les dejo otra rutina, un poco mas compacta:

*------------------------------------------------------------------------------------------------
FUNCTION YaEstaCorriendo( tcEXEName )

LOCAL llRetorno as Boolean, loManager as Object, loStuff as Object

llRetorno = .F.

loManager = GETOBJECT("winmgmts:\\localhost\root\cimv2")
loStuff = loManager.InstancesOf("Win32_process")

FOR EACH PROCESS IN loStuff
IF UPPER( ALLTRIM( PROCESS.NAME ) ) == UPPER( ALLTRIM( tcEXEName ) )
llRetorno = .T.
ENDIF
NEXT

RETURN llRetorno

ENDFUNC

muy buen ejemplo gracias !!!

Gracias por la rutina. Me fue muy útil.