Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
How to call updated prg/frx/scx that is outside applicat
Message
From
10/12/2009 10:19:14
 
 
To
10/12/2009 06:46:12
Freddie Rodrigues
Bitrun Business Solutions
Mumbai, India
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows XP SP2
Miscellaneous
Thread ID:
01438358
Message ID:
01438391
Views:
126
Below is from FP 2.6 program that will allow for updating the APP file that I wrote years ago (before VFP). This is added to its own project and then compiled into an EXE. Then your main program is compiled into APP that this EXE will execute. Before execution it checks for a newer APP file on a fileshare; if it finds a newer file then it copies it first and then executes. This allows you to update the program without having to go to all user's workstations.
************************************************************************************************
* Written by:  Gregory A. Green
************************************************************************************************
SET SYSMENU TO
SET SYSMENU OFF
CLEAR
************************************************************************************************
*  Global Variables used in file
*
PUBLIC gcIniFileName              && Path and name of configuration file

************************************************************************************************
*  Program Application start
*
PRIVATE ALL LIKE l*
	SET SAFETY OFF
	gcProgramTitle = "Your Program Name"
	MODIFY WINDOW SCREEN TITLE gcProgramTitle ICON FILE "MYICON.ICO"
	SET LIBRARY TO SYS(2003) + "\foxtools.fll" ADDITIVE
	gcIniFileName = FORCEEXT(SYS(16),"INI")
	IF FILE(gcIniFileName)                                            && Test for file existance
		lcUpdateDir = GetProfileString(gcIniFileName,"Setup","Update Directory")
		IF !EMPTY(lcUpdateDir)                                         && Check for network program update
			lcExistnFile = FORCEEXT(SYS(16),"APP")
			lcUpdateFile = ADDBS(lcUpdateDir) + JUSTFNAME(lcExistnFile)
			lnFileFound  = ADIR(lcNetwkFile,lcUpdateFile)
			IF lnFileFound > 0
				lnFileFound = ADIR(lcLocalFile,lcExistnFile)
				IF lnFileFound > 0
					DO CASE                                               && Check if newer file on network
						CASE lcNetwkFile(3) > lcLocalFile(3)
							DO show_wait_screen WITH "Please Wait -- Updating Program File"
							COPY FILE (lcUpdateFile) TO (lcExistnFile)
							DO kill_wait_screen
						CASE lcNetwkFile(3) = lcLocalFile(3)
							lnLocalFileTime = VAL(SUBSTR(lcLocalFile(4),1,2)) + (VAL(SUBSTR(lcLocalFile(4),4,2))/60) + (VAL(SUBSTR(lcLocalFile(4),7,2))/360)
							lnNetwkFileTime = VAL(SUBSTR(lcNetwkFile(4),1,2)) + (VAL(SUBSTR(lcNetwkFile(4),4,2))/60) + (VAL(SUBSTR(lcNetwkFile(4),7,2))/360)
							IF lnNetwkFileTime > lnLocalFileTime
								DO show_wait_screen WITH "Please Wait -- Updating Program File"
								COPY FILE (lcUpdateFile) TO (lcExistnFile)
								DO kill_wait_screen
							ENDIF
					ENDCASE
				ELSE
					DO show_wait_screen WITH "Please Wait -- Updating Program File"
					COPY FILE (lcUpdateFile) TO (lcExistnFile)
					DO kill_wait_screen
				ENDIF
			ENDIF
		ENDIF
		IF FILE(lcExistnFile)                                          && Test for file existance
			DO (lcExistnFile)
		ELSE
			lcUserMsg = "Unable to locate the application file; Contact System Administrator."
			=WMSGBOX(lcUserMsg,"Application File Error",16,"ERROR")
		ENDIF
	ELSE
		lcUserMsg = "Unable to locate configuration file; Contact System Administrator."
		=WMSGBOX(lcUserMsg,"Configuration File Error",16,"ERROR")
	ENDIF
	SET SAFETY ON
RETURN

************************************************************************************************
*
*  Routine for displaying wait message
*
PROCEDURE show_wait_screen
PARAMETER pcWaitText
	IF NOT WEXIST("_wait_scrn")
		DEFINE WINDOW _wait_scrn AT 0.000,0.000 SIZE 4.250,86.333 FONT "Arial", 10 STYLE "B" NOFLOAT NOCLOSE NOMINIMIZE NONE COLOR RGB(,,,0,128,128)
		MOVE WINDOW _wait_scrn CENTER
	ENDIF
	ACTIVATE WINDOW _wait_scrn NOSHOW
	CLEAR
	@ 1.438,7.167 SAY pcWaitText SIZE 0.950,53.875 FONT "Arial", 12 STYLE "B" PICTURE "@I" COLOR RGB(255,255,255,0,128,128)
	@ 0.000,0.000 TO 4.250,86.333 PEN 6, 8 COLOR RGB(128,128,128,,,,)
	ACTIVATE WINDOW _wait_scrn
RETURN

************************************************************************************************
*
*  Routine for removing the wait message
*
PROCEDURE kill_wait_screen
	RELEASE WINDOW _wait_scrn
RETURN

************************************************************************************************
*
*  Routine for getting a string from user configuration file
*
*  Return Value:      string value or null (empty) if not found
*
*  Parameters:        pcFileName    the name of the configuration file; full path optional,
*                                   will use the search path as specified by SET PATH command
*                                   if not located first in the current directory
*                     pcSection     the section in the configuration file to retrieve the
*                                   string from
*                     pcStrName     the name of the string text to retrieve
*
FUNCTION GetProfileString
PARAMETER pcFileName, pcSection, pcStrName
	PRIVATE ALL LIKE l*
	_ReFox_ = (9876543210)
	_ReFox_ = (9876543210)
*	DECLARE INTEGER GetPrivateProfileString IN Win32API  AS GetPrivStr ;
*		String cSection, String cKey, String cDefault, String @cBuffer, ;
*		Integer nBufferSize, String cINIFile
*
*	=GetPrivStr(pcSection,pcStrName,,)
*
	IF FILE(pcFileName)                                               && Check if configuration file exists
		lhHandle   = 0                                                 && Initialize variables
		lcStrValue = ""
		llFound    = .F.
		pcFileName = ALLTRIM(pcFileName)
		pcSection  = "[" + ALLTRIM(pcSection) + "]"
		pcStrName  = ALLTRIM(pcStrName)
		IF FILE(pcFileName)                                            && Check if configuration file exists
			lhHandle = FOPEN(pcFileName)                                && Open for read only
			=FSEEK(lhHandle,0,0)                                        && Goto beginning of file
			DO WHILE NOT FEOF(lhHandle)                                 && Loop to find string header section
				lcStrBuffer = FGETS(lhHandle)                            && Get string of text from file
				IF ATC(pcSection,lcStrBuffer) > 0                        && Test if section header found
					DO WHILE NOT FEOF(lhHandle)                           && Loop to find string text
						lcStrBuffer = FGETS(lhHandle)                      && Get string of text from file
						IF ATC(pcStrName,lcStrBuffer) > 0                  && Test if string text found
							lnNdx = ATC("=",lcStrBuffer) + 1                && Get starting position of return string
							lnStrLen = LEN(lcStrBuffer)
							IF lnStrLen >= lnNdx
								lcStrValue = SUBSTR(lcStrBuffer,lnNdx)
							ELSE
								lcStrValue = SPACE(1)                        && String not found, set return to null
							ENDIF
							EXIT
						ENDIF
						lcStrValue = SPACE(1)                              && String not found, set return to null
						IF ATC("[",lcStrBuffer) > 0                        && Test if next section encountered
							EXIT                                            && Next section, exit loop
						ENDIF
					ENDDO
					EXIT
				ENDIF
				lcStrValue = SPACE(1)                                    && String not found, set return to null
			ENDDO
			=FCLOSE(lhHandle)                                           && Close file
		ENDIF
	ELSE
		lcStrValue = SPACE(1)                                          && File not found, set return to null
	ENDIF
RETURN lcStrValue

************************************************************************************************
*
*  Routine for displaying a user information dialog box
*
FUNCTION WMSGBOX
PARAMETERS pcMessage,pcTitle,pnButtons,pcIcon
	IF TYPE('pcIcon') = 'L'
		pcIcon = 'EXCLAIM'
	ENDIF
	lnButton = 0
	DO FORM MsgBox WITH pcMessage,pcTitle,pnButtons,pcIcon TO lnButton
RETURN lnButton
Previous
Reply
Map
View

Click here to load this message in the networking platform