FTP AVEC THERMOMETRE

FUNCTION LOCAL_VERS_WEB(ficsurleweb,ficaenvoyer)
retour=.f.
*--------------------------------------------------------------------------*
* FTP
* Classe pour le transfert FTP
*--------------------------------------------------------------------------*

#DEFINE INTERNET_INVALID_PORT_NUMBER   0
#DEFINE INTERNET_OPEN_TYPE_DIRECT      1
#DEFINE INTERNET_SERVICE_FTP           1
#DEFINE FTP_TRANSFER_TYPE_ASCII        1
#DEFINE FTP_TRANSFER_TYPE_BINARY       2
#DEFINE INTERNET_FLAG_NEED_FILE       16
#DEFINE FILE_ATTRIBUTE_DIRECTORY      16
#DEFINE GENERIC_READ    2147483648   && &H80000000
#DEFINE GENERIC_WRITE   1073741824   && &H40000000

objet=createobject("ftp")
toto=objet.CONNEXION(maconnexion,mon_loing,mon_motdepasse)
if toto
    objet.changerepertoire("www/transfert")
*!*     objet.EnvoyerFichier("c:\aumeric\temp\totototo.txt","creat.txt")
    fd_ftp=objet.OuvrirFichier(ficsurleweb,.t.
    
    


quel= objet.misjour_ftp_vers_WEB( ficsurleweb, ficaenvoyer )
if quel 
messagebox("L'envoi du fichier "+ ficaenvoyer + " a réussi" )
else
  messagebox("L'envoi du fichier "+ ficaenvoyer + "n' a pas réussi" )
endif
retour=quel
objet.destroy()
else
messagebox("La connexion n'a pas réussi, assurez vous d'avoir une connexion internet en cours ") 
endif
release objet

return retour






*-------------------------------------



FUNCTION WEB_VERS_LOCAL(ficaenvoyer,ficsurleweb)
retour=.f.
*--------------------------------------------------------------------------*
* FTP
* Classe pour le transfert FTP
* Ecrit par anatole
* modifié par aumeric
*--------------------------------------------------------------------------*

#DEFINE INTERNET_INVALID_PORT_NUMBER   0
#DEFINE INTERNET_OPEN_TYPE_DIRECT      1
#DEFINE INTERNET_SERVICE_FTP           1
#DEFINE FTP_TRANSFER_TYPE_ASCII        1
#DEFINE FTP_TRANSFER_TYPE_BINARY       2
#DEFINE INTERNET_FLAG_NEED_FILE       16
#DEFINE FILE_ATTRIBUTE_DIRECTORY      16
#DEFINE GENERIC_READ    2147483648   && &H80000000
#DEFINE GENERIC_WRITE   1073741824   && &H40000000

objet=createobject("ftp")
toto=objet.CONNEXION(ma connextion,mon login,mon  motdepasse)
if toto
    objet.changerepertoire("www/transfert")
*!* objet.prendrefichier("eteocle.exe","c:\testeteocele.exe")

   fd_ftp=objet.OuvrirFichier(ficsurleweb)
   taillefic=FtpGetFileSize(fd_ftp, .F.

quel= objet.misjour_ftp_vers_local(ficsurleweb,ficaenvoyer)
if quel 
messagebox("L'envoi du fichier "+ ficaenvoyer + " a réussi" )
else
  messagebox("L'envoi du fichier "+ ficaenvoyer + "n' a pas réussi" )
endif
retour=quel
objet.destroy()
else
messagebox("La connexion n'a pas réussi, assurez vous d'avoir une connexion internet en cours ") 
endif
release objet

return retour





define class FTP as custom

  mOpen       = null && handle de l'ouverture internet
  mConnect    = null && handle de connexion au serveur FTP

  *--------------------------------------------------------------------------*
  procedure init()

    declare integer InternetOpen in wininet;
      string  sAgent,;
      integer lAccessType,;
      string sProxyName,;
      string sProxyBypass,;
      string lFlags

    declare integer InternetCloseHandle in wininet;
      integer hInet

    declare integer InternetConnect in wininet;
      integer hInternetSession,;
      string sServerName,;
      integer nServerPort,;
      string sUsername,;
      string sPassword,;
      integer lService,;
      integer lFlags,;
      integer lContext

    declare integer FtpFindFirstFile in wininet;
      integer hFtpSession,;
      string lpszSearchFile,;
      string @lpFindFileData,;
      integer dwFlags,;
      integer dwContent

    declare integer InternetFindNextFile in wininet;
        integer hFind,;
        string @lpvFindData

    declare integer FtpGetCurrentDirectory in wininet;
      integer hFtpSession,;
      string @lpszDirectory,;
      integer @lpdwCurrentDirectory

    declare integer FtpSetCurrentDirectory in wininet;
      integer hFtpSession,;
      string @lpszDirectory

    declare integer FtpOpenFile in wininet;
      integer hFtpSession,;
      string  sFileName,;
      integer lAccess,;
      integer lFlags,;
      integer lContext

    declare integer InternetReadFile in wininet;
      integer hFile,;
      string @lpBuffer,;
      integer dwNumberOfBytesToRead,;
      integer @lpdwNumberOfBytesRead

   declare integer InternetWriteFile in wininet;
     integer  hFile,;
      string @lpBuffer,;
      integer dwNumberOfBytesToWrite,;
      integer @lpdwNumberOfBytesWritten

    declare integer FtpGetFile in wininet;
      integer hFtpSession,;
      string  lpszRemoteFile,;
      string  lpszNewFile,;
      integer fFailIfExists,;
      integer dwFlagsAndAttributes,;
      integer dwFlags,;
      integer dwContext

    declare integer FtpPutFile in wininet;
      integer hConnect,;
      string  lpszLocalFile,;
      string  lpszNewRemoteFile,;
      integer dwFlags,;
      integer dwContext

    declare integer FtpDeleteFile in wininet;
      integer hConnect,;
      string  lpszFileName

    declare integer FtpCreateDirectory in wininet;
      integer hFtpSession,;
      string  lpszDirectory

    declare integer FtpRemoveDirectory in wininet;
      integer hFtpSession,;
      string  lpszDirectory

    declare integer FtpGetFileSize in wininet;
      integer   hFile,;
      integer @ lpdwFileSizeHigh

    declare integer FtpRenameFile in wininet;
      integer hFtpSession,;
      string  lpdzExisting,;
      string  lpdzNew

    declare integer FileTimeToSystemTime in kernel32;
      string @lpFileTime,;
      string @lpSystemTime




  endproc && init

  *--------------------------------------------------------------------------*
  *---> Se connecte au serveur FTP
  procedure Connexion(strHost, strUser, strPwd)
    with this
      .mOpen = InternetOpen ("vfp", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
      if .mOpen = 0
         return .F.
      endif
      .mConnect = InternetConnect (.mOpen, strHost,;
         INTERNET_INVALID_PORT_NUMBER,;
         strUser, strPwd, INTERNET_SERVICE_FTP, 0, 0)
      if .mConnect = 0
         = InternetCloseHandle (.mOpen)
         return .F.
      endif
      return .T.
    endwith
  endproc && Connect

  *--------------------------------------------------------------------------*
  *---> Fermeture de la connexion à la desctruction de l'objet
  procedure destroy()
    InternetCloseHandle(this.mOpen)
  endproc && destroy

  *--------------------------------------------------------------------------*
  *---> Renvoie le répertoire courant
  procedure RepertoireCourant()
  local v_directory, v_len
    v_directory = space(250)
    v_len = len(v_directory)
    if FtpGetCurrentDirectory (this.mConnect, @v_directory, @v_len) = 1
       return left(v_directory, v_len)
    else
       return ""
    endif
  endproc

  *--------------------------------------------------------------------------*
  procedure ChangeRepertoire(p_dir  )
    return FtpSetCurrentDirectory(this.mConnect, p_dir) > 0
  endproc && ChangeRepertoire

  *--------------------------------------------------------------------------*
  *---> Envoie un fichier sur le serveur
  procedure EnvoyerFichier(p_local ,;
                           p_remote )

    return FtpPutFile(this.mConnect, p_local, p_remote, FTP_TRANSFER_TYPE_BINARY, 0) > 0
  endproc && EnvoyerFichier

  *--------------------------------------------------------------------------*
  *---> Télécharge un fichier sur le serveur
  procedure PrendreFichier(p_remote  ,;
                           p_local  )
    return FtpGetFile(this.mConnect ,;
                     p_remote ,;
                     p_local ,;
                     1 ,; && échec si existe en local
                     FILE_ATTRIBUTE_DIRECTORY ,;
                     FTP_TRANSFER_TYPE_BINARY ,;
                     0) > 0
  endproc && PrendreFichier
*------------------------------------------------------------------------*
procedure misjour_ftp_vers_local (p_remote  , p_local  )

IF FILE(p_local)  && Le fichier existe-t-il?
   gnFichierErreur = FOPEN(p_local,12)     && Si oui, ouvrir en lecture/écriture
ELSE
   gnFichierErreur = FCREATE(p_local)  && Si non, le créer
ENDIF
IF gnFichierErreur < 0     && Recherche les erreurs à l'ouverture du fichier
   WAIT "Impossible d'ouvrir ou de créer le fichier de sortie" WINDOW NOWAIT
ELSE  && S'il n'y a pas d'erreur, écrire dans le fichier



#define FTPBUFSIZ_GET  (32*1024) && ou 4 * 1024, comme tu veux


local Success
Success = .t.
  buf = space(FTPBUFSIZ_GET)  && tu peux mettre cette ligne et la suivante avant le do while
    BytesRead = 0
    n=0
    DO FORM ATTENTEMISEAJOUR with "Réception du fichier "+p_remote+" vers " +p_local
do while m.Success


   sts = InternetReadFile(fd_ftp, @m.Buf, FTPBUFSIZ_GET, @m.BytesRead)
  do case
   case empty(m.sts)
    assert .f.
    Success = .f.
   case empty(m.BytesRead)
    exit
   otherwise
    n = m.n + m.BytesRead
   endcase
attentemiseajour.echelle(n,taillefic)
    aretourner=.t.
*   messagebox(alltrim(str(m.n)))

   do case
   case !m.Success

   case fwrite(gnFichierErreur , m.buf, m.BytesRead) <> m.BytesRead
    =MessageBox('local Write error', 16, m.this.Class)
    Success = .f.

   endcase

enddo

ENDIF
attentemiseajour.release()
=FCLOSE(gnFichierErreur )     && Ferme le fichier
return aretourner


*-------------------------------------------------------------

procedure misjour_ftp_vers_web (p_remote  , p_local  )

Local gnDescripteurFichier,nTaille,cchaine
gnDescripteurFichier = FOPEN(p_local)
* Recherche la fin du fichier pour déterminer le nombre d'octets contenu dans le fichier
nTaille =  FSEEK(gnDescripteurFichier, 0, 2)           && Déplace le pointeur à EOF
IF nTaille <= 0
   * Si le fichier est vide, affiche un message d'erreur
   WAIT WINDOW "Ce fichier est vide!" NOWAIT
ELSE
   * Si le fichier n'est pas vide, le programme stocke son contenu
   * en mémoire, puis affiche le texte dans la fenêtre principale de Visual FoxPro
   = FSEEK(gnDescripteurFichier, 0, 0)              && Déplace le pointeur à BOF
   *!* cchaine = FREAD(gnDescripteurFichier, nTaille)

ENDIF
= FCLOSE(gnDescripteurFichier)
*----
# define FTPBUFSIZ_PUT  (32*1024)

fd = fopen( p_local)
BytesWritten = 0
DO FORM ATTENTEMISEAJOUR with "Réception du fichier "+p_remote+" vers " +p_local
local Success
Success = .t.
*!*   buf = space(FTPBUFSIZ)  && tu peux mettre cette ligne et la suivante   avant le do while
    BytesRead = 0
    n=0

  do while !feof(m.fd) and m.Success

   buf = fread(m.fd, FTPBUFSIZ_PUT)

   do case
   case empty(InternetWriteFile(m.fd_ftp, @m.buf, len(m.buf), @m.BytesWritten))
    =m.this.Error_Show()
    assert .f.
    Success = .f.

   case m.BytesWritten <> len(m.buf)
    =MessageBox('remote Write error', MB_ICONSTOP, m.this.Class)
    assert .f.
    Success = .f.

   otherwise
    n = m.n + m.BytesWritten
     attentemiseajour.echelle(n,ntaille)
    aretourner=.t.
   endcase
enddo
attentemiseajour.release()
= empty(m.fd_ftp) or !empty(InternetCloseHandle(m.fd_ftp))
 = (m.fd < 0) or fclose(m.fd)

 return m.Success





  *--------------------------------------------------------------------------*
  *---> Ouvre un fichier sur le serveur en renvoie un pointeur

procedure OuvrirFichier(p_remote, JeVoudraisEcrire   )
    local flags
    flags = iif(m.JeVoudraisEcrire, GENERIC_WRITE,  GENERIC_READ)
    return FtpOpenFile(this.mConnect, p_remote, m.flags, FTP_TRANSFER_TYPE_BINARY, 0)
  endproc && OuvrirFichier




  *--------------------------------------------------------------------------*
  *---> Retourne la taille en octet d'un fichier sur le serveur
  procedure TailleFichier(p_remote   )
  local v_hinternet
    v_hinternet = this.OuvrirFichier(p_remote)
    return FtpGetFileSize(v_hinternet, .F.
  endproc && TailleFichier

  *--------------------------------------------------------------------------*
  *---> Créer un répertoire sur le serveur
  procedure CreerRepertoire(p_dir   )
    return FtpCreateDirectory(this.mConnect, p_dir) > 0
  endproc && CreerRepertoire

  *--------------------------------------------------------------------------*
  *---> Supprime un fichier sur le serveur
  procedure SupprimerFichier(p_remote   )
    return FtpDeleteFile(this.mConnect, p_remote) > 0
  endproc && SupprimerFichier

  *--------------------------------------------------------------------------*
  *---> Supprime un répertoire sur le serveur
  procedure SupprimerRepertoire(p_dir   )
    return FtpRemoveDirectory(this.mConnect, p_dir) > 0
  endproc && SupprimerRepertoire

  *--------------------------------------------------------------------------*
  *---> Renomme un fichier sur le serveur
  procedure RenommerFichier(p_old    ,;
                            p_new   )
    return FtpRenameFile(this.mConnect, p_old, p_new) > 0
  endproc && RenommerFichier

  *--------------------------------------------------------------------------*
  *---> Renvoie .T. si le fichier existe sur le serveur
  procedure EstFichier(p_remote   )
    return this.OuvrirFichier(p_remote) > 0
  endproc && EstFichier

  *--------------------------------------------------------------------------*
  *---> Extrait la liste des objets dans le masque
  * ex de masque : /*.*
  *
  *---> Colonnes
  * 1 : nom du fichier   string
  * 2 : taille           integer
  * 3 : dernière modif.  datetime
  * 4 : attributs        integer
  *
  *---> Attributs :
  * 0   Normal      Fichier normal. Aucun attribut n'est défini.
  * 1   ReadOnly    Fichier en lecture seule. L'attribut est lecture/écriture.
  * 2   Hidden      Fichier caché. L'attribut est lecture/écriture.
  * 4   System      Fichier système. L'attribut est lecture/écriture.
  * 8   Volume      Étiquette de volume de lecteur de disque. L'attribut est lecture seule.
  * 16  Directory   Dossier ou répertoire. L'attribut est lecture seule.
  * 32  Archive     Le fichier a été modifié depuis la dernière sauvegarde. L'attribut est lecture/écriture.
  * 64  Alias       Lien ou raccourci. L'attribut est lecture seule.
  * 128 Compressed  Fichier compressé. L'attribut est lecture seule.
  procedure Fichiers2Array(p_masque ,@p_t)
  local v_fichier, v_i, v_find
    with this
      v_i = 0
      v_trame = replicate(chr(0), 320)
      v_find = FtpFindFirstFile (.mConnect, p_masque, @v_trame, INTERNET_FLAG_NEED_FILE, 0)
      if v_find > 0
        do while .T.
          v_i = v_i + 1
          dimension p_t(v_i, 4)
          p_t[v_i, 1] = ltrim(substr(v_trame, 45, 250))
          if at(chr(0), p_t[v_i, 1]) <> 0
            p_t[v_i, 1] = substr(p_t[v_i, 1], 1, at(chr(0), p_t[v_i, 1])-1)
          endif
          p_t[v_i, 2] = .buf2num(v_trame, 32, 4)
          p_t[v_i, 3] = .ftime2dtime(substr(v_trame, 21, 8))
          p_t[v_i, 4] = .buf2num(v_trame, 0, 4)
          v_trame = replicate(chr(0), 320)
          if InternetFindNextFile (v_find, @v_trame) <> 1
            exit
          endif
        enddo
      endif
      return v_i
    endwith
  empty(m.v_find) or !empty(InternetCloseHandle(m.v_find))
  endproc && PremierFichier

  *--------------------------------------------------------------------------*
  hidden procedure buf2num(lcBuffer, lnOffset, lnBytes)
  local ii
    lnResult = 0
    FOR ii=1 TO lnBytes
        lnResult = lnResult +;
            BitLShift(Asc(SUBSTR (lcBuffer, lnOffset+ii, 1)), (ii-1)*8)
    ENDFOR
    RETURN  lnResult
  endproc && bug2num

  *--------------------------------------------------------------------------*
  hidden procedure ftime2dtime(lcFileTime)
  local lcSystemTime, ltResult, lcDate, lcTime, wYear, wMonth, wDay, wHour, wMinute, wSecond, lcStoredSet
    lcSystemTime = REPLI (Chr(0), 16)
    = FileTimeToSystemTime (@lcFileTime, @lcSystemTime)
    wYear   = .buf2num(lcSystemTime,  0, 2)
    wMonth  = .buf2num(lcSystemTime,  2, 2)
    wDay    = .buf2num(lcSystemTime,  6, 2)
    wHour   = .buf2num(lcSystemTime,  8, 2)
    wMinute = .buf2num(lcSystemTime, 10, 2)
    wSecond = .buf2num(lcSystemTime, 12, 2)
    lcStoredSet = SET ("DATE")
    SET DATE TO MDY
    lcDate = STRTRAN (STR(wMonth,2) + "/" +;
        STR(wDay,2) + "/" + STR(wYear,4), " ","0")
    lcTime = STRTRAN (STR(wHour,2) + ":" +;
        STR(wMinute,2) + ":" + STR(wSecond,2), " ","0")
    ltResult = ctot(lcDate + " " + lcTime)
    set date to &lcStoredSet
    RETURN  ltResult
  endproc && ftime2dtime

enddefine && FPT