| LMF |
Mon programme doit lire dans une base de données access les différents parametres de connections a des comptes/serveurs FTP dans le but de télécharger tous les fichiers présents dans les comptes.
->MAis dans les différents comptes, quelques fichiers ont un nom identique mais de taille différentes.
Le probleme est que tous les fichiers de nom identiques sont remplacé sur le Disque dur (destination donnée par lecture de la base)par le premier du nom.
exemple : compte 1
fichier téléchargé :
azerty.log (1000KO)
aqw.aze(50KO)
compte 2
fichier téléchargé :
azerty.log (1000KO) (en réalité 1500KO, c'est donc meme que le premier)
vfr.aze(40KO)
...
De plus le second azerty.log met quelques secondes a etre téléchargé alors qu'il devrait mettre plus de temps (connection numéris), probleme de cache ????
voici le code :
' Déclaration des constantes
Private Const SESSION As String = "Ftp Session"
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const ERROR_NO_MORE_FILES = 18
'définition des variables globales
Private mlINetHandle As Long
Private mlConnection As Long
Dim pData As WIN32_FIND_DATA
Dim inetHandle As Long
Private Sub btquit_Click()
End
End Sub
Private Sub btstart_Click()
Dim dbimport As ADODB.Connection
Dim rstserveur As ADODB.Recordset
Dim nbenr As Integer
Dim ser, comp, pass, nom As String
'ouverture catalogue
Set dbimport = New ADODB.Connection
With dbimport
.Provider = "Microsoft.jet.OLEDB.4.0"
.Mode = adModeShareDenyNone
.Open "c:\fred\ftp\PR.mdb "
End With
' Déclaration et ouverture du Recordset sur la table
Set rstserveur = New ADODB.Recordset
With rstserveur
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open "Serveur", dbimport, , , adCmdTable
End With
nbenr = rstserveur.RecordCount
For i = 0 To 2
'nbenr -1 (pour éviter de tout télécharger)
' Initialisation
mlINetHandle = 0
mlConnection = 0
nom = rstserveur("nom" )
Text1.Text = nom
' MsgBox ""
' Récupération des paramètres de connexion
ser = rstserveur.Fields("serveur" )
comp = rstserveur.Fields("compte" )
pass = rstserveur.Fields("password" )
'depart procédé de connection
'Connexion internet
mlINetHandle = FTP.InternetOpen(SESSION, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
'ouverture connexion au site
mlConnection = FTP.InternetConnect(mlINetHandle, ser, INTERNET_INVALID_PORT_NUMBER, _
comp, pass, INTERNET_SERVICE_FTP, 0, 0)
If (mlConnection = 0) Then
MsgBox "erreur de connexion, vérifiez les paramètres ou attendez quelques instants", vbInformation, "Connexion"
End If
' Déplacement au répertoire désiré
cheminFTP = rstserveur.Fields("Rep_distant" )
retour = FTP.FtpSetCurrentDirectory(mlConnection, cheminFTP)
If (retour = False) Then MsgBox "erreur de changement de dossier", vbInformation, "FTP error"
Text2.Text = "connection en cours; veuillez patienter..."
'efface la liste
List1.Clear
'rempli la liste
inetHandle = FTP.FtpFindFirstFile(mlConnection, "*.*", pData, 0, 0)
If (inetHandle <> 0) Then
If List1.List(0) = "" Then
Do
currentFile = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
List1.AddItem currentFile
fctreturn = FTP.FTPFindNextFile(inetHandle, pData)
Loop While fctreturn
End If
End If
Dim m4, dirname As String
Dim z4, i4 As Integer
Dim retour4 As Boolean
z4 = List1.ListCount
dirname = Dir(rstserveur.Fields("Rep_Local" ) + rstserveur.Fields("nom" ) + "\", 16)
If dirname = "" Then
MkDir rstserveur.Fields("Rep_Local" ) + rstserveur.Fields("nom" ) + "\"
Else
Set fso = CreateObject("Scripting.FileSystemObject" )
fso.DeleteFile rstserveur.Fields("Rep_Local" ) + rstserveur.Fields("nom" ) + "\" + "*.*"
End If
'crée un répertoire selon le nom du serveur
'télécharge les fichiers du serveur dans le répertoire crée
m4 = ""
For i4 = 0 To (z4 - 1)
m4 = ""
m4 = List1.List(i4)
' MsgBox mlConnection
' MsgBox rstserveur.Fields("Rep_Local" ) & rstserveur.Fields("nom" ) & "\" & m4
retour4 = FTP.FtpGetFile(mlConnection, m4, rstserveur.Fields("Rep_Local" ) + rstserveur.Fields("nom" ) + "\" + m4, True, FILE_ATTRIBUTE_NORMAL, INTERNET_FLAG_RELOAD + INTERNET_FLAG_TRANSFER_BINARY, 0)
If retour = True Then
Text2.Text = m4 + " copié"
End If
Next i4
Text2.Text = "Fichiers téléchargés !"
Text1.Text = ""
rstserveur.MoveNext
' fermeture de la connexion au site FTP
FTP.InternetCloseHandle mlConnection
' fermeture de la connexion internet
FTP.InternetCloseHandle mlINetHandle
Next i
End Sub |
