******************************************
* FUNCTION IS_RUN(tcprograma)
* 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
Crear cuenta