FoxPro/Visual FoxPro - Impedir q pueda arrancar mas de una vez mi aplic

Hola a todos, mi pregunta es como puedo Impedir que se pueda arrancar mas de una vez mi aplicación

Este es el código del programa inicio, que alguien se conduela de mi, gracias por anticipadas.

CLOSE ALL
CLEAR ALL
SET ESCAPE OFF
SET CENTURY ON
SET DATE TO DMY
SET NOTIFY OFF
SET TALK OFF
SET DELETED ON
SET DECIMALS TO 2

LOCAL lcNewDir

*!* Ir al directorio del ejecutable
lcNewDir = JUSTPATH(SYS(16, 0))
CD (lcNewDir)
SET DEFAULT TO (lcNewDir)

SET EXACT ON
SET EXCLUSIVE OFF
SET MULTILOCKS ON
SET SYSMENU OFF
SET STATUS BAR OFF


ON SHUTDOWN quit
CLOSE ALL

PUBLIC ADMINI,RECTOR,SECRET, _VentanasOpen

_VentanasOpen = 0
SET PATH TO ;Base_Dato;Menu;Icono;Mantenimientos;Progrmas;Ayuda_
SET CLASSLIB TO ("\ToolBars") ADDITIVE
use compañia
GO TOP
fondo = ALLTRIM(compañia.fondo)
WITH _Screen
.LockScreen = .F.
.BackColor = RGB(255,255,255)
.BorderStyle = 2
.Closable = .T.
.ControlBox = .T.
.MaxButton = .T.
.MinButton = .T.
.WindowState = 2
.Movable = .T.
.Caption = " InscriSoft S.A." && Set a caption
.ShowTips = .T.
.icon = '\Icono\APPS.ico'
.Picture = fondo&&'C:\Trabajo_Practico\Icono\Bandera_Fondo.bmp'
ENDWITH

PUBLIC MiBarra, Usuario
MiBarra = CREATEOBJECT("Barra")
MIBARRA.DOCK(0)

DO FORM entrada

READ EVENTS
PROCEDURE SALIR

IF MESSAGEBOX('Realmente Desea Salir Del Sistema?',36,'Cenoví Compu Center,CECOMCE ') = 7
RETURN
ELSE
SET SYSMENU TO DEFAULT
RELEASE MiBarra
CANCEL
CLOSE ALL
QUIT
ENDIF
ENDPROC

Utiliza la función que te viene más abajo.

IF is_run("nombredelexe")=.t.
MESSAGEBOX("Error: Ya se está ejecutando el programa),16,"Aviso")
ELSE
do form entrada
endif



***********************************************************************************
************************************************************
* 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.
*
* Adaptación de código realizado por Carlos Salina
* http://www.portalfox.com/article.php?sid=329
* Creación : 14/02/2006 Pablo Roca
* Ultima Modificacion: 25/02/2006 Pablo Roca
*
* 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

Añadele a tu prinicipal esto


W_CAPTION=" mI Programa "+ALLTRIM(mEMPRESA)+" "+SPACE(50-LEN(ALLTRIM(mEMPRESA)))
DECLARE INTEGER FindWindow IN WIN32API STRING cNULL,STRING cWINNAME
IF FindWindow(0,W_CAPTION) # 0
MESSAGEBOX("Aplicaccion En Uso En Esta P.C.",16,"ERROR")
CLOSE TABLES ALL
CLOSE ALL
CLEAR ALL
QUIT
ENDIF

SUERTE

yo resolvi eso cojiendo el main de el ejemplo de tastrade que trae el visual
el no permite correrlo mas de una vez

Hola a Todos y no entiendo mucho, disculpen mi torpeza,

Muy atentamente simón

Este el Código del Programa Inicio, lo quiero es que mi programa no se ejecute mas de una vez

CLOSE ALL
CLEAR ALL
SET ESCAPE OFF
SET CENTURY ON
SET DATE TO DMY
SET NOTIFY OFF
SET TALK OFF
SET DELETED ON
SET DECIMALS TO 2

LOCAL lcNewDir

*!* Ir al directorio del ejecutable
lcNewDir = JUSTPATH(SYS(16, 0))
CD (lcNewDir)
SET DEFAULT TO (lcNewDir)

SET EXACT ON
SET EXCLUSIVE OFF
SET MULTILOCKS ON
SET SYSMENU OFF
SET STATUS BAR OFF

*SET HELP TO "C:\Trabajo_Practico\Ayuda_\InscriSoftAyuda.Chm"
*SET HELP ON

ON SHUTDOWN quit
CLOSE ALL

PUBLIC ADMINI,RECTOR,SECRET, _VentanasOpen

_VentanasOpen = 0
SET PATH TO ;Base_Dato;Menu;Icono;Mantenimientos;Progrmas;Ayuda_
SET CLASSLIB TO ("\ToolBars") ADDITIVE
use compañia
GO TOP
fondo = ALLTRIM(compañia.fondo)
WITH _Screen
.LockScreen = .F.
.BackColor = RGB(255,255,255)
.BorderStyle = 2
.Closable = .T.
.ControlBox = .T.
.MaxButton = .T.
.MinButton = .T.
.WindowState = 2
.Movable = .T.
.Caption = " InscriSoft S.A." && Set a caption
.ShowTips = .T.
.icon = '\Icono\APPS.ico'
.Picture = fondo&&'C:\Trabajo_Practico\Icono\Bandera_Fondo.bmp'
ENDWITH
*_screen.AddObject("Link","Hyperlink")

PUBLIC MiBarra, Usuario
MiBarra = CREATEOBJECT("Barra")
MIBARRA.DOCK(0)
*MIBARRA.TOP = 0

DO FORM entrada

READ EVENTS
PROCEDURE SALIR
*PROCEDURE Salida
IF MESSAGEBOX('Realmente Desea Salir Del Sistema?',36,'Cenoví Compu Center,CECOMCE ') = 7
RETURN
ELSE
SET SYSMENU TO DEFAULT
RELEASE MiBarra
CANCEL
CLOSE ALL
QUIT
ENDIF
ENDPROC