Wiki Home

WScript Shell Run


Namespace: WIN_COM_API

New 2015-09-14 *** WScript.Shell 'Run' compatible replacement for VFP 9



Recently I've got the need for replacing the wscript.shell 'Run' function with a Win 32 API equivalent, so I've modified the procedure made by William GC Steinford and added some stuff taken from others, including Microsoft documentation, and added some garbage collect, so here is the result.

Note: I don't know how this work on 64bit machines using 64bit Chen's compiler. May be the pointers handled need an update.

Added the capability of indicating a Kill-timeout for the executed program on the tbWaitOnReturn parameter in milliseconds, if used a value > 1.

FUNCTION WScriptShell_Run(tcCmdLine as String, tnWindowStyle as Integer, tbWaitOnReturn as Boolean, tlDebug as Logical)
	* 14/09/2015 Fernando D. Bozzo - http://fox.wikis.com/wc.dll?Wiki~WScriptShellRun~VFP
	* Modificación basada en la rutina RunExitCode.prg de William GC Steinford (nov 2002)
	* pero compatible con el método Run de WScript.Shell para su reemplazo cuando no es posible usarlo.
	* http://fox.wikis.com/wc.dll?Wiki~ProcessExitCode
	*-----------------------------------------------------------------------------------------------
	* 'Run' Parameter Documentation at: https://msdn.microsoft.com/en-us/library/d5fk67ky%28v=vs.84%29.aspx
	*
	* NOTA IMPORTANTE:
	* A diferencia del WScript.Shell.Run original, el valor tbWaitOnReturn se comporta como un timeout
	* en milisegundos si se pasa un valor mayor a 1, pasado el cual se mata a la tarea invocada.
	*-----------------------------------------------------------------------------------------------
	* Ej.1: Ejecutar el comando DIR en una consola y enviar la salida stdout a un archivo dir.txt
	* ? WScriptShell_Run("c:\windows\system32\cmd.exe /c dir c:\*.* > \temp\dir.txt")
	*
	*-----------------------------------------------------------------------------------------------
	* Ej.2: Ejecutar la calculadora de Windows en ventana normal y esperar 5 segundos a que el usuario la cierre, o matarla.
	* ? WScriptShell_Run("calc.exe", 5, 5000, .T.)
	*
	*-----------------------------------------------------------------------------------------------
	* Ej.3: Ejecutar la calculadora de Windows en ventana normal y no esperar a su cierre.
	* ? WScriptShell_Run("calc.exe", 5, 0, .T.)
	*
	*-----------------------------------------------------------------------------------------------
	* Ej.4: Ejecutar el Notepad de Windows en ventana maximizada y esperar 15 segundos a que el usuario la cierre, o matarla.
	* ? WScriptShell_Run("notepad.exe", 3, 15000, .T.)
	*
	*-----------------------------------------------------------------------------------------------
	* Ej.5: Ejecutar el Notepad de Windows en ventana maximizada y esperar indefinidamente a que el usuario la cierre, o matarla.
	* ? WScriptShell_Run("notepad.exe", 3, 1, .T.)
	*
	*-----------------------------------------------------------------------------------------------

	LOCAL lnWfSO, ln_dwFlags, ln_wShowWindow, lcStartInfo, lcProcessInfo, ln_hProcess, ln_hThread ;
		, lnExitCode, ln_dwProcessId, ln_dwThreadId, tcProgFile, laDirFile(1,5), lnTimeout

	TRY
		* NOTA: Las constantes para VFP se pueden consultar en http://www.news2news.com/vfp/w32constants.php

		#DEFINE SEE_MASK_NOCLOSEPROCESS  0x00000040
		#DEFINE WAIT_MILLISECOND 3000

		#DEFINE SW_SHOW			5
		#DEFINE STILL_ACTIVE	0x103
		#DEFINE cnINFINITE		0xFFFFFFFF
		#DEFINE cnHalfASecond	500 && milliseconds
		#DEFINE cnTimedOut		0x0102

		*-- Constantes para WaitForSingleObject
		#DEFINE WAIT_ABANDONED	0x00000080
		#DEFINE WAIT_OBJECT_0	0x00000000
		#DEFINE WAIT_TIMEOUT	0x00000102
		#DEFINE WAIT_FAILED		0xFFFFFFFF

		tcProgFile		= EVL(tcProgFile, NULL)
		tcCmdLine		= EVL(tcCmdLine, NULL)
		lnTimeout		= cnINFINITE
		lnExitCode		= 0

		DO CASE
		CASE VARTYPE(tbWaitOnReturn) = "L"
		CASE VARTYPE(tbWaitOnReturn) = "N"
			* Si se indica un valor mayor a 1, se interpreta como "esperar por N milisegundos"
			IF tbWaitOnReturn > 1
				lnTimeout	= tbWaitOnReturn
			ENDIF
			tbWaitOnReturn	= (tbWaitOnReturn >= 1)
		OTHERWISE
			ERROR 'Invalid value for tbWaitOnReturn parameter'
		ENDCASE

		IF VARTYPE(tnWindowStyle) # "N" OR NOT BETWEEN(tnWindowStyle, 0, 10) THEN
			tnWindowStyle	= 10
		ENDIF

		ln_dwFlags		= 1
		ln_wShowWindow	= tnWindowStyle

		* DOCUMENTACIÓN estructura _STARTUPINFO:
		* creates the STARTUP structure to specify main window
		* properties if a new window is created for a new process

		*| typedef struct _STARTUPINFO {
		*|     DWORD   cb;                4
		*|     LPTSTR  lpReserved;        4
		*|     LPTSTR  lpDesktop;         4
		*|     LPTSTR  lpTitle;           4
		*|     DWORD   dwX;               4
		*|     DWORD   dwY;               4
		*|     DWORD   dwXSize;           4
		*|     DWORD   dwYSize;           4
		*|     DWORD   dwXCountChars;     4
		*|     DWORD   dwYCountChars;     4
		*|     DWORD   dwFillAttribute;   4
		*|     DWORD   dwFlags;           4
		*|     WORD    wShowWindow;       2
		*|     WORD    cbReserved2;       2
		*|     LPBYTE  lpReserved2;       4
		*|     HANDLE  hStdInput;         4
		*|     HANDLE  hStdOutput;        4
		*|     HANDLE  hStdError;         4
		*| } STARTUPINFO, *LPSTARTUPINFO; total: 68 bytes
		lcStartInfo	= BINTOC(68,'4RS') ;
			+ BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') ;
			+ BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') ;
			+ BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS') ;
			+ BINTOC(ln_dwFlags,'4RS') ;
			+ BINTOC(ln_wShowWindow,'2RS') ;
			+ BINTOC(0,'2RS') + BINTOC(0,'4RS') ;
			+ BINTOC(0,'4RS') + BINTOC(0,'4RS') + BINTOC(0,'4RS')

		lcProcessInfo = REPLICATE( CHR(0), 16 )

		* DOCUMENTACIÓN estructura _PROCESS_INFORMATION:
		* https://msdn.microsoft.com/en-us/library/windows/desktop/ms684873%28v=vs.85%29.aspx
		*    typedef struct _PROCESS_INFORMATION {
		*        HANDLE hProcess;
		*        HANDLE hThread;
		*        DWORD dwProcessId;
		*        DWORD dwThreadId;
		*    } PROCESS_INFORMATION;
		*

		IF CreateProcess( tcProgFile, tcCmdLine,0,0,0,0,0,0, lcStartInfo, @lcProcessInfo ) = 0

			*-- Segundo intento: Si se definió un archivo (ej: un TXT,LOG,etc) intento lanzarlo
			*-- con la aplicación predeterminada
			IF ADIR(laDirFile, tcCmdLine) = 1 THEN
				LOCAL lcInfo, lnHeap, lnLen, lnPtr

				*-- Ejemplo adaptado de: http://www.foxite.com/archives/0000316611.htm
				lnLen	= LEN(tcCmdLine) + 1
				lnHeap	= GetProcessHeap()
				lnPtr	= HeapAlloc(lnHeap, 0x8, 5 + lnLen)
				SYS(2600, lnPtr, 5, [open] + CHR(0))
				SYS(2600, lnPtr+5, lnLen, tcCmdLine + CHR(0))

				* DOCUMENTACIÓN estructura _SHELLEXECUTEINFO:
				* https://msdn.microsoft.com/en-us/library/windows/desktop/bb759784%28v=vs.85%29.aspx
				*typedef struct _SHELLEXECUTEINFO {
				*    DWORD     cbSize;            4
				*    ULONG     fMask;             4
				*    HWND      hwnd;              4
				*    LPCTSTR   lpVerb;            4
				*    LPCTSTR   lpFile;            4
				*    LPCTSTR   lpParameters;      4
				*    LPCTSTR   lpDirectory;       4
				*    int       nShow;             4
				*    HINSTANCE hInstApp;          4
				*    LPVOID    lpIDList;          4
				*    LPCTSTR   lpClass;           4
				*    HKEY      hkeyClass;         4
				*    DWORD     dwHotKey;          4
				*    union {
				*        HANDLE hIcon;            
				*        HANDLE hMonitor;         
				*    } DUMMYUNIONNAME;            4
				*    HANDLE    hProcess;          4
				*} SHELLEXECUTEINFO, *LPSHELLEXECUTEINFO;
				*

				lcInfo = ;
					BINTOC(60, [4RS]) + ;
					BINTOC(SEE_MASK_NOCLOSEPROCESS, [4RS]) + ;
					BINTOC(0, [4RS]) + ;
					BINTOC(lnPtr, [4RS]) + ;
					BINTOC(lnPtr+5, [4RS]) + ;
					BINTOC(0, [4RS]) + ;
					BINTOC(0, [4RS]) + ;
					BINTOC(1, [4RS]) + ;
					REPLICATE(CHR(0), 28)

				IF ShellExecuteEx(@lcInfo) = 0
					HeapFree(lnHeap, 0, lnPtr) && Comprobar si es correcto limpiar el puntero aqui
					IF tlDebug
						? "Could not call process"
					ENDIF
					lnExitCode	= -1
					EXIT
				ELSE
					HeapFree(lnHeap, 0, lnPtr)
					ln_hProcess	= CTOBIN(RIGHT(lcInfo, 4), [4RS])
					ln_hThread	= 0

					IF tlDebug
						? "Process handle    = "+TRANSFORM(ln_hProcess)
						? "Thread handle     = "+TRANSFORM(ln_hThread)
					ENDIF

					*IF lnProcess != 0
					*	WaitForSingleObject(ln_hProcess, WAIT_MILLISECOND)
					*	IF tlDebug
					*		? "Terminating process!"
					*	ENDIF
					*	TerminateProcess(ln_hProcess, 0)
					*ENDIF
				ENDIF
			
			ELSE
				IF tlDebug
					? "Could not create process"
				ENDIF
				lnExitCode	= -1
				EXIT
			ENDIF
		ELSE

			* Process and thread handles returned in ProcInfo structure
			ln_hProcess 	= CTOBIN( LEFT( lcProcessInfo, 4 ), '4RS' )
			ln_hThread		= CTOBIN( SUBSTR( lcProcessInfo, 5, 4 ), '4RS' )
			ln_dwProcessId	= CTOBIN( SUBSTR( lcProcessInfo, 9, 4 ), '4RS' )
			ln_dwThreadId	= CTOBIN( SUBSTR( lcProcessInfo, 13, 4 ), '4RS' )

			IF tlDebug
				? "Process handle    = "+TRANSFORM(ln_hProcess)
				? "Thread handle     = "+TRANSFORM(ln_hThread)
				? "Process handle id = "+TRANSFORM(ln_dwProcessId)
				? "Thread handle id  = "+TRANSFORM(ln_dwThreadId)
			ENDIF
		ENDIF

		IF tbWaitOnReturn THEN
			* // Give the process time to execute and finish
			lnExitCode = STILL_ACTIVE

			DO WHILE lnExitCode = STILL_ACTIVE
				lnWfSO	= WaitForSingleObject(ln_hProcess, lnTimeout)

				IF tlDebug
					? 'lnWfSO = ' + TRANSFORM(lnWfSO)
				ENDIF

				IF GetExitCodeProcess(ln_hProcess, @lnExitCode) <> 0
					IF lnExitCode = STILL_ACTIVE
						DO CASE
						CASE lnWfSO = WAIT_TIMEOUT
							IF tlDebug
								? "Exit code = "+ TRANSFORM(lnWfSO) + " (WAIT_TIMEOUT)"
							ENDIF
							TerminateProcess(ln_hProcess, 0)
							lnExitCode = WAIT_TIMEOUT

						CASE lnWfSO = WAIT_FAILED
							IF tlDebug
								? "Exit code = "+ TRANSFORM(lnWfSO) + " (WAIT_FAILED)"
							ENDIF

						CASE lnWfSO = WAIT_OBJECT_0
							IF tlDebug
								? "Exit code = "+ TRANSFORM(lnWfSO) + " (WAIT_OBJECT_0)"
							ENDIF

						CASE lnWfSO = WAIT_ABANDONED
							IF tlDebug
								? "Exit code = "+ TRANSFORM(lnWfSO) + " (WAIT_ABANDONED)"
							ENDIF

						OTHERWISE
							IF tlDebug
								? "Exit code = "+ TRANSFORM( lnExitCode )
							ENDIF
						ENDCASE
					ELSE
						IF tlDebug
							? "Exit code = "+ TRANSFORM( lnExitCode )
						ENDIF
					ENDIF
				ELSE
					IF tlDebug
						? "GetExitCodeProcess() failed"
					ENDIF
					lnExitCode	= -2
				ENDIF

				*DOEVENTS
			ENDDO
		ELSE
			lnExitCode	= 0
		ENDIF

		*-- DOCUMENTACIÓN sobre cierre procesos/threads:
		*-- https://msdn.microsoft.com/en-us/library/windows/desktop/ms682512%28v=vs.85%29.aspx
		=CloseHandle(ln_hProcess)
		=CloseHandle(ln_hThread)

		IF tlDebug
			? '> FUNCTION RETURN VALUE = '
			?? lnExitCode
		ENDIF
	ENDTRY

	RETURN lnExitCode
ENDFUNC


- Fernando DBozzo
( Topic last updated: 2017.02.28 02:06:57 PM )