Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
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,fichiersurleweb) 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 de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
CalendriCode
| | | L | M | M | J | V | S | D |
| | | | 1 | 2 | 3 | 4 |
| 5 | 6 | 7 | 8 | 9 | 10 | 11 |
| 12 | 13 | 14 | 15 | 16 | 17 | 18 |
| 19 | 20 | 21 | 22 | 23 | 24 | 25 |
| 26 | 27 | 28 | 29 | 30 | 31 | |
|
Téléchargements
Logiciels à télécharger sur le même thème :
|