Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Close A File
Message
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Environment versions
Visual FoxPro:
VFP 9 SP1
OS:
Windows 7
Network:
Windows 2008 Server
Database:
Visual FoxPro
Application:
Desktop
Miscellaneous
Thread ID:
01542893
Message ID:
01543016
Views:
61
Likes (2)
> this does not work for me in vfp9.2 under windows 7

Below is an updated version of this code sample that now works under XP and under Windows 7. I found that under Windows 7, a process has to be created with specific creation flags NORMAL_PRIORITY_CLASS | CREATE_BREAKAWAY_FROM_JOB. Otherwise call to AssignProcessToJobObject fails.
CLEAR
CLEAR ALL

LOCAL oForm
oForm = CREATEOBJECT("TForm")
oForm.Show(1)
* end of main

DEFINE CLASS TForm As Form
#DEFINE MAX_PATH 260
	Width=300
	Height=200
	BorderStyle=2
	MinButton=.F.
	MaxButton=.F.
	Autocenter=.T.
	Caption="Managing group of processes"
	hJob=0

	ADD OBJECT cmdOpenApp As CommandButton WITH;
	Left=90, Top=36, Width=120, Height=27, Caption="Open Document"

	ADD OBJECT cmdOpenDos As CommandButton WITH;
	Left=90, Top=70, Width=120, Height=27, Caption="Open DOS Window"

	ADD OBJECT cmdClose As CommandButton WITH;
	Left=90, Top=130, Width=120, Height=27, Caption="Close All"

PROCEDURE Init
	THIS.declare

PROCEDURE Destroy
	THIS.CloseJob

PROCEDURE cmdOpenApp.Click
	ThisForm.AddToJob

PROCEDURE cmdOpenDos.Click
	ThisForm.OpenDosWindow

PROCEDURE AddToJob
	LOCAL cPath, cDocName, hProcess, nResult

	cPath = SYS(5) + SYS(2003)
	cDocName = GETFILE("*;TXT;DOC;XLS;MDB;PDF;JPG;BMP;GIF")
	SET DEFAULT TO (m.cPath)

	IF NOT EMPTY(cDocName)
		hProcess = THIS.OpenDoc(cDocName)
		
		IF hProcess <> 0
			IF THIS.hJob = 0
				THIS.OpenJob
			ENDIF
			
			nResult = AssignProcessToJobObject(THIS.hJob, hProcess)
			
			IF nResult = 0
				? 'AssignProcessToJobObject faied:', GetLastError()
			ENDIF

		ENDIF
	ENDIF

PROCEDURE cmdClose.Click
	ThisForm.CloseJob

PROCEDURE OpenJob
	THIS.hJob = CreateJobObject(0, SUBSTR(SYS(2015), 3))

PROCEDURE CloseJob
	IF THIS.hJob <> 0
		
		LOCAL nResult
		nResult = TerminateJobObject(THIS.hJob, 0)
	
		IF nResult = 0
			ACTIVATE SCREEN
			? 'TerminateJobObject failed:', GetLastError()
		ENDIF
		
		= CloseHandle(THIS.hJob)
		THIS.hJob=0
	ENDIF

PROCEDURE OpenDosWindow
	LOCAL cSystem32, cAppName, hProcess
	
	cSystem32 = THIS.GetSystem32Directory()
	cAppName = cSystem32 + "\cmd.exe"
	
	IF NOT FILE(cAppName)
		cAppName = cSystem32 + "\command.com"
	ENDIF

	IF FILE(cAppName)
		hProcess = THIS.StartProcess(cAppName, "")
		IF hProcess <> 0
			IF THIS.hJob = 0
				THIS.OpenJob
			ENDIF
			= AssignProcessToJobObject(THIS.hJob, hProcess)
		ENDIF
	ENDIF

PROCEDURE GetSystem32Directory
	LOCAL cBuffer, nResult
	cBuffer = REPLICATE(CHR(0), MAX_PATH)
	nResult = GetSystemDirectory(@cBuffer, Len(cBuffer))
RETURN SUBSTR(cBuffer, 1, nResult)

PROCEDURE OpenDoc(cDocName)
	LOCAL cAppName
	cAppName = THIS.GetAppName(cDocName)

	IF LEN(cAppName)=0
		WAIT WINDOW NOWAIT "Default application not found for " +;
			CHR(13) + cDocName
		RETURN 0
	ENDIF

	WAIT WINDOW NOWAIT cAppName
RETURN THIS.StartProcess(m.cAppName, m.cDocName)

PROCEDURE StartProcess(cAppName, cCmdLine)
#DEFINE START_INFO_SIZE  68

#DEFINE CREATE_BREAKAWAY_FROM_JOB 0x01000000
#DEFINE NORMAL_PRIORITY_CLASS 0x00000020

	LOCAL cProcInfo, cStartInfo, nResult, hProcess, nFlags
	
	nFlags = BITOR(CREATE_BREAKAWAY_FROM_JOB, NORMAL_PRIORITY_CLASS)

	hProcess = 0
	cProcInfo = Repli(Chr(0), 16)
	cStartInfo = PADR(Chr(START_INFO_SIZE), START_INFO_SIZE, Chr(0))
	
	IF NOT EMPTY(m.cCmdLine)
		cCmdLine = [ "] + ALLTRIM(cCmdLine) + ["]
	ENDIF

	nResult = CreateProcess(cAppName, cCmdLine, 0,0,0,;
		nFlags,0, SYS(5)+SYS(2003),;
		@cStartInfo, @cProcInfo)

	IF nResult <> 0
	* retrieve process handle from PROCINFO structure
		hProcess = buf2dword(SUBSTR(cProcInfo, 1,4))
	ENDIF
RETURN m.hProcess

FUNCTION GetAppName(cFileName)
	LOCAL cResult
	cResult = REPLICATE(CHR(0), MAX_PATH)
	= FindExecutable(cFileName, "", @cResult)
RETURN ALLTRIM(STRTRAN(cResult, CHR(0), ""))

PROTECTED PROCEDURE declare
	DECLARE INTEGER GetLastError IN kernel32
	
	DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject

	DECLARE INTEGER TerminateJobObject IN kernel32;
		INTEGER hJob, LONG uExitCode

	DECLARE INTEGER CreateJobObject IN kernel32;
		INTEGER lpJobAttributes, STRING lpName

	DECLARE INTEGER AssignProcessToJobObject IN kernel32;
		INTEGER hJob, INTEGER hProcess

	DECLARE INTEGER FindExecutable IN shell32;
		STRING lpFile, STRING lpDir, STRING @lpResult

	DECLARE INTEGER GetSystemDirectory IN kernel32;
		STRING @ lpBuffer, INTEGER nSize

	DECLARE INTEGER CreateProcess IN kernel32;
		STRING lpApplicationName, STRING lpCommandLine,;
		INTEGER lpProcessAttr, INTEGER lpThreadAttr,;
		INTEGER bInheritHandles, INTEGER dwCreationFlags,;
		INTEGER lpEnvironment, STRING lpCurrentDirectory,;
		STRING @lpStartupInfo, STRING @lpProcessInformation

ENDDEFINE

FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
	BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
	BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
	BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform