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.


FUNCTION WScriptShell_Run
	* 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
	*-----------------------------------------------------------------------------------------------
	LPARAMETERS tcCmdLine, tnWindowStyle, tbWaitOnReturn, tlDebug
	* ? WScriptShell_Run("c:\windows\system32\cmd.exe /c dir c:\*.* > \temp\dir.txt")

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

	TRY
		DECLARE SHORT CreateProcess IN WIN32API ;
			STRING lpszModuleName, ;
			STRING @lpszCommandLine, ;
			STRING lpSecurityAttributesProcess, ;
			STRING lpSecurityAttributesThread, ;
			SHORT bInheritHandles, ;
			INTEGER dwCreateFlags, ;
			STRING lpvEnvironment, ;
			STRING lpszStartupDir, ;
			STRING @lpStartInfo, ;
			STRING @lpProcessInfo

		DECLARE LONG WaitForSingleObject IN WIN32API INTEGER hHandle, LONG dwMilliseconds
		DECLARE INTEGER GetExitCodeProcess IN WIN32API INTEGER ln_hProcess, INTEGER @ lnExitCode
		DECLARE INTEGER CloseHandle IN kernel32.DLL INTEGER hObject
		*DECLARE INTEGER ShellExecuteEx IN Shell32 STRING @lpExecInfo
		DECLARE LONG ShellExecuteEx IN shell32.DLL STRING @
		DECLARE LONG HeapAlloc IN WIN32API LONG, LONG, LONG
		DECLARE LONG HeapFree IN WIN32API LONG, LONG, LONG
		DECLARE LONG GetProcessHeap IN WIN32API
		*DECLARE LONG WaitForSingleObject IN WIN32API LONG, LONG
		DECLARE LONG TerminateProcess IN WIN32API LONG, LONG

		* 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)

		DO CASE
		CASE VARTYPE(tbWaitOnReturn) = "L"
		CASE VARTYPE(tbWaitOnReturn) = "N"
			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
					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, cnHalfASecond)
				lnWfSO	= WaitForSingleObject(ln_hProcess, cnINFINITE)

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

				IF GetExitCodeProcess(ln_hProcess, @lnExitCode) <> 0
					DO CASE
					CASE lnExitCode = STILL_ACTIVE
						IF tlDebug
							? "Process is still active"
						ENDIF
					OTHERWISE
						IF tlDebug
							? "Exit code = "+ TRANSFORM( lnExitCode )
						ENDIF
					ENDCASE
				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 = '
		ENDIF
	ENDTRY

	RETURN lnExitCode
ENDFUNC


- Fernando DBozzo
( Topic last updated: 2015.09.14 08:51:11 AM )