Code: Select all
/*
Class TUpdate - application update over ftp
--------------------------------------------------
(based on a function from Biel Maimo)
Version 1.3
(c) Stefan Haupt 2012 / 2013
Description: This is a claas to update your application over a Ftp-Server.
Itïs very easy to use, I think the code is self explaining. You
just need some vars to be set, the update is automatically done.
That means your application is closed, the files are copied and
your application is restarted.
Sample:
FUNCTION Update ()
LOCAL oUpdate
LOCAL cFtp := "YourFtpServer"
LOCAL cUser := "YourLoginName"
LOCAL cPW := "YourPassword"
LOCAL cFtpDir := "YourUpdateFolderOnFtp"
LOCAL cUpdFile := "NameOfTheUpdatefile"
LOCAL cLocalDir := "NameOfTheLocalDir"
LOCAL nFlags := <SpecialConnectionFlags> // flag to set passive mode
oUpdate := TUpdate():New(cFtp, cUser, cPW, cFtpDir, cUpdFile, cLocalDir+"Updates\")
oUpdate:nFlags := nFlags
oUpdate:Update ()
oUpdate:End ()
RETURN (nil)
****************************************************************************
Remarks: If you want to use the passive mode in your ftp connection, you have
to update the class TFtp that comes with fwh.
Just replace the method new with this one:
METHOD New( cFTPSite, oInternet, cUserName, cPassword, nFlags ) CLASS TFTP
DEFAULT nFlags := 0
::oInternet = oInternet
::cSite = cFTPSite
::cUserName = cUserName
::cPassword = cPassword
if oInternet:hSession != nil
::hFTP = InternetConnect( oInternet:hSession, cFTPSite, FTP_PORT,;
::cUserName, ::cPassword,;
INTERNET_SERVICE_FTP, nFlags, 0 )
AAdd( oInternet:aFTPs, Self )
endif
return Self
****************************************************************************/
#include "FiveWin.ch"
//#include "xBrowse.ch"
//#define GERMAN
//#define ENGLISH
//#define SPANISH
#define ITALIAN
#ifdef GERMAN
#define txtHEAD "Programmaktualisierung"
#define txtHEAD2 "Überprüfung auf neue Programmversion"
#define txtCONNECT "Verbindung aufbauen..."
#define txtDISCONNECT "Verbindung beenden..."
#define txtNEWUPDATE "Neue Version vorhanden, Aktualisierung durchführen ?"
#define txtNOUPDATE "Die Programmversion ist aktuell"
#define txtDOWNLOAD "Dateien herunterladen"
#define txtUNPACK "Entpacken"
#define txtCANCEL "Abbrechen"
#define txtRESTART "Neu starten"
#define errLOCALDIR "Updateverzeichnis konnte nicht erstellt werden"
#define errADMIN "Sie benötigen Administratorrechte für dieses Update"
#define errNOSERVER "Verbindung zum Server gescheitert"
#define errFTPDIR "Updateverzeichnis auf FTP-Server nicht gefunden"
#define errUPDATEFAIL "Aktualisierung fehlgeschlagen"
#define errDOWNLOAD "Fehler beim Download"
#define errUNPACK "Fehler beim Entpacken"
#endif
#ifdef ENGLISH
#define txtHEAD "Update"
#define txtHEAD2 "Checking for new version"
#define txtCONNECT "Connecting..."
#define txtDISCONNECT "Closing connection..."
#define txtNEWUPDATE "New version found, update ?"
#define txtNOUPDATE "You already have the last version"
#define txtDOWNLOAD "Download files"
#define txtUNPACK "Unpack"
#define txtCANCEL "Cancel"
#define txtRESTART "Restart now"
#define errLOCALDIR "Updatefolder could not be created"
#define errADMIN "You need admin rights to update"
#define errNOSERVER "Server not found, no connecction possible"
#define errFTPDIR "Updatefolder on the server does not exist"
#define errUPDATEFAIL "Update failed"
#define errDOWNLOAD "Error downloading files"
#define errUNPACK "Error unpacking files"
#endif
#ifdef ITALIAN
#define txtHEAD "Aggiornamento"
#define txtHEAD2 "Controllo per nuove versioni"
#define txtCONNECT "Sto connettendo..."
#define txtDISCONNECT "Sto Chiudendo la connessione..."
#define txtNEWUPDATE "Trovata una nuova versione, devo aggiornare ?"
#define txtNOUPDATE "Non ci sono nuove versioni rilasciate.@@@E' già installata l'ultima versione."
#define txtDOWNLOAD "_ gli archivi"
#define txtUNPACK "Unpack"
#define txtCANCEL "Annulla"
#define txtRESTART "Riavviare"
#define errLOCALDIR "La cartella di aggiornamento non è stata creata"
#define errADMIN "Necessita un account amministratore per aggiornare"
#define errNOSERVER "Server non trovato, nessuna connesione possibile"
#define errFTPDIR "La cartella di aggiornamento non esiste sul server"
#define errUPDATEFAIL "Aggiornamento non è andato a buon fine"
#define errDOWNLOAD "Errore durante il download degli archivi"
#define errUNPACK "Errore durante la decompressione degli archivi"
#endif
#define INTERNET_FLAG_PASSIVE 0x08000000 // used for FTP connections - 134217728
#define ZTRIM( cString ) Left( cString, At( Chr( 0 ), cString ) - 1 )
//--------------------------------------------------------------------------//
CLASS TUpdate
DATA oInternet AS OBJECT
DATA oFtp AS OBJECT
DATA nFlags AS NUMERIC
DATA cIP AS CHARACTER // Ftp-Server
DATA cUser AS CHARACTER // login name
DATA cPW AS CHARACTER // password
DATA cFtpFolder AS CHARACTER // folder on ftp where update files are
DATA cZipFile AS CHARACTER // name of the update file (must be zip)
DATA cLocalDir AS CHARACTER // local folder where the update files are copied
DATA cAppDir AS CHARACTER // applications folder
DATA cAppFile AS CHARACTER // name of the application
DATA aUpdateFiles AS ARRAY // files in the zip
DATA cUpdateBatch AS CHARACTER // path and name of the update batchfile
//DATA lRestartApp AS LOGICAL INIT .f.
DATA nError INIT 0 // common error
METHOD New () CONSTRUCTOR // create a new instance, initialize all vars
METHOD End () // close the connection
METHOD Update () // update the application
//METHOD Setup () HIDDEN // all other methods are only for internal use
METHOD Download () HIDDEN
METHOD DownloadFile () HIDDEN
METHOD UnpackFile () HIDDEN
METHOD WriteBatch () HIDDEN
ENDCLASS
//----------------------------------------------------------------------
METHOD New (cIP, cUser, cPW, cFTPFolder, cZIPFile, cLocalDir, nFlags) CLASS TUpdate
DEFAULT cIP := "localhost",;
cUser := "anonymous",;
cPW := "anonymous@localhost",;
cFtpFolder := "/",;
cZipFile := "",;
cLocalDir := cFilePath( GetModuleFileName( GetInstance() ) ) + "Updates\" ,;
nFlags := 0
::cIP := cIp
::nFlags := nFlags // special flags for ftp, eg. passive mode
::cUser := cUser
::cPW := cPW
::cFtpFolder := cFtpFolder
::cZipFile := cZipFile
::cAppFile := GetModuleFileName( GetInstance() )
::cAppDir := cFilePath (GetModuleFileName( GetInstance() ) )
::cLocalDir := cLocalDir
::cUpdateBatch := ::cLocalDir + "Update.cmd"
IF !IsDir (::cLocalDir) // create updatefolder
IF (::nError := MakeDir (::cLocalDir)) != 0
MsgAlert (errLOCALDIR, txtHEAD)
ENDIF
ENDIF
IF !IsAdmin () //
::nError := 1
MsgAlert (errADMIN, txtHEAD)
ENDIF
RETURN (self)
//----------------------------------------------------------------------
METHOD End () CLASS TUpdate
LOCAL bClose := {|| ::oFtp:END(), ::oInternet:END()}
IF ::nError = 0
MsgRun (txtDISCONNECT,,bClose)
ENDIF
RETURN (nil)
//----------------------------------------------------------------------
METHOD Update () CLASS TUpdate
LOCAL cFile, nSize, dDate, cTime, aTime
LOCAL cFtpFile, dFtpDate, cFtpTime, nFtpSize
LOCAL aF := {}, aFiles:={}
LOCAL lIsFile := .f. // update file exists ?
LOCAL aUpdate := {}, lSuccess := .f.
LOCAL bConnect := {|| ::oInternet := tInternet():New(),;
::oFtp := tFtp():New (::cIp, ::oInternet, ::cUser, ::cPW, ::nFlags) }
IF ::nError != 0
Return (nil)
ENDIF
IF !Empty (::cIP)
CursorWait ()
MsgRun (txtCONNECT,,bConnect)
CursorArrow ()
IF Empty (::oFtp:hFtp)
MsgStop (errNOSERVER, txtHEAD)
//::oFtp:END()
//::oInternet:END()
ELSE
IF !::oFtp:SetCurrentDirectory( ::cFtpFolder )
// IF ::oFtp:GetCurrentDirectory() <> ::cFtpFolder
MsgStop (errFTPDIR, txtHEAD)
RETURN (nil)
ENDIF
aFiles := ::oFtp:Directory (::cZipFile) // all files in ftp folder
IF !Empty (aFiles)
AEval (aFiles, {|x| Aadd (aF, {ZTRIM (x[1]), x[2], x[3], x[4] } )} )
cFtpFile := aF[1,1] // filename
dFtpDate := aF[1,3] //
cFtpTime := aF[1,4] //
nFtpSize := aF[1,2] //
cFile := ::cLocalDir + ::cZipFile // local file
IF File (cFile)
aTime := FileTimes ( cFile, 1 )
dDate := CToD (Str( aTime[ 3 ], 2 ) + "/" + StrZero( aTime[ 2 ], 2 ) + "/" + StrZero( aTime[ 1 ], 4 ))
cTime := StrZero ( aTime[ 4 ], 2 ) + ":" + StrZero( aTime[ 5 ], 2 ) + ":" + StrZero( aTime[ 6 ], 2 )
nSize := FileSize ( cFile )
lIsFile := .t.
ENDIF
IF !lIsFile .or. ; // updatefile not present
(dDate < dFtpDate).OR.; // copmpare date and time
(dDate == dFtpDate .AND. (TimeToSec (cTime ) < TimeToSec (cFtpTime) ) )
IF MsgYesNo(txtNEWUPDATE, txtHEAD2)
IF ::Download (cFtpFile , cFile, nFtpSize, dFtpDate, cFtpTime)
::oFtp:END()
::oInternet:END()
IF ::WriteBatch ()
CLOSE ALL
WinExec (::cUpdateBatch)
PostQuitMessage(0)
QUIT
ELSE
MsgStop (errUPDATEFAIL, txtHEAD)
ENDIF
ENDIF
ENDIF // MsgYesNo
ELSE
MsgInfo (txtNOUPDATE, txtHEAD)
ENDIF // IF (dDate < dFtpDate).OR
ELSE
MsgInfo (txtNOUPDATE, txtHEAD)
ENDIF // !Empty (aFiles)
ENDIF // Empty (::oFtp:hFtp)
ENDIF // !Empty (::cIP)
RETURN (nil)
//----------------------------------------------------------------------
METHOD Download (cSource, cTarget, nSize, dDate, cTime) CLASS TUpdate
LOCAL oDlg, oSay1, oSay2, oBtnCancel, oMeter1, oMeter2, nMeter1, nMeter2
LOCAL lEnd:=.F., nAmount, lOk:=.F., lValRet:=.F.
LOCAL hFile
LOCAL cError1 := errDOWNLOAD
LOCAL cError2 := errUNPACK
// orange
// GRADIENT TRACK { { 1/2, nRGB( 198, 203, 213 ), nRGB( 219, 224, 233 ) },;
// { 1/2, nRGB( 224, 238,237 ), nRGB( 224, 238,237 ) } } ;
DEFINE DIALOG oDlg TITLE txtHEAD FROM 0,0 TO 10,50
@ 0.5,01 SAY oSay1 PROMPT txtDOWNLOAD SIZE 80,8 OF oDlg
@ 1.2,01 METEREX oMeter1 VAR nMeter1 SIZE 180,10 TOTAL nSize ;
GRADIENT TRACK { { 1/2, nRGB( 198, 203, 213 ), nRGB( 219, 224, 233 ) },;
{ 1/2, nRGB( 224, 238,237 ), nRGB( 224, 238,237 ) } } ;
OF oDlg
@ 02 ,01 SAY oSay2 PROMPT txtUNPACK OF oDlg
@ 2.7,01 METEREX oMeter2 VAR nMeter2 SIZE 180,10 TOTAL 0 ;
GRADIENT TRACK { { 1/2, nRGB( 198, 203, 213 ), nRGB( 219, 224, 233 ) },;
{ 1/2, nRGB( 224, 238,237 ), nRGB( 224, 238,237 ) } } ;
OF oDlg
@ 3.2,12 BUTTON oBtnCancel PROMPT txtCANCEL ACTION ( lEnd := .t., SysRefresh(), oDlg:End() )
oDlg:bStart := {|| lOk := ::DownloadFile ( cSource, nSize, oMeter1, @lEnd, oDlg, cTarget ),;
IIF (lOk, SetFDaTi (cTarget, dDate, cTime), MsgStop (cError1) ),;
IIF (lOk, lOk := ::UnPackFile (cTarget, oMeter2), ),;
IIF (lOk, (oBtnCancel:SetText( txtRESTART ), oBtnCancel:bAction := {|| lEnd := .f., oDlg:End()} ),;
MsgStop (cError2) ) }
ACTIVATE DIALOG oDlg CENTERED
IF !lEnd .AND. lOk
lValRet:=.T.
ENDIF
RETURN (lValRet)
//----------------------------------------------------------------------------------------
METHOD DownloadFile ( cSource, nSize, oMeter, lEnd, oDlg, cTarget ) CLASS TUpdate
LOCAL oFile, hTarget, lValRet:=.F.
LOCAL nBufSize,cBuffer,nBytes := 0, nTotal := 0//, nFile:=0
LOCAL lRet := .f.
nBufSize := 4096
cBuffer := Space(nBufSize)
hTarget := FCreate (cTarget)
oFile := tFtpFile():New( cSource, ::oFtp )
oFile:OpenRead()
SysRefresh()
WHILE ( nBytes := Len( cBuffer := oFile:Read( nBufSize ) ) ) > 0 .and. !lEnd
FWrite( hTarget, cBuffer, nBytes )
nTotal += nBytes
oMeter:Set( nTotal )
SysRefresh()
END
FClose( hTarget )
oFile:End()
IF nTotal > 0
lRet := (nTotal==nSize)
ENDIF
RETURN (lRet)
//----------------------------------------------------------------------------------------
METHOD UnPackFile (cZip, oMeter) CLASS TUpdate
LOCAL aUpdate :={}, aFiles := {}, aUnzip := {}, n := 1
LOCAL lSuccess := .f.
LOCAL bProgress := {|| oMeter:Set (n++) }
LOCAL cPath := cFilePath (cZip)
aUpdate := hb_GetFilesInZip( cZip, .t. )
IF Len (aUpdate) > 0
AEval (aUpdate, {|x| Aadd (aFiles, {x[1], x[6], x[7]} ) } )
AEval (aUpdate, {|x| Aadd (aUnzip, x[1]) } )
oMeter:nTotal:= Len (aUnzip)
lSuccess := hb_UnZipFile( cZip , ;
bProgress,; //
nil,; // lWithSubDir
nil,; // cPassword
cPath,; // cZipDir
aUnzip ,;
nil ) // bFileProgress
AEval (aFiles, {|x| SetFDaTi (cPath+x[1], x[2], x[3]) } ) // restore original date and time !!
ENDIF
::aUpdateFiles := AClone (aUnzip)
RETURN (lSuccess)
//-------------------------------------------------------------------------------
METHOD WriteBatch () CLASS TUpdate
LOCAL hBatch,i
LOCAL cBatch, cCopy := "", cDel := "", cS := ["]
FErase (::cUpdateBatch)
FOR i := 1 TO Len (::aUpdateFiles)
cCopy += "Copy /Y /B /V " + cS + ::cLocalDir + ::aUpdateFiles[i] + cS + " " + cS + ::cAppDir + cS + " > NUL" + CRLF
cDel += "Del /F " + cS + ::cLocalDir + ::aUpdateFiles[i] + cS + " >NUL" + CRLF
NEXT
cBatch := "@Echo off"+CRLF+;
"echo Updating ..."+CRLF+;
"ping -n 2 127.0.0.1 > NUL"+CRLF+; // waiting 2 secs
cCopy +;
"Start " + cS + "update" + cS + " " + cS + ::cAppFile + cS + CRLF +;
cDel +;
"EXIT"
hBatch := FCreate (::cUpdateBatch,0)
FWrite (hBatch, cBatch)
FClose (hBatch)
RETURN (FError() = 0)
// FUNCIONES PARA CONVERIR HORA A SEGUNDOS, Y VICEVERSA
//--------------------------------------------------------
STATIC FUNCTION TimeToSec( cTime )
local nSec := 0, nLen, i, aLim, aMod, nInd, n
if cTime == NIL
nSec := seconds()
elseif HB_ISCHAR( cTime )
nLen := len( cTime )
if ( nLen + 1 ) % 3 == 0 .and. nLen <= 11
nInd := 1
aLim := { 24, 60, 60, 100 }
aMod := { 3600, 60, 1, 1/100 }
for i := 1 to nLen step 3
if isdigit( substr( cTime, i, 1 ) ) .and. ;
isdigit( substr( cTime, i + 1, 1 ) ) .and. ;
( i == nLen - 1 .or. substr( cTime, i + 2, 1 ) == ":" ) .and. ;
( n := val( substr( cTime, i, 2 ) ) ) < aLim[ nInd ]
nSec += n * aMod[ nInd ]
else
nSec := 0
exit
endif
++nInd
next
endif
endif
RETURN (Round( nSec, 2)) /* round FL val to be sure that you can compare it */
//----------------------------------------------------------------------
#pragma BEGINDUMP
#include <WinTen.h>
#include <Windows.h>
#include <mapiwin.h>
#include <hbApi.h>
#include <CommDlg.h>
extern LPSTR LToStr( long w );
//nTime 1=Last Update, 2=Last Acces, 3=Creation, defecto last update
HB_FUNC( FILETIMES ) // params cFileName, nTime --> { nYear, nMonth, nDay, nHour, nMin, nSec }
{
LPSTR cFileName = hb_parc( 1 ) ;
int nTime = ( ISNUM( 2 ) ? hb_parni( 2 ) : 1 ) ; // defaults to 1
FILETIME ftCreate, ftAccess, ftWrite ;
SYSTEMTIME stTime ;
BOOL bRet ;
HANDLE hFile = CreateFile( cFileName, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0 ) ;
if( ! hFile )
return ;
GetFileTime( (HANDLE) hFile, &ftCreate, &ftAccess, &ftWrite ) ;
switch( nTime )
{
case 1 : // last update
FileTimeToSystemTime( &ftWrite, &stTime ) ;
break ;
case 2 : // last access
FileTimeToSystemTime( &ftAccess, &stTime ) ;
break ;
case 3 : // creation
FileTimeToSystemTime( &ftCreate, &stTime ) ;
break ;
default : // last update
FileTimeToSystemTime( &ftWrite, &stTime ) ;
break ;
}
SystemTimeToTzSpecificLocalTime( NULL, &stTime, &stTime ) ;
CloseHandle( hFile ) ;
hb_reta( 6 ) ;
hb_storni( stTime.wYear, -1, 1 ) ;
hb_storni( stTime.wMonth, -1, 2 ) ;
hb_storni( stTime.wDay, -1, 3 ) ;
hb_storni( stTime.wHour, -1, 4 ) ;
hb_storni( stTime.wMinute, -1, 5 ) ;
hb_storni( stTime.wSecond, -1, 6 ) ;
}
#define FA_RDONLY 1 /* R */
#define FA_HIDDEN 2 /* H */
#define FA_SYSTEM 4 /* S */
#define FA_LABEL 8 /* V */
#define FA_DIREC 16 /* D */
#define FA_ARCH 32 /* A */
#define FA_NORMAL 0
HB_FUNC(FILESIZE)
{
LPCTSTR szFile;
DWORD dwFlags=FILE_ATTRIBUTE_ARCHIVE;
HANDLE hFind;
WIN32_FIND_DATA hFilesFind;
int iAttr;
if (hb_pcount() >=1){
szFile=hb_parc(1);
if (ISNUM(2)) {
iAttr=hb_parnl(2);
}
else{
iAttr=63;
}
if( iAttr & FA_RDONLY )
dwFlags |= FILE_ATTRIBUTE_READONLY;
if( iAttr & FA_HIDDEN )
dwFlags |= FILE_ATTRIBUTE_HIDDEN;
if( iAttr & FA_SYSTEM )
dwFlags |= FILE_ATTRIBUTE_SYSTEM;
if( iAttr & FA_NORMAL )
dwFlags |= FILE_ATTRIBUTE_NORMAL;
hFind = FindFirstFile(szFile,&hFilesFind);
if (hFind != INVALID_HANDLE_VALUE){
if (dwFlags & hFilesFind.dwFileAttributes) {
if(hFilesFind.nFileSizeHigh>0)
hb_retnl((hFilesFind.nFileSizeHigh*MAXDWORD)+hFilesFind.nFileSizeLow);
else
hb_retnl(hFilesFind.nFileSizeLow);
}
else
hb_retnl(-1);
}
}
}
HB_FUNC (ISADMIN)
{
HANDLE hToken;
PTOKEN_GROUPS pGroupInfo;
DWORD dwSize = 0, dwResult;
DWORD nError = 0, i;
BOOL lError, lAdMin = FALSE;
LPSTR cFunc = "";
PSID psidAdmin;
CHAR cMess[200];
SID_IDENTIFIER_AUTHORITY SystemSidAuthority= SECURITY_NT_AUTHORITY;
if ( lError = (! OpenProcessToken(GetCurrentProcess(),TOKEN_QUERY,&hToken) ))
{
cFunc = "OpenProcessToken";
nError = GetLastError();
if (nError == ERROR_CALL_NOT_IMPLEMENTED)
{
hb_retl( TRUE );
return;
}
}
if ( ! lError && ! GetTokenInformation(hToken, TokenGroups, NULL, dwSize, &dwSize))
{
dwResult = GetLastError();
if( lError=(dwResult != ERROR_INSUFFICIENT_BUFFER ))
{
nError = dwResult;
cFunc = "GetTokenInformation";
}
}
if ( ! lError )
{
pGroupInfo = (PTOKEN_GROUPS) GlobalAlloc( GPTR, dwSize );
if( lError = (! GetTokenInformation(hToken, TokenGroups, pGroupInfo, dwSize, &dwSize ) ))
{
nError = GetLastError();
cFunc = "GetTokenInformation";
}
}
if ( ! lError )
if ( lError = (! AllocateAndInitializeSid ( &SystemSidAuthority, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &psidAdmin) ))
{
nError = GetLastError();
cFunc = "AllocateAndInitializeSid";
}
if ( ! lError )
{
for( i=0; i<pGroupInfo->GroupCount; i++)
{
if ( EqualSid(psidAdmin, pGroupInfo->Groups[i].Sid) )
{
lAdMin = TRUE;
break;
}
}
}
else
{
cMess[0]=0;
lstrcat(cMess,"Error calling ");
lstrcat(cMess,cFunc);
lstrcat(cMess,": ");
lstrcat(cMess,LToStr(nError));
MessageBox(GetActiveWindow(),cMess,"Attention", MB_OK);
}
if (psidAdmin)
FreeSid(psidAdmin);
if ( pGroupInfo )
GlobalFree( pGroupInfo );
CloseHandle( hToken );
hb_retl( lAdMin );
}
#pragma ENDDUMP
