Ftp avec thermometre

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 699 fois - Téléchargée 24 fois

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

Ajouter un commentaire

Commentaire

Messages postés
2
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
16 décembre 2007

Ou est le form "ATTENTEMISEAJOUR" ? ... or qui est ?

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.