Files
vfp_roaauto/COMUN/utile/web/wwcodeupdate.prg

550 lines
15 KiB
Plaintext

#INCLUDE WCONNECT.H
*** The following PRG contains:
*** A self loading stub program that can be used to run
*** as the code 'hot swapper' after the main EXe has unloaded
***
*** Following the stub is the actual CodeUpdate class
************************************************************************
* CodeUpdate
****************************************
*** Function: Hot swaps an EXE file by running a Zip Exe file that
*** unzips the update files.
*** Assume: The original application has quit and is no longer
*** loaded and running.
*** Pass: lcExeFile - The main application EXE file to run
*** (wwReader70.exe)
*** lcUpdateFile - The updated EXE(Auto-Zip) file (full path)
*** that contains the update files
*** (d:\temp\updates\wwReaderUpdate.exe)
*** Return: nothing
************************************************************************
LPARAMETER lcExeFile, lcUpdateFile, lcApplicationName
SET PROCEDURE TO wwCodeUpdate ADDIT
SET PROCEDURE TO wwUtils ADDIT
SET PROCEDURE TO wwHTTP ADDIT
SET CLASSLIB TO wwDialogs ADDIT
*** Default - just load classes and exit
IF EMPTY(lcExeFile)
* WAIT WINDOW TIMEOUT 5 "No Exe file specified on command line..."
RETURN
ENDIF
IF EMPTY(lcUpdateFile) OR !FILE(lcUpdateFile)
WAIT WINDOW TIMEOUT 5 "Invalid Update File Path specified on command line..."
ENDIF
loVersion = CREATEOBJECT("wwCodeUpdate")
loVersion.cExeFile = lcExeFile
IF !EMPTY(lcApplicationName)
loVersion.cApplicationName = lcApplicationName
ENDIF
loVersion.SwapExes(lcUpdateFile)
RETURN
*** Main Application Sample code
#IF .F.
#DEFINE APP_VERSION 1.0
*** Test Code
MESSAGEBOX("West Wind Technologies presents:" + CHR(13)+CHR(13) + ;
CHR(9) + "GREAT BIG, BAD APPLICATION" + CHR(13) + ;
CHR(9) + "Version " + TRANS(APP_VERSION,"99.99") + CHR(13),;
64,"West Wind Technologies")
o=CREATEOBJECT("wwCodeUpdate")
o.cVersionUrl = "http://localhost/codeupdate/update.xml"
o.cVersionType = "N"
o.cExeFile = "test.exe"
lnVersion = o.GetVersionInfo()
IF lnVersion > APP_VERSION
IF MESSAGEBOX("Version " + TRANS(lnVersion,"99.99") + " of GREAT BIG APP" + CHR(13) +;
"is available online now." + CHR(13) + CHR(13) +;
"Would you like to download it now?",32+4,;
"West Wind Technologies") = 6
o.DownloadUpdate()
o.UpdateCode("cu_Update.exe")
ENDIF
ENDIF
MESSAGEBOX("your Great Big Application starts here")
RETURN
#ENDIF
*************************************************************
DEFINE CLASS wwCodeUpdate AS RELATION
*************************************************************
*: Author: Rick Strahl
*: (c) West Wind Technologies, 2000
*:Contact: http://www.west-wind.com
*************************************************************
#IF .F.
*:Help Documentation
*:Topic:
wwServer::GetProcessID
*:Description:
*:Example:
*:Remarks:
SERVER UPDATE FILE looks AS follows:
<?XML VERSION="1.0"?>
<codeupdate>
<VERSION>2.55</VERSION>
<minversion>2.45</minversion>
<fileurl>http://www.west-WIND.com/FILES/UPDATES/wwhelp_update.EXE</fileurl>
<filesize>444</filesize>
<commandline>wwhelp.EXE</commandline>
</codeupdate>
The ONLY required KEYS are <VERSION> AND <fileurl> WITH The others optional.
*:SeeAlso:
*:ENDHELP
#ENDIF
cVersionUrl = ""
cVersionType = "C"
cExeFile = ""
cCommandLineParameters = ""
cApplicationName = "the application"
cDownloadPath = ".\CodeUpdate\"
lUnZipFile = .F.
cErrorMsg = ""
lError = .F.
*** Downloaded values from XML file
vOnlineVersion = ""
cOnlineFileUrl = ""
nFileSize = 0
vOnlineMinVersion = ""
cUserMessage = ""
cNewsMessage = ""
lShowDialog = .T.
nConnectTimeout = 5000
*** Allows access configuration of HTTP
*** settings. Call CreateHTTPClient to
*** create an instance of this object to
*** manipulate
oHTTP = NULL
PROTECTED cXML
cXML = ""
cAppStartpath = ""
************************************************************************
* wwCodeUpdate :: Init
*********************************
*** Function:
*** Assume:
*** Pass:
*** Return:
************************************************************************
FUNCTION INIT
THIS.cAppStartpath = GetAppStartPath()
ENDFUNC
* wwCodeUpdate :: Init
************************************************************************
* wwCodeUpdate :: GetVersionInfo
*********************************
*** Function: Retrieves online XML file and parses the Version and
*** download URL from the result
*** Assume: Sets these properties from XML retrieved:
*** vOnlineVersion
*** cOnlineFileUrl
*** Pass: lnVersion - Current Version Number/or string
*** Return: Numeric: Online Version number or 0 on failure
************************************************************************
FUNCTION GetVersionInfo
LOCAL loIP, lcVersionType, lcXML, lnSize, lcVersion
THIS.SetError()
lcVersionType = THIS.cVersionType
IF ISNULL(THIS.oHTTP)
* THIS.CreateHTTPClient()
THIS.oHTTP = CREATEOBJECT("cu_wwHTTP")
ENDIF
THIS.oHTTP.lShowDialog = .F.
lcXML = THIS.oHTTP.HTTPGet(THIS.cVersionUrl)
IF THIS.oHTTP.nError # 0
THIS.SetError(THIS.oHTTP.cErrorMsg)
RETURN IIF(lcVersionType = "C","",0)
ENDIF
IF LEFT(lcXML,5) <> "<?xml"
THIS.SetError("Missing or invalid XML returned from server")
RETURN IIF(lcVersionType = "C","",0)
ENDIF
lcVersion = Extract(lcXML,"<version>","</version>")
IF EMPTY(lcVersion)
THIS.SetError("No version number found in XML")
RETURN IIF(lcVersionType = "C","",0)
ENDIF
THIS.vOnlineVersion = IIF(lcVersionType="C",lcVersion,VAL(lcVersion))
lcVersion = Extract(lcXML,"<minversion>","</minversion>")
IF !EMPTY(lcVersion)
THIS.vOnlineMinVersion = IIF(lcVersionType="C",lcVersion,VAL(lcVersion))
ENDIF
***!!!!!!!!!
*---------------------------
*THIS.cOnlineFileUrl = Extract(lcXML,"<fileurl>","</fileurl>")
THIS.cOnlineFileUrl = JUSTPATH(THIS.cVersionUrl) + "/" + Extract(lcXML,"<fileurl>","</fileurl>")
*======================================
***!!!!!!!!!!!!!!
THIS.nFileSize = VAL( Extract(lcXML,"<filesize>","</filesize>") )
THIS.cUserMessage = Extract(lcXML,"<usermessage>","</usermessage>")
THIS.cNewsMessage = Extract(lcXML,"<newsmessage>","</newsmessage>")
*** Save the XML just in case
THIS.cXML = lcXML
*!* IF lcVersionType = "C"
*!* RETURN lcVersion
*!* ENDIF
RETURN THIS.vOnlineVersion
ENDFUNC
* wwCodeUpdate :: GetVersion
************************************************************************
* wwCodeUpdate :: CheckVersionAndUpdate
***************************************
*** Function:
*** Assume:
*** Pass:
*** Return:
************************************************************************
FUNCTION CheckVersionAndUpdate
LPARAMETERS lvVersion
lvNewVersion = THIS.GetVersion()
IF lvNewVersion > lvVersion
THIS.DownloadUpdate()
THIS.UpdateCode()
ENDIF
ENDFUNC
* wwCodeUpdate :: CheckVersionAndUpdate
************************************************************************
* wwCodeUpdate :: DownloadUpdate
*********************************
*** Function: Downloads the actual file from the Web site.
*** Assume:
*** Pass: llCheckForExistingVersion
*** Return: .T. or .F.
************************************************************************
FUNCTION DownloadUpdate
LPARAMETER llCheckforExistingVersion, tcFileVersionXML
LOCAL loIP, lcData, lnSize, loUrl
IF !EMPTY(tcFileVersionXML)
lcFileVersionXML = tcFileVersionXML
ELSE
lcFileVersionXML = "fileversion.xml"
ENDIF
IF llCheckforExistingVersion
lcFile = File2Var(THIS.cDownloadPath + lcFileVersionXML)
lcVersion = Extract(lcFile,"<version>","</version>")
IF IIF(THIS.cVersionType="C",lcVersion,VAL(lcVersion)) = THIS.vOnlineVersion
RETURN .T. && File was already downloaded
ENDIF
ENDIF
IF ISNULL(THIS.oHTTP)
loIP = THIS.CreateHTTPClient()
ELSE
loIP = THIS.oHTTP
ENDIF
loIP.lShowDialog = THIS.lShowDialog
*** Break down the URL into its components
loUrl = loIP.InternetCrackUrl(THIS.cOnlineFileUrl)
IF ISNULL(loUrl)
RETURN .F.
ENDIF
loIP.nhttpport=VAL(loUrl.cPort)
IF loIP.HTTPConnect(loUrl.cServer,"","",IIF(LOWER(loUrl.cProtocol)="https",.T.,.F.)) # 0
THIS.SetError(loIP.cErrorMsg)
RETURN .F.
ENDIF
*** Create a temporary directory if it doesn't exist
IF !ISDIR(THIS.cDownloadPath)
MD (THIS.cDownloadPath)
ENDIF
lcTFile = THIS.cDownloadPath + JUSTFNAME(STRTRAN(THIS.cOnlineFileUrl,"/","\"))
lcData = ""
lnSize = 0
IF loIP.HTTPGetEx( TRIM(loUrl.cPath),@lcData,@lnSize,,lcTFile) # 0
THIS.SetError(loIP.cErrorMsg)
RETURN .F.
ENDIF
File2Var(THIS.cDownloadPath + lcFileVersionXML,;
[<?xml version="1.0"?><version>]+ TRANS(THIS.vOnlineVersion) +[</version>])
loIP.HTTPClose()
ENDFUNC
* wwCodeUpdate :: DownloadUpdate
************************************************************************
* wwCodeUpdate :: SwapExes
****************************************
*** Function: Hot swaps an EXE file by running a Zip Exe file that
*** unzips the update files.
*** Assume: The original application has quit and is no longer
*** loaded and running.
*** Meant to be run as a mainline method
*** Pass: lcUpdateFile - The updated EXE(Auto-Zip) file (full path)
*** that contains the update files
*** Return: nothing
************************************************************************
FUNCTION SwapExes
LPARAMETER lcUpdateFile
LOCAL loSafety, OP
loSafety = CREATEOBJECT("wwEnv","SAFETY","OFF")
*_screen.visible = .F.
IF EMPTY(lcUpdateFile)
lcUpdateFile = SYS(5) + CURDIR() + [\codeupdate\Codeupdate.exe /auto ] +;
SYS(5) + CURDIR()
ENDIF
*** Configure the notification dialog
OP = CREATEOBJECT("wwProgressForm")
OP.WIDTH = 350
OP.SetCaption("File Update")
OP.SetDescription("Updating files for " + THIS.cApplicationName + "...")
OP.HideProgressBar()
OP.SHOW()
*** Force the form to update
DOEVENTS
*** Allow the application some time to go away
INKEY(5,"HM")
*** Execute the RUN command and wait
lcParms = [RUN /n7] + lcUpdateFile
&lcParms
*** Wait for 5 seconds to allow unzipping to complete
*** This should be plenty of time
OP.SetDescription([Getting ready to restart ] +;
THIS.cApplicationName + [...])
INKEY(5,"HM")
*** Make sure the new Exe exists - if not wait longer
IF !FILE(THIS.cExeFile)
*** Wait 5 more seconds
INKEY(5,"HM")
ENDIF
*** And start up the EXE
lcParms = [RUN /n1 ] + THIS.cExeFile + ;
IIF(!EMPTY(THIS.cCommandLineParameters)," " + THIS.cCommandLineParameters,"")
&lcParms
RETURN
RETURN
* wwCodeUpdate :: UpdateExe
************************************************************************
* wwCodeUpdate :: RunUpdateExe
*********************************
*** Function:
*** Assume:
*** Pass:
*** Return:
************************************************************************
FUNCTION RunUpdateExe
LPARAMETER lcUpdateExe
*** Run external program to copy in the files
lcParms = [RUN /n1 ] + lcUpdateExe
*Messagebox(lcParms)
&lcParms
*** Required if READ EVENTS IS ACTIVE
*** otherwise EXE won't release
IF RDLEVEL() > 0
CLEAR EVENTS
ENDIF
ON ERROR *
ON SHUTDOWN
*!* CLEAR DLLS
*!* RELEASE ALL
*!* CLEAR ALL
DOEVENTS
QUIT
ENDFUNC
* wwCodeUpdate :: RunUpdateExe
************************************************************************
* wwCodeUpdate :: CopyUpdate
*********************************
*** Function: Once downloaded copies the update
*** Assume:
*** Pass:
*** Return:
************************************************************************
FUNCTION CopyUpdate
OP = CREATEOBJECT("wwProgressForm")
OP.SetCaption("File Update")
OP.SetDescription("Updating file:" + THIS.cExeFile)
OP.HideProgressBar()
OP.SHOW()
IF MESSAGEBOX("Ready to update your application",32+4,"Code Update") = 6
COPY FILE (THIS.cExeFile) TO (".\codeupdate\" + THIS.cExeFile + "_bak")
COPY FILE (".\codeupdate\" + THIS.cExeFile) TO (THIS.cExeFile)
ENDIF
ENDFUNC
* wwCodeUpdate :: CopyUpdate
************************************************************************
* wwCodeUpdate :: CreateHTTPClient
****************************************
*** Function:
*** Assume:
*** Pass:
*** Return:
************************************************************************
FUNCTION CreateHTTPClient()
THIS.oHTTP = CREATEOBJECT("CU_wwHTTP")
THIS.oHTTP.nConnectTimeout = THIS.nConnectTimeout
RETURN THIS.oHTTP
ENDFUNC
* wwCodeUpdate :: CreateHTTPClient
************************************************************************
* wwCodeUpdate :: SetError
*********************************
PROTECTED FUNCTION SetError
LPARAMETERS lcErrorMsg
IF PCOUNT() = 0
THIS.lError = ""
THIS.cErrorMsg = ""
ELSE
THIS.lError = .T.
THIS.cErrorMsg = lcErrorMsg
ENDIF
ENDFUNC
* wwCodeUpdate :: SetError
ENDDEFINE
*****************************************************
DEFINE CLASS CU_wwHTTP AS wwHTTP
**************************************
*** Custom properties dealing with display
*** of download information
lShowDialog = .F.
oProgressForm = .NULL.
cCaption = "Se descarca actualizarea..."
nContentSize = 0
************************************************************************
* CU_wwHTTP :: OnHTTPBufferUpdate
************************************
*** Function: HTTP Progress Event Handler
*** Assume: Relies on wwDialogs.vcx for Progress Form
*** Pass:
*** Return:
************************************************************************
FUNCTION OnHTTPBufferUpdate
LPARAMETERS lnbytes,lnbufferreads,lccurrentchunk
DO CASE
*** If this is the 0 chunk it's HTTP Header
CASE lnbufferreads = 0
THIS.nContentSize = VAL( Extract(lccurrentchunk,CHR(13)+CHR(10) + "Content-length: ",CHR(13)) )
DO CASE
CASE THIS.nContentSize > 90000
THIS.nHTTPWorkBufferSize = 16484
CASE THIS.nContentSize > 40000
THIS.nHTTPWorkBufferSize = 8182
ENDCASE
RETURN
CASE lnbufferreads = -1
*** Done
DOEVENTS
THIS.oProgressForm = .F.
THIS.oProgressForm = .NULL.
RETURN
OTHERWISE
DOEVENTS
ENDCASE
IF THIS.lShowDialog
IF lnbufferreads=1
THIS.oProgressForm = CREATEOBJECT("wwProgressForm")
THIS.oProgressForm.SetCaption(THIS.cCaption)
THIS.oProgressForm.ShowCancelButton()
THIS.oProgressForm.SHOW()
ENDIF
IF THIS.oProgressForm.lCancelled
THIS.lHTTPCancelDownload = .T.
ENDIF
THIS.oProgressForm.SetDescription("S-au primit de la " + THIS.cServer + ":" +CHR(13) +;
LTRIM( TRANSFORM(lnbytes,"999,999,999") ) + " din " +;
LTRIM(TRANSFORM(THIS.nContentSize,"999,999,999"))+ " bytes")
THIS.oProgressForm.SetProgress(lnbytes/THIS.nContentSize * 100)
ENDIF
ENDFUNC
ENDDEFINE