FoxPro/Visual FoxPro - GENERAR EXE EN VFP9 NO VISUAL ( llamarlo modo DOS)

PROCEDURE Shell_Exec

*--------------------------------------------

LPARAMETERS tcFileName, tcAction, tcParams,tlChangeDir

* tcFileName="\\ruta\nombreArchivo.extensión

* tcAction: "open", "find","print"   (por defecto es "open")

* tcParams: lista de parámetros separados por CHR(32) (unicamente para archivos exe)

* Sample Shell_Exec(m.lcFileName)

TRY 

	LOCAL lcExt,;

		lcMessage,;

		lDoit,;

		lcFolder,;

		loFso as Object,;

		loex AS Exception,;

		loResp AS Object

	lcFolder = FULLPATH("")

	loFso = NEWOBJECT("Scripting.FileSystemObject")

	loResp = NEWOBJECT("Empty")

	ADDPROPERTY(loResp,"nResponse",0)

	ADDPROPERTY(loResp,"failure",.f.)

	ADDPROPERTY(loResp,"FileExist",loFso.FileExists(m.tcFileName) )

	IF loResp.FileExist

		tcAction = EVL(m.tcAction,"Open")

		tcparams = EVL(m.tcParams,"")

		lcExt = JustExt(m.tcFileName)

		IF m.tlChangeDir

			lcPath = JUSTPATH(m.tcFileName)

			IF !EMPTY(m.lcPath) AND lofso.FolderExists(ADDBS(m.lcpath))

				CD &lcPath

			ENDIF 

		ENDIF 

		DECLARE INTEGER ShellExecute IN SHELL32.dll INTEGER nWinHandle,;

			STRING cOperation,;

			STRING cFileName,;

			STRING cParameters,;

			STRING cDirectory,;

			INTEGER nShowWindow

		DECLARE INTEGER FindWindow IN WIN32API STRING cNull,;

			STRING cWinName

		loResp.nResponse = ShellExecute(FindWindow(0,_SCREEN.Caption),tcAction,tcFileName,tcParams,SYS(2023),1)

		DO CASE

			CASE loResp.nResponse = 2

				lcMessage = "Invalid path or filename. No existe el archivo"

			CASE loResp.nResponse=8

				lcMessage = "No hay suficiente memoria para realizar la acción solicitada"

			CASE loResp.nResponse=11

				lcMessage = "El archivo no es ejecutable o está corrompido"

			CASE loResp.nResponse=31

				* Aparentemente ocurre cuando no encuentra

				* una aplicación asociada

				lcMessage = "No se encuentra una aplicación para "+m.lcExt

			CASE loResp.nResponse=33

				* VErificado para XLS,DOC,JPG,BMP

			CASE loResp.nResponse=42

				* Verificado para PDF,GIF,0MDI,MIP,NRI

			OTHERWISE 

		ENDCASE

	ENDIF 

CATCH TO loex

	loex.UserValue = PROGRAM()

	ShowError(loex)

FINALLY

	loFso = null

	IF m.tlChangeDir

		CD &lcFolder

	ENDIF 

	IF !EMPTY(m.lcMessage)

		loResp.Failure = .t.

		Messagebox(m.lcMessage,0,program())

	ENDIF 

ENDTRY 

RETURN loResp

ENDPROC 

PROCEDURE ShowError

LPARAMETERS toExcep,tlNotShow,tcCaption

*--------------------------------------

tcCaption=EVL(tcCaption,MENSAJE_DE)

LOCAL lcMens

lcMens="Fecha "+TRANSFORM(DATETIME());

	+CHR(13)+"Mensaje: "+toExcep.message;

	+CHR(13)+"ErrorNo: "+TRANSFORM(toExcep.Errorno);

	+CHR(13)+"Llamada: "+toExcep.Uservalue

IF PEMSTATUS(toExcep,"lineno",5) AND VARTYPE(toExcep.lineno)="N"

	lcMens=lcMens+CHR(13)+"linea "+TRANSFORM(toExcep.lineno)

ENDIF

STRTOFILE(m.lcMens + CHR(13) + REPLICATE("=",80) + CHR(13) ,"TheoCall_Error.log",1)

IF !tlNotShow

	MESSAGEBOX("Se ha producido un error:"+CHR(13)+lcMens,0,m.tcCaption)

ENDIF

ENDPROC

LPARAMETERS tcFolder_ini, tcProgram_Name

SET DEBUG OFF

SET SAFETY OFF

SET DATE TO BRITISH

SET CENTURY ON

SET DELETED ON

set BELL OFF

SET STATUS OFF

set STATUS BAR OFF

SET SCORE OFF

SET TALK OFF

SET NOTIFY OFF

SET NEAR OFF

SET ESCAPE OFF

SET UNIQUE OFF

SET FIXED OFF

SET EXACT OFF

SET CONF ON

SET FDOW TO 2

SET OLEOBJECT ON

SET LOGERRORS OFF

SET HOURS TO 24

ON SHUTDOWN do MyQuit

TRY

	LOCAL lcMessage,;

			lFailure,;

			lcFile_Path_Name,;

			loEx as Exception,;

			loFso as Object,;

			lnParameters

	lnParameters = PCOUNT()

	loFso = NEWOBJECT("Scripting.FileSystemObject")

	lcMessage = ""

	DO WHILE .t.

		IF VARTYPE(m.tcFolder_ini)#"C" OR EMPTY(m.tcFolder_ini)

			lcMessage = m.lcMessage ;

				+ IIF(EMPTY(m.lcMessage),"",CHR(13));

				+ "Parámetro 'Folder_Ini' incorrecto" + CHR(13);

				+ "Parámetros pasados = "+TRANSFORM(m.lnParameters)

			lFailure = .t.

		ENDIF

		IF VARTYPE(m.tcProgram_Name)#"C" OR EMPTY(m.tcProgram_Name)

			lcMessage = m.lcMessage ;

				+ IIF(EMPTY(m.lcMessage),"",CHR(13));

				+ "Parámetro 'Program_Name' incorrecto"	+ CHR(13);

				+ "Parámetros pasados = "+TRANSFORM(m.lnParameters)

			lFailure = .t.

		ENDIF

		IF m.lFailure

			EXIT

		ENDIF

		lcMessage = m.lcMessage ;

			+ IIF(EMPTY(m.lcMessage),"",CHR(13));

			+ "Folder_Ini: "+m.tcFolder_Ini + CHR(13);

			+ "Program_Name: "+m.tcProgram_Name

		lcFile_path_Name = ADDBS(m.tcFolder_Ini)+m.tcProgram_Name

		IF !loFso.FileExists(m.lcFile_Path_Name)

			lcMessage = m.lcMessage ;

				+ CHR(13);

				+ "No se encuentra el archivo m.lcFile_Path_Name"

			EXIT

		ENDIF

		lcMessage = m.lcMessage ;

			+ CHR(13) ;

			+ "Preparado para la acción"

		EXIT

	ENDDO

CATCH TO loex

	loex.UserValue = PROGRAM()

	ShowError(loex)

FINALLY

       loFso = null

	MESSAGEBOX(m.lcMessage,0,"Mensaje de PasPar")

	QUIT

ENDTRY

PROCEDURE myquit

*-----------------

*_screen.frmMain = null

CLEAR ALL

CLEAR EVENTS

ON SHUTDOWN

QUIT

ENDPROC

*--------------------------------------

PROCEDURE ShowError

LPARAMETERS toExcep,tlNotShow,tcCaption

*--------------------------------------

tcCaption=EVL(tcCaption,"Mensaje de PasPar")

LOCAL lcMens

lcMens="Fecha "+TRANSFORM(DATETIME());

	+CHR(13)+"Mensaje: "+toExcep.message;

	+CHR(13)+"ErrorNo: "+TRANSFORM(toExcep.Errorno);

	+CHR(13)+"Llamada: "+toExcep.Uservalue

IF PEMSTATUS(toExcep,"lineno",5) AND VARTYPE(toExcep.lineno)="N"

	lcMens=lcMens+CHR(13)+"linea "+TRANSFORM(toExcep.lineno)

ENDIF

STRTOFILE(m.lcMens + CHR(13) + REPLICATE("=",80) + CHR(13) ,"TheoCall_Error.log",1)

IF !tlNotShow

	MESSAGEBOX("Se ha producido un error:"+CHR(13)+lcMens,0,m.tcCaption)

ENDIF

ENDPROC