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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
| Option Compare Database
Option Explicit
'-------------------
'Déclaration des API
'-------------------
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFile As Long, ByVal localFile As String, ByVal newRemoteFile As String, ByVal dwFlags As Long, ByVal lContext As Long) As Boolean
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const scUserAgent = "VB OpenUrl"
Private Const INTERNET_FLAG_RELOAD = &H8000000 '(&H8000000 mode passif, 0 mode actif)
Private Const INTERNET_bin_asc = &H2 '(&H1 ascii, &H2 binaire)
Public Sub Download(sURL As String, SaveAs As String)
'Exemple :
' Call Download("http://www.url.com/fichier.zip", "C:\Fichier.zip")
Dim hOpen As Long
Dim hOpenUrl As Long
Dim bDoLoop As Boolean
Dim bRet As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long
Dim sBuffer As String
Dim sMsg As String
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hOpenUrl = InternetOpenUrl(hOpen, sURL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
Open SaveAs For Binary Access Write As #1
Put #1, , sBuffer
Close #1
If bRet Then
sMsg = sURL & " a été transféré "
Else
sMsg = sURL & " n'a pas pu être transféré"
End If
If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
'annoncer le résultat de l'opération
If sMsg <> "" Then
MsgBox sMsg
Else
MsgBox "aucun fichier transféré"
End If
End Sub
Public Sub Upload(sURL As String, sLogin As String, sPwd As String, localFile As String, remoteDir As String, remoteSaveAs As String)
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
Dim hOpen As Long
Dim hOpenFtp As Long
Dim bRet As Boolean
Dim sMsg As String
'''PARAMETRES************************
''sURL = "ftpperso.free.fr"
''localFile = "c:\test.log"
''sLogin = "zaza"
''sPwd = "miaou"
''remoteDir = "/"
''INTERNET_bin_asc = &H2 '(&H1 ascii, &H2 binaire)
''Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
'''**********************************
'lancer le transfert
hOpen = InternetOpen("PutFtpFile", 1, "", "", 0)
If hOpen = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
hOpenFtp = InternetConnect(hOpen, sURL, 21, sLogin, sPwd, 1, INTERNET_FLAG_RELOAD, 0)
If hOpenFtp = 0 Then
MsgBox "connection impossible"
Exit Sub
End If
If FtpSetCurrentDirectory(hOpenFtp, remoteDir) = 0 Then
MsgBox "impossible de trouver le répertoire distant " & remoteDir
Exit Sub
End If
'nom du fichier sans le chemin
' Do While InStr(localFile, "\") > 0
' localFile = Right(localFile, Len(localFile) - InStr(localFile, "\"))
' Loop
'transférer le fichier
bRet = FtpPutFile(hOpenFtp, localFile, remoteSaveAs, INTERNET_bin_asc, 0)
If bRet Then
sMsg = localFile & " a été transféré "
Else
sMsg = localFile & " n'a pas pu être transféré"
End If
'fermer les pointeurs, ménage
InternetCloseHandle hOpenFtp
InternetCloseHandle hOpen
'annoncer le résultat de l'opération
If sMsg <> "" Then
MsgBox sMsg
Else
MsgBox "aucun fichier transféré"
End If
End Sub |
Upload de fichiers sur FTP
Répondre avec citation
Envoyé par Copernic09
!
Partager