Como fazer com que o programa não seja executado duas vezes?
Se o programa já estiver sendo executado deve impedir que ele seja executado outra vez.
Eu acho o jeito mais facil é verificar se existe um arquivo de controle no disco, se nao existir, criar um arquivo no disco na abertura do programa , dai se outra copia for aberta, vai verificar que o arquivo ja existe e cai fora. Importante, o programa so deve sair ao apagar o arquivo, para nao dar problema.
Por exemplo
PROCEDURE Main()
LOCAL cLockFile := "programa.lock"
LOCAL hFile
// Tenta criar o arquivo de trava
IF File(cLockFile)
? "O programa já está em execução."
RETURN
ENDIF
// Cria o arquivo de trava
hFile := FCreate(cLockFile)
IF hFile == -1
? "Não foi possível criar o arquivo de trava."
RETURN
ENDIF
// Executa o programa principal
? "Programa em execução..."
// Aqui vem o código principal do seu sistema
// Aguarda uma tecla para simular o uso
Inkey(0)
// Ao sair, remove o arquivo de trava
FClose(hFile)
FErase(cLockFile)
RETURN
1 curtida
Buen día
Lo hago de esta forma en windows modo consola
Al principio del programa después de mi conexión a la base de datos
sql server 2019 y/o postgres
Procedure Main()
IF EstaRodando()
CLS
SETMODE(25,80)
PLSWAIT(.T.,"El sistema se esta ejecutando. Saliendo ...")
INKEY(2)
PLSWAIT(.F.)
SR_EndConnection(nCnn)
CLS
QUIT
ENDIF
Return
//---------------------
FUNCTION EstaRodando()
LOCAL aProcs:={}, lEstaRodando:=.F., nVezes:=0, cExeName
cExeName:=SubStr(HB_ArgV(0), RAT("\", HB_ArgV(0)) + 1 )
WIN_GETPROCESSLIST( aProcs, cExeName )
AEval( aProcs, {|x| nVezes++ } )
IF nVezes > 1
lEstaRodando:=.T.
ENDIF
RETURN lEstaRodando
Saludos!!
1 curtida
O chatgpt me deu essa mesma solução ontem, testei no servidor e deu certo, mas falta testar em pelo menos 1 ou 2 computadores clientes onde os usuários do sistema trabalham. No caso para multiusuário o nome do arquivo programa.lock precisa incorportar o nome de usuário do Windows. Também é interessante colocar hFile e cLockFile como variável pública para chamar essa parte do fechamento em uma rotina EXIT PROCEDURE para garantir que ele sempre será executado saindo por bem ou por mal (dando erro) do programa.
FUNCTION MAIN()
************************************************************************
*** IMPEDIR QUE O PROGRAMA SEJA EXECUTADO DUAS VEZES PELO MESMO USUÁRIO
************************************************************************
LOCAL cUser
PUBLIC nHNOTWICE, cLockFile
***************************************************
*** TOCAR SOM: SNDPLAYSOUND( cWavTada, 1 )
***************************************************
*** SOM OK
PUBLIC cWavTada, cWavOk, cWavErro
cWavTada := "c:\windows\media\tada.wav"
cWavOk := "c:\windows\media\Windows Logon.wav"
*** SOM ERRO
cWavErro := "c:\windows\media\Windows Foreground.wav"
***************************************************
************************************************************************
*** IMPEDIR QUE O PROGRAMA SEJA EXECUTADO DUAS VEZES PELO MESMO USUÁRIO
************************************************************************
cUser := GetEnv("USERNAME")
cLockFile := "LOCK_" + cUser + ".LCK"
// Tenta criar o arquivo de lock exclusivo
nHNOTWICE := FCreate( cLockFile, FO_EXCLUSIVE + FO_READWRITE )
IF nHNOTWICE == -1
SNDPLAYSOUND( cWavErro, 1 )
Alert( "Já existe uma instância do sistema aberta para o usuário " + cUser + "!" )
RETURN NIL
ENDIF
************************************************************************
EXIT PROCEDURE SAIR
*******************
// A EXIT PROCEDURE é executada sempre que o programa fecha normalmente ou por erro.
// Assim garante que as medidas serão tomadas antes de sair.
DbCommitAll()
SET RELATION TO // DbClearRelation()
DbCloseAll()
CLEAR
SET COLOR to
SETMODE(25,80)
************************************************************************
*** IMPEDIR QUE O PROGRAMA SEJA EXECUTADO DUAS VEZES PELO MESMO USUÁRIO
************************************************************************
// Libera o arquivo de lock
FClose( nHNOTWICE )
FILEDELETE( cLockFile )
************************************************************************
QUIT
Era algo assim que eu estava procurando, uma função que me desse o que já está sendo executado no computador. Vou testar essa WIN_GETPROCESSLIST( aProcs, cExeName ), precisa incluir alguma lib específica ou código pragma para importar comando de linguagem C?
No necesitas ninguna Lib y/o lenguaje C
Tal y como esta funciona
Saludos!!
1 curtida
hbmk2: Linkando... PROGHB32.exe
.hbmk/win/mingw/UTIL.o:UTIL.c:(.data+0x38c8): undefined reference to `HB_FUN_WIN_GETPROCESSLIST'
collect2.exe: error: ld returned 1 exit status
hbmk2[DEV]: Erro: Executando linkeditor. 1
D:\HB32\comp\mingw\bin\gcc.exe .hbmk/win/mingw/CAD.o .hbmk/win/mingw/CHEQ.o .hbmk/win/mingw/CLI.o .hbmk/win/mingw/COM.o .hbmk/win/mingw/DEPO.o .hbmk/win/mingw/DESP.o .hbmk/win/mingw/EST.o .hbmk/win/mingw/ESTREL.o .hbmk/win/mingw/ESTROM.o .hbmk/win/mingw/FIN.o .hbmk/win/mingw/ORC.o .hbmk/win/mingw/PAG.o .hbmk/win/mingw/PED.o .hbmk/win/mingw/PROGRAMA.o .hbmk/win/mingw/REC.o .hbmk/win/mingw/REL.o .hbmk/win/mingw/ROMA.o .hbmk/win/mingw/UTIL.o .hbmk/win/mingw/VEND.o .hbmk/win/mingw/SAMPLES.o .hbmk/win/mingw/hbEMAIL.o .hbmk/win/mingw/_hbmkaut_CAD.o libSIBRAHB32.a libLIB52.a .hbmk/win/mingw/_hbmkaut_CAD.reso -Wl,--allow-multiple-definition -mwindows -Wl,--start-group -lgtwvg -lhbct -lhbwin -lpng -lhbziparc -lhbmzip -lminizip -lhbssl -lssl -lcrypto -lhbmisc -lhbxpp -lhbfoxpro -lxhb -lhbtip -lhbfship -lHBZEBRA -lhbextern -lhbdebug -lhbvmmt -lhbrtl -lhblang -lhbcpage -lgtcgi -lgtpca -lgtstd -lgtwin -lgtwvt -lgtgui -lhbrdd -lhbuddall -lhbusrrdd -lrddntx -lrddcdx -lrddnsx -lrddfpt -lhbrdd -lhbhsx -lhbsix -lhbmacro -lhbcplr -lhbpp -lhbcommon -lhbmainwin -lwinmm -lkernel32 -luser32 -lgdi32 -ladvapi32 -lws2_32 -liphlpapi -lwinspool -lcomctl32 -lcomdlg32 -lshell32 -luuid -lole32 -loleaut32 -lmpr -lmapi32 -limm32 -lmsimg32 -lwininet -lhbpcre -lhbzlib -Wl,--end-group -oPROGHB32.exe -LD:/HB32/lib/win/mingw
hbmk2: Erro: Referenciado, faltando, mas funções desconhecida(s):
WIN_GETPROCESSLIST()
Estou usando Harbour v3.2
Achei esse WIN_GETPROCESSLIST() na web em C++, mas deu erro na compilação.
Aí achei esse outro mais simples que compilou, fíz só alguns ajustes para funcionar como eu queria, ou seja, saber se o programa já estava aberto mais de 1 vez.
Function EstaAberto( cQuem )
Local aProcs := {}, nReturn, nPosi := 0
nReturn := Win_PegaProcessos( aProcs )
If nReturn = 1
Hb_Alert( "Argument error" )
ElseIf nReturn = 2
Hb_Alert("Unable to obtain current process list.")
ElseIf nReturn = 3
Hb_Alert("Error retrieving information about processes.")
EndIf
For x = 1 To Len( aProcs )
If Upper( aProcs[ x, 1 ] ) = Upper( cQuem )
nPosi++
EndIf
Next
Return ( nPosi > 1 ) // Se tiver mais de um aberto retorna .T.
************************
#pragma BEGINDUMP
#include <windows.h>
#include <windef.h>
#include <tlhelp32.h>
#include <hbapi.h>
#include <hbapiitm.h>
/*
WIN_PEGAPROCESSOS( aArray ) -> nResult
Baseada na função WIN_GETPROCESSLIST() by Vailton Renato - 15/12/2009 - 18:58:58
*/
HB_FUNC( WIN_PEGAPROCESSOS )
{
HANDLE hProcessSnap;
PROCESSENTRY32 pe32;
PHB_ITEM pArray = hb_param( 1, HB_IT_ARRAY );
const char * szAppName = hb_parcx(2);
BOOL bCanAdd = TRUE;
if( !pArray )
{
hb_retni( 1 );
return;
}
// Take a snapshot of all processes in the system.
hProcessSnap = CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
if( hProcessSnap == INVALID_HANDLE_VALUE )
{
// CreateToolhelp32Snapshot (of processes)
hb_retni( 2 );
return;
}
// Set the size of the structure before using it.
pe32.dwSize = sizeof( PROCESSENTRY32 );
// Retrieve information about the first process,
// and exit if unsuccessful
if( !Process32First( hProcessSnap, &pe32 ) )
{
hb_retni( 3 );
CloseHandle( hProcessSnap ); // clean the snapshot object
return;
}
// Ignores a empty string on seconds argument
if ( hb_parclen(2) < 1 )
szAppName = NULL;
// Now walk the snapshot of processes, and
// display information about each process in turn
do
{
PHB_ITEM pSubarray;
if (szAppName)
bCanAdd = ( hb_stricmp( szAppName, pe32.szExeFile ) == 0 );
if (bCanAdd)
{
pSubarray = hb_itemNew( NULL );
hb_arrayNew( pSubarray, 1 );
hb_arraySetC ( pSubarray, 1, pe32.szExeFile ); // Process Name
hb_arrayAddForward( pArray, pSubarray );
}
} while( Process32Next( hProcessSnap, &pe32 ) );
CloseHandle( hProcessSnap );
hb_retni( 0 );
return;
}
#pragma ENDDUMP
Daí no FUNCTION MAIN() eu coloquei assim:
IF EstaAberto( "PROGHB32.EXE" )
SNDPLAYSOUND( cWavErro, 1 )
Alert( "Já existe uma instância do sistema aberta para o usuário!")
QUIT
ENDIF
Testei no HB32 o:
cExeName:=SubStr(HB_ArgV(0), RAT("\", HB_ArgV(0)) + 1 )
e deu certinho o nome do executável, vou incorporar no código! Precisou de lib nenhuma.