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
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.