romfast/vfp_roaauto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
vfp_roaauto/COMUN/programe/quitapp.prg

340 lines
11 KiB
Plaintext
Raw Permalink Blame History

* Program: QUITAPP.PRG
* Description: Client-side of remote termination of applications.
* Created: 07/11/2003
* Developer: Gregory L Reichert
* Copyright: Copyright (c) 2003 GLR software
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
*!* Overview
*!* The component is the client-side portion of a Remote Application Killer.
*!* With the use of a shared table, an network administrator can determine
*!* what workstation has what application running, and instruct that application
*!* to quit.
*!* An administrator can monitor which applications are running, and instruct them
*!* termination themselves.
*!* Instructions
*!* This component is based on a Timer class with a one minute interval. Each minute
*!* the application check to see if the administrator wishs the application to
*!* quit. If discovered so, the countdown begins (default 10 minutes). During the
*!* Countdown, a message is displayed notifing the user that the automatic termination of
*!* the application is underway. They can manual exit the application, or wait for the
*!* automatic. Either way, it is intended for the user to complete their current task.
*!* At the end of the countdown, the application issues a QUIT command.
*!* Call this routine, and a object reference is returned. This object should
*!* remain active throughout the life of the application.
*!* PRIVATE oQuitApp
*!* oQuitApp = QuitApp( "\\MyServer\MyDrive\CommonFiles\" )
*!*
*!* When the administrator wish to terminate one or more application, they place
*!* a True (.T.) in the "lQuit" field of the QuitApp.dbf table. As the Application continues
*!* countdown to automated termination, the "Remain" field indicates the number of minutes
*!* remaining. If the Admin changes the value of "Remain", the countdown continues from
*!* that new value. If a value less then zero (0) is entered, the application terminates
*!* the next time the QuitApp timer is fired.
*!* Two exposed method are provided to inform the routine that the application
*!* is performing critical operations and can not be interupted. These are called
*!* EnterCritical() and LeaveCritical(). The EnterCritical() should be called when the
*!* critical section begins, and the LeaveCritical() should be called when the section
*!* ends.
*!* The administrator can check to see a application is running, or if it crashed before hand,
*!* by set the "aLiveTest" field of the QuitApp.dbf to False (.F.). After a couple of minutes,
*!* if the application is still alive, the field will revert to True (.T.).
*!* The form called Admin_QuitApp.scx is used by the administrator to monitor and control the
*!* remote applications.
*!* =====================================================================================
LPARAMETERS tcPath, tcQuitName
RETURN CREATEOBJECT("QuitApp", tcPath, tcQuitName)
#DEFINE kQuitMax 10 && Wait 10 minutes before auto-quit
*------------------------------------------------------------
* Description: QuitApp class
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
DEFINE CLASS QuitApp AS TIMER
INTERVAL = (60*1000) && check once a minute.
ENABLE = .T.
cPath = tcPath
cQuitName ="QuitApp"
cQFile ="QuitApp"
cAlias = "QuitApp"
&& Full URN to QuitApp.dbf. Must be at a shared network location for all running application to gain access.
*------------------------------------------------------------
* Description: Error Trap
* Parameters: internal
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE ERROR( a,b,c )
*-- ignore all error from this class
RETURN
ENDPROC
*------------------------------------------------------------
* Description: Initializes the timer
* Parameters: cPath: path to the shared QuitApp.dbf - path only
* Return: N/A
* Use: ox = CreateObject( "QuitApp","\\myserver\shared\CommonFiles\" )
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE INIT( cPath, cQuitName )
LOCAL lc
lc = SELECT()
cPath = ADDBS(IIF(EMPTY(cPath),"", cPath))
cQuitName = IIF(EMPTY(cQuitName),"QuitApp",JUSTSTEM(cQuitName))
cQFile = cPath+cQuitName+".dbf"
cAlias = "QuitApp"
this.cPath = cPath
this.cQuitName = cQuitName
this.cQFile = cQFile
this.cAlias = cAlias
*-------------------------------------
* create QuitApp table if missing.
*-------------------------------------
IF NOT FILE(this.cQFile)
SELECT 0
CREATE TABLE (this.cQFile) (ws c(40),ID N(10,0), cCaption c(100),lQuit L, remain N(3), Critical L, aLiveTest L)
USE
ENDIF
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Timer routine
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE TIMER
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
LOCATE FOR ID=_VFP.HWND AND cCaption=_VFP.CAPTION AND NOT DELETED()
IF NOT FOUND()
*-------------------------------------
* Add an instence for this workstation / application
INSERT INTO (this.cQFile) (ws,ID,cCaption,lQuit,remain, Critical, aLiveTest) ;
VALUES ( UPPER(SYS(0)),_VFP.HWND, _VFP.CAPTION, .F., kQuitMax, .F., .T.)
ENDIF
*- Each time, reset the aLiveTest field.
REPLACE aLiveTest WITH .T.
IF NOT Critical AND TXNLEVEL()=0
*- do only if not in Critical Section of the code,
* and not in a Transaction block
IF lQuit
*-------------------------------------
* if still timing out, display remaining time.
*-------------------------------------
IF remain>0
IF remain=kQuitMax
* - if first time displaying the warning, force application on top.
_SCREEN.ALWAYSONTOP=.T.
_SCREEN.ALWAYSONTOP=.F.
ENDIF
*- decrement the counter, and display warning.
REPLACE remain WITH remain -1
osh=CREATEOBJECT('shell.application')
osh.minimazeall
_screen.windowstate=2
WAIT WINDOW NOCLEAR NOWAIT "Programul se va inchide automat in " +ALLTRIM(STR(remain,10))+" minute."
?? CHR(7)
osh.undominimazeall
RELEASE osh
ELSE
*-------------------------------------
* otherwise, quit the application.
*-------------------------------------
USE IN (this.cAlias)
CLEAR EVENTS
glQuit = .T.
QUIT
ENDIF
ELSE
*-------------------------------------
* if nolonger quiing, reset counter.
*-------------------------------------
REPLACE remain WITH kQuitMax
WAIT CLEAR
ENDIF
ENDIF
USE IN (this.cAlias)
THIS.RESET
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Called when entering a Critical Section of the code.
* Parameters: n/a
* Return: True
* Use: <object>.EnterCritical
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE EnterCritical()
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
UPDATE (this.cQFile) SET Critical=.T. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Called when exitting a Critical Section of the code.
* Parameters: n/a
* Return: True
* Use: <object>.LeaveCritical
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE LeaveCritical()
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
UPDATE (this.cQFile) SET Critical=.F. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
*------------------------------------------------------------
* Description: Destroy this object
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 07/11/2003 Gregory L Reichert Initial Creation
*
*------------------------------------------------------------
PROCEDURE DESTROY
*-----------------------------------------------
* On destroy, remove the application reference from the QuitApp table.
*-----------------------------------------------
LOCAL lc
lc = SELECT()
USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias)
SELECT (this.cAlias)
DELETE FROM (this.cQFile) WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION
USE IN (this.cAlias)
SELECT(lc)
ENDPROC
ENDDEFINE
&& ------------------------------INCEPUT: Quit_Automat ------------------------------
*!* Procedura: Quit_Automat
*!* Parametri: tlQuit
*!* Data/Ora generarii: 19/02/2004 12:48
*!* Autor: MARIUS.MUTU
PROCEDURE Quit_Automat
LPARAMETERS tlQuit
IF tlQuit
QUIT
ENDIF
ENDPROC
&& ------------------------------SFARSIT: Quit_Automat ------------------------------
* Eof QUITAPP.PRG
***************************
*!* FUNCTION AppInstance
*!* PARAMETERS WindowName
*!* #DEFINE GW_OWNER 4
*!* #DEFINE GW_HWNDFIRST 0
*!* #DEFINE GW_HWNDNEXT 2
*!* #DEFINE SW_MAXIMIZE 3
*!* #DEFINE SW_NORMAL 1
*!* DECLARE integer SetForegroundWindow in win32api long lnhWnd
*!* DECLARE integer GetWindowText in win32api integer, string, integer
*!* DECLARE integer GetWindow in win32api integer,INTEGER
*!* DECLARE integer IsWindowVisible in win32api integer
*!* DECLARE integer GetActiveWindow in win32api
*!* DECLARE integer ShowWindow in user32 INTEGER lnhWnd, INTEGER lnCmdShow
*!* IsWindEx = .F.
*!* if len(WindowName) < 1
*!* return .t.
*!* endif
*!* foxhwnd = GetActiveWindow()
*!* hwndNext = GetWindow(foxhwnd,GW_HWNDFIRST)
*!* DO WHILE hwndNext <> 0
*!* IF (hwndnext <> foxhwnd .AND. GetWindow(hwndnext,GW_OWNER) = 0)
*!* Stuffer = SPACE(64)
*!* x = GetWindowText(hwndnext,@Stuffer,64)
*!* IF WindowName $ Stuffer
*!* IsWindEx = .T.
*!* =SetForegroundWindow(hwndnext)
*!* =ShowWindow(hwndNext,SW_MAXIMIZE)
*!* EXIT
*!* ENDIF
*!* ENDIF
*!* hwndNext = GetWindow(hwndnext,GW_HWNDNEXT)
*!* ENDDO
*!* RETURN IsWindEx
*!* ENDFUNC
Reference in New Issue View Git Blame Copy Permalink