FiveTech Software tech support forums

Code: Select all  Expand view

/*
   Class TUpdate - application update over ftp
   --------------------------------------------------
   (based on a function from Biel Maimo)

   Version 1.2
   (c) Stefan Haupt 2012

   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> // use 134217728 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 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 ("Updateverzeichnis konnte nicht erstellt werden","Programmaktualisierung")
    ENDIF
  ENDIF

  IF !IsAdmin ()                               // n
    ::nError := 1
    MsgAlert ("Sie benötigen Administratorrechte für dieses Update","Programmaktualisierung")
  ENDIF

RETURN (self)


//----------------------------------------------------------------------
METHOD End ()

  LOCAL bClose := {|| ::oFtp:END(), ::oInternet:END()}

  IF ::nError = 0
    MsgRun ("Verbindung beenden...",,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 ("Verbindung aufbauen...",,bConnect)
    CursorArrow ()

    IF Empty (::oFtp:hFtp)
      MsgStop ("Verbindung zum Server gescheitert", "Programmaktualisierung")
      //::oFtp:END()
      //::oInternet:END()
    ELSE

      ::oFtp:SetCurrentDirectory( ::cFtpFolder )
//     cDir := oFtp:GetCurrentDirectory()
      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('Neue Version vorhanden, Aktualisierung durchführen ?',;
                      "Überprüfung auf neue Programmversion")

            IF ::Download (cFtpFile , cFile, nFtpSize, dFtpDate, cFtpTime)
              ::oFtp:END()
              ::oInternet:END()
              IF ::WriteBatch ()
                CLOSE ALL
                WinExec (::cUpdateBatch)
                PostQuitMessage(0)
                QUIT
              ELSE
                MsgStop ("Aktualisierung fehlgeschlagen", "Programmaktualisierung")
              ENDIF
            ENDIF

          ENDIF // MsgYesNo
        ELSE
          MsgInfo ("Die Programmversion ist aktuell","Programmaktualisierung")
        ENDIF // IF (dDate < dFtpDate).OR

      ELSE
        MsgInfo ("Die Programmversion ist aktuell","Programmaktualisierung")
      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 := "Fehler beim Download"
  LOCAL cError2 := "Fehler beim Entpacken"

  // 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 "Programm-Aktualisierung" FROM 0,0 TO 10,50

   @ 0.5,01 SAY oSay1 PROMPT "Dateien herunterladen" 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 "Entpacken" 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 "&Abbrechen" 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( "&Neu starten" ), 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)



// convert hours to seconds
//--------------------------------------------------------
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
 

James Bott wrote:Could you explain how this works? Can it be called from a menu in an app, and if so, what then happens?

Code: Select all  Expand view

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)

Can we somehow check for a new version from a running app?

Code: Select all  Expand view

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 )  // changed !
            AAdd( oInternet:aFTPs, Self )
         endif

      return Self
 

TimStone wrote:I wrote an auto update routine which runs in the background all of the time in the folder where the database files are stored.

1) Every 3 hours query the server and download a "version file".

2) Check the customer's status. If they are eligible, then download and unpack the zip file to its update directory.