Page 1 of 3

Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 10:27 am
by ukoenig
Hello,

1. is there a function to download a defined file from my homepage ?
I need a solution, the user can download a given zip-file for a update on buttonaction.

sample :
cUrl := "http://www.pflegeplus.com/DOWNLOADS/Myupdate.zip"
the same like we do in the forum for download :
????????

2. a solution to place a DBF in the CLOUD to be used to update the file on another computer ?

best regards
Uwe :?:

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 10:53 am
by Silvio.Falconi
there a clas called s TUpdate from our friend Prof. Ing. Stephan Haupt ( great loss we hope he rest in peace forever)

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 11:17 am
by ukoenig
Silvio,

thank You for the info.
I didn't know about it.
It seems to be the solution I'm looking for.

regards
Uwe :D

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 11:39 am
by Silvio.Falconi

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
 

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 12:57 pm
by ukoenig
Silvio,

NO connection to the server

my function

//DEFAULT cIP := "localhost",;
// cUser := "anonymous",;
// cPW := "anonymous@localhost",;
// cFtpFolder := "/",;
// cZipFile := "",;
// cLocalDir := cFilePath( GetModuleFileName( GetInstance() ) ) + "Updates\" ,;
// nFlags := 0

FUNCTION PFL_DOWNLD()
LOCAL oUpdate
LOCAL cFtp := "www.pflegeplus.com"
//LOCAL cFtp := "http://www.pflegeplus.com" // test
//LOCAL cFtp := "pflegeplus.com" // test
LOCAL cUser := "--------" // user
LOCAL cPW := ---------" // password
LOCAL cFtpDir := "/Software/DOWNLOADS/" // downloaddir
LOCAL cUpdFile := "BARTEST1.zip" // file
LOCAL cLocalDir := "I:/DOWNLOADS/" // destination
LOCAL nFlags := 0 // flag to set passive mode

oUpdate := TUpdate():New( cFtp, cUser, cPW, cFtpDir, cUpdFile, cLocalDir +"Updates\" )
oUpdate:nFlags := nFlags
oUpdate:Update()
oUpdate:End ()

RETURN ( NIL )


I got the message < Server not found, no connecction possible >

A normal working download looks like : http://www.pflegeplus.com/DOWNLOAD/Test.zip

my normal working connection

Image

regards
Uwe :?:

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 3:18 pm
by Gale FORd
I don't think it works for http://www.mysite.com it has to be ftp.mysite.com
It works with FTP port.
I have it working for a couple of my programs.

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 3:20 pm
by byte-one
Uwe, no answer to connection, but

Code: Select all

LOCAL cLocalDir := "I:/DOWNLOADS/" // destination
should be

Code: Select all

LOCAL cLocalDir := "I:\DOWNLOADS\" // destination

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 3:47 pm
by ukoenig
I tested everything, but NO connection

a minimumtest only to connect :

FUNCTION DOWNLD()
LOCAL oUpdate
LOCAL cFtp := "www.pflegeplus.com"
LOCAL cUser := "---------" // user
LOCAL cPW := "---------" // password

oUpdate := TUpdate():New( cFtp, cUser, cPW )
oUpdate:Update()
oUpdate:End ()

RETURN ( NIL )


my working settings to connect without any problems :

Image

there is a short running-message of the connection-try

Image

any idea ?

regards
Uwe :|

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 4:31 pm
by ukoenig
Gale,
I don't think it works for http://www.mysite.com it has to be ftp.mysite.com
It works with FTP port.
I have it working for a couple of my programs.
tested as well

LOCAL cFtp := "ftp.pflegeplus.com"

NO connection.

regards
Uwe :(

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 4:43 pm
by Gale FORd
Do you have a FTP setup on your server using port 21?
The TUpdate I use works only if there is a FTP server. If you are trying to download file from regular Web server then it will not work.

Code: Select all

//TUpdate uses tFTp class
::oFtp      := tFtp():New(::cIp, ::oInternet, ::cUser, ::cPW, ::nFlags) }
 

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 4:56 pm
by ukoenig
Gale,

I'm afraid that it is the problem.

FOUND !!! :oops:

nothing else I need

ACTION DOWNLD( oDlg1,"Trtext1zip")
-----------------
FUNCTION DOWNLD( oDlg1, cFile )
cDownload := "http://www.pflegeplus.com/DOWNLOADS/" + cFile
ShellExecute( oDlg1, ,cDownload, , , 5 )
RETURN ( NIL )


the download-result of a defined zip-file

Image

It would be perfect, to copy the download straight to the defined folder.
I think it can be fixed defined what to do with the zip-file.

Still much better maybe possible a < QUITE > download

because there are many tools stored in the homepage as a download
You can collect the download-links and simply download them with just one line like :
ShellExecute( oDlg1, ,"http://www.pflegeplus.com/DOWNLOADS/Trtext1zip", , , 5 ) // download of alphabmp-sample

regards
Uwe :D

Re: Function to download a defined file from a homepage ?

Posted: Thu Apr 21, 2016 11:55 pm
by russimicro

Code: Select all

   IF !FILE("Ammyy5.exe") 

        cDirSer := cNomSer+"/actualiz"
        oUrl := tURL():New(http+cDirSer+"/Ammyy5.rar" )
        oClient := tIPClientHTTP():New( oUrl )
        oClient:nConnTimeout := nSegEsp
        IF oClient:Open( oUrl )
           oClient:ReadToFile( cRutDes+"Ammyy5.rar",nil,nil,"no borra chr(13)")
           oClient:Close()
        ELSE
           MYMEN("Error. No fue posible conectarse al servidor "+cNomSer)
           return
        ENDIF
  ENDIF
 

Re: Function to download a defined file from a homepage ?

Posted: Fri Apr 22, 2016 9:52 am
by ukoenig
russimicro,

I tested but doesn't work :(
maybe Your defined vars are different ?

tIPClientHTTP not supported !!!
IF !FILE("Ammyy5.exe")

cDirSer := cNomSer+"/actualiz"
oUrl := tURL():New(http+cDirSer+"/Ammyy5.rar" )
oClient := tIPClientHTTP():New( oUrl )
oClient:nConnTimeout := nSegEsp
IF oClient:Open( oUrl )
oClient:ReadToFile( cRutDes+"Ammyy5.rar",nil,nil,"no borra chr(13)")
oClient:Close()
ELSE
MYMEN("Error. No fue posible conectarse al servidor "+cNomSer)
return
ENDIF
ENDIF
FUNCTION DOWNLOAD()
LOCAL cServer := "http:www.Pflegeplus.com"
LOCAL cDirSer := "/Software/DOWNLOADS"

oUrl := tURL():New( cServer + cDirSer + "/Pflegepl_4.zip" )
oClient := tIPClientHTTP():New( oUrl )
oClient:nConnTimeout := 3
IF oClient:Open( oUrl )
oClient:ReadToFile( "D:\" + "Pflegepl_4.zip", nil, nil, "no borra chr(13)")
oClient:Close()
ELSE
MsgAlert( "not connected" )
ENDIF

RETURN ( NIL )


any idea ?

best regards
Uwe

Re: Function to download a defined file from a homepage ?

Posted: Fri Apr 22, 2016 3:32 pm
by MaxP
I use this function to download a file

Code: Select all

#include "fivewin.ch"

function Main()
        LOCAL   nRet
        
        nRet := DOWNLOADFILE( "http://www.yoursite.it/index.html", "C:\index.html" )
        
        MsgStop( nRet )
RETURN NIL


#pragma BEGINDUMP

#include <WinTen.h>
#include <Windows.h>
#include <ClipApi.h>
#include <urlmon.h> 
#include "hbapi.h"
#include "hbvm.h"
#include "hbstack.h"

HB_FUNC( DOWNLOADFILE )

{
        unsigned long   lRet ;
        
        lRet = URLDownloadToFile( NULL, _parc( 1 ), _parc( 2 ), 0, NULL ) ;
        
        _retnl( lRet ) ;
}

#pragma ENDDUMP
 
best regards
Massimo

Re: Function to download a defined file from a homepage ?

Posted: Fri Apr 22, 2016 4:00 pm
by ukoenig
Massimo,

got a error

unresolved external < URLDownloadToFileA >

not possible to compile.

I tested from samples : Icopyfil.prg and could connect to my homepage
but maybe still something wrong because there is no visible downlod process

FTPGetFiles( "www.pflegeplus.com", ;
{ "Software\DOWNLOADS\cPicker1.zip" }, ;
{ "I:\cPicker1.zip" } )


MsgRun( "Verbinde mit Internet...", "Bitte warten",;
{ || oInternet := TInternet():New(),;
oFTP := TFTP():New( cFTPSite, oInternet, "-------", "--------" ) } )
// name and password needed !!!

Image

regards
Uwe :(