Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Is an exe running
Message
From
30/07/2012 21:25:32
 
 
To
19/07/2012 09:11:07
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 9 SP2
Miscellaneous
Thread ID:
01548807
Message ID:
01549547
Views:
168
This message has been marked as a message which has helped to the initial question of the thread.
Hi guys, my english not very good, but go write now. :)

One question, you wonder if any program is running, or your program is done in VFP and you want it not to run again?
If not to run your program again when the user tries to run, I create a "Semaphore" via API, was the best solution I found, the code below.

Name PRG is Gerencia.prg
***************************
FUNCTION TooManyInstances(lnInstancesAllowed, lcUniqueSemaphore, lcUniqueProperty, lnNaoMaximizar as Integer)
***************************
*		#DEFINE GW_CHILD                5 && 0x00000005
*		#DEFINE GW_HWNDNEXT                2 && 0x00000002
*		#DEFINE SW_MAXIMIZE                3 && 0x00000003
*		#DEFINE SW_NORMAL                1 && 0x00000002
	#DEFINE WAIT_OBJECT_0            0 && 0x00000000

	LOCAL lcUniqueProperty, lcUniqueSemaphore, lnhSemaphore, lnHwnd, llReturn
	IF PCOUNT() = 0
		lnInstancesAllowed = 1 && default
	ELSE
		lnInstancesAllowed = MAX(lnInstancesAllowed,1) &&At least one
	ENDIF
	DO DeclareAPIs

	*!* The GUIDs below were created using
	*!* the following two lines in the command window
	*!* then it was just a matter of pasting them in
	*!* oTypeLib = CreateObject("scriptlet.typelib")
	*!*    _cliptext = substr(oTypeLib.GUID, 2, 36)
	*!* Thanks Mike Gagnon

*		REMOVI AS DUAS LINHA ABAIXO, PORQUE DEVO GERAR UM PAR DE GUID PARA CADA SISTEMA QUE EU FIZER, ...
*		...E ESTE VALOR SERÁ COLOCADO NA CHAMADA DA FUNÇÃO
*		lcUniqueSemaphore = "968360BF-C7AD-4B62-A045-0A06D597EF18"
*		lcUniqueProperty = "E2429959-D873-4733-8182-7A3F14780A27" && GUID to insure uniqueness

	lnhSemaphore = CreateSemaphore(0,lnInstancesAllowed,lnInstancesAllowed,lcUniqueSemaphore)
	IF lnhSemaphore != 0 AND WaitForSingleObject(lnhSemaphore, 0) != WAIT_OBJECT_0
		DO DeclareMoreAPIs
		llReturn = .T.
		lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
		DO WHILE lnHwnd != 0 && loop through all windows
			IF GetProp(lnHwnd, lcUniqueProperty) = 1  && does window have our unique property?
				BringWindowToTop(lnHwnd)
				IF !lnNaoMaximizar THEN
					ShowWindow(lnHwnd,SW_MAXIMIZE) && or send SW_NORMAL
				ENDIF
				llReturn = .T.
				EXIT
			ENDIF
			lnHwnd = GetWindow(lnHwnd, GW_HWNDNEXT)
		ENDDO
		CloseHandle(lnHwnd)
		CloseHandle(lnhSemaphore)
		CLEAR DLLS "BringWindowToTop", "GetDesktopWindow", ;
		"GetProp", "GetWindow", "ShowWindow", ;
		"CloseHandle"
	ELSE
		=SetProp(_VFP.HWND, lcUniqueProperty, 1)
		_screen.AddProperty("SemaphoreHandle",lnhSemaphore)
		llReturn = .F.
	ENDIF
	CLEAR DLLS "CreateSemaphore", "GetLastError", ;
	"SetProp"
	RETURN (llReturn)
ENDFUNC

***************************
PROCEDURE DeclareAPIs()
***************************
	DECLARE INTEGER CloseHandle IN Kernel32 INTEGER hObject
	DECLARE INTEGER CreateSemaphore IN Kernel32 ;
		INTEGER lpSemaphoreAttributes, INTEGER lInitialCount, ;
		INTEGER lMaximumCount, STRING lpName
	DECLARE INTEGER SetProp IN User32 INTEGER HWND, STRING lpString, INTEGER hData
	DECLARE INTEGER WaitForSingleObject IN kernel32 INTEGER hHandle, INTEGER dwMilliseconds
ENDPROC

***************************
PROCEDURE DeclareMoreAPIs()
***************************
	DECLARE INTEGER BringWindowToTop IN Win32API INTEGER HWND
	DECLARE INTEGER GetDesktopWindow IN User32
	DECLARE INTEGER GetProp IN User32 INTEGER HWND, STRING  lpString
	DECLARE INTEGER GetWindow IN User32 INTEGER HWND, INTEGER uCmd
	DECLARE INTEGER ShowWindow IN Win32API INTEGER HWND, INTEGER nCmdShow
ENDPROC
In "main.prg" use the following command.
IF .NOT. TooManyInstances(1, "171B7747-3210-428D-A994-859B0C673508", "0A1DA789-F9BE-458B-B85C-FD1467EE052E")
....

....
READ EVENTS
ENDIF


	IF PEMSTATUS(_screen,"SemaphoreHandle",5)
		DECLARE INTEGER ReleaseSemaphore IN kernel32 ;
			INTEGER hSemaphore, INTEGER lReleaseCount, INTEGER @lpPreviousCount
		DECLARE INTEGER CloseHandle IN Kernel32 INTEGER hObject
		ReleaseSemaphore(_screen.SemaphoreHandle,1,0)
		CloseHandle(_screen.SemaphoreHandle)
		REMOVEPROPERTY(_screen, "SemaphoreHandle")
	ENDIF
The first parameter indicates the number of instances where you want, put 1.

The second and third parameters are numbers generated by the GUID, in the above code is to generate a new one, because each application must be different.

The fourth parameter is to bring the application to indicate whether or not maximized.
Previous
Reply
Map
View

Click here to load this message in the networking platform