Accueil > > > FTP AVEC THERMOMETRE
FTP AVEC THERMOMETRE
Information sur la source
Description
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,fichiersur leweb) Bonne journée à toutes et à tous
Source
- 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
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
Historique
- 10 juin 2006 16:34:54 :
-
..
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
ENUMERABLECOLLECTIONENUMERABLECOLLECTION par Matthieu MEZIL
Prenons le scénario suivant. On utilise MVVM. On a les deux classes suivantes dans le model : public class Child { } public class Parent { private ObservableCollection < Child > _children; public ObservableCollection < Child > Children { get {...
Cliquez pour lire la suite de l'article par Matthieu MEZIL [HS] CHROME 6 + MOI = COUP DE GUEULE ![HS] CHROME 6 + MOI = COUP DE GUEULE ! par JeremyJeanson
Attention, le poste qui suit n'est pas la complainte d'une personne : Qui n'aime pas Chrome. D'un anti Google. D'un développeur qui a un poil énorme dans la main. Ceux qui me fréquentent savent que je change de navigateur favori tous les 2 ou 3 mois afin ...
Cliquez pour lire la suite de l'article par JeremyJeanson [WP7] UTILISER UN WRAPPANEL DANS UNE APPLICATION WINDOWS PHONE 7[WP7] UTILISER UN WRAPPANEL DANS UNE APPLICATION WINDOWS PHONE 7 par Audrey
Lors de la réalisation de ma 2ème application Windows Phone 7, j'ai souhaité utiliser un WrapPanel pour afficher plusieurs photos. Mais le contrôle WrapPanel ne fait pas parti de la liste des contrôles inclus dans le SDK de la version Beta des outils pour...
Cliquez pour lire la suite de l'article par Audrey [WP7] BESOIN D'AVOIR DES DONNéES EN CACHE[WP7] BESOIN D'AVOIR DES DONNéES EN CACHE par Nicolas
Les développeurs ASP.NET ont l'habitude de mettre des données en cache pour éviter de requêter a chaque fois la base de données. Et il est toujours utilie de penser que vos utilisateurs mobiles n'ont pas troujours une super connexion 3G/WIFI et un for...
Cliquez pour lire la suite de l'article par Nicolas [TFS] COMMENT FORCER LA SAISIE D'UN AREA OU ITERATION[TFS] COMMENT FORCER LA SAISIE D'UN AREA OU ITERATION par cyril
Lorsque l'on créé un Work Item dans TFS, il est possible de le classer dans un "area" et dans une "iteration". Dans la plupart des types de projet, un "area" correspond à une catégorie, une "iteration" à un numéro de version. Il est possible de cré...
Cliquez pour lire la suite de l'article par cyril
Logiciels
uTorrent (2.0.4)UTORRENT (2.0.4)C'est un client BitTorrent très puissant et très performant. Comme son nom l'indique, uTorrent (m... Cliquez pour télécharger uTorrent Bureau de Gestion - ERP Devis Facturation (2.02)BUREAU DE GESTION - ERP DEVIS FACTURATION (2.02)- Version gratuite du 10/06/2010
Le Bureau de Gestion est un logiciel dédié à la gestion de l'en... Cliquez pour télécharger Bureau de Gestion - ERP Devis Facturation 4Videosoft Transfert iPod Mac (3.2.08)4VIDEOSOFT TRANSFERT IPOD MAC (3.2.08)4Videosoft Transfert iPod-Mac caractérise principalement à transférer les fichiers iPod vers Mac.... Cliquez pour télécharger 4Videosoft Transfert iPod Mac 4Videosoft HD Convertisseur (3.3.08)4VIDEOSOFT HD CONVERTISSEUR (3.3.08)Etant le meilleur HD Vidéo Convertisseur, 4Videosoft HD Convertisseur, vous pouvez regarder la vi... Cliquez pour télécharger 4Videosoft HD Convertisseur 4Videosoft Transfert iPad Mac (3.2.08)4VIDEOSOFT TRANSFERT IPAD MAC (3.2.08)4Videosoft Transfert iPad-Mac est un logiciel managérial iPad professionnel qui a des fonctions i... Cliquez pour télécharger 4Videosoft Transfert iPad Mac
|