Ftp avec thermometre

Commenter
Contenu du snippet

Bonjour à toutes et à tous

Merci à anatole je me suis basé sur sa classe

Bien voila c'est fait et cela fonctionne. Un grand merci à Grégory
Pour envoyer un fichier vers le web :
local_vers_web (fichiersurleweb,fichieraenvoyer)

pour recevoir un fichier du web
web_vers_local(fichierarecevoirenlocal,fichiersurleweb)

Bonne journée à toutes et à tous
Source / Exemple :

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
A voir également

Ftp avec thermometre
Chat ftp - Forum Java
Ftp //localhost ✓ - Forum PHP
Ftp alternative ✓ - Forum Visual Basic 6
Vscode ftp ✓ - Forum VB.NET
Syntaxe ftp ✓ - Forum VB.NET
S'inscrire maintenant
Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.
Ftp avec thermometre

Contenu du snippet

Source / Exemple :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (cs_aumeric)

Etat dynamique

Un autre calendrier

Calcul de cle iban

Creer une table contenant la lites complète des objets contenus dans un formulaire

Source / Exemple :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (cs_aumeric)

Etat dynamique

Un autre calendrier

Calcul de cle iban

Creer une table contenant la lites complète des objets contenus dans un formulaire

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
