- Katılım
- 29 Eylül 2004
- Mesajlar
- 14
Merhaba makro ile ftp nasıl yapılır. Yardımlarınızı bekliyorum
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
'//
'// Dedicated to my Friend Colo
'// Some of the code from http://www.allapi.net
'// spec thanks to Joacim Andersson 29 July 2001
'// Amendments by Ivan F Moala 28 Sept 2002
'//
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_PASSIVE = &H8000000 '// used for FTP connections
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 '// use registry configuration
Private Const INTERNET_OPEN_TYPE_DIRECT = 1 '// direct to net
Private Const INTERNET_OPEN_TYPE_PROXY = 3 '// via named proxy
Private Const _
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 '// prevent using java/script/INS
Private Const MAX_PATH = 260
Private Const INTERNET_INVALID_PORT_NUMBER = 0 '// use the protocol-specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21 '// default for FTP servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70 '// " " gopher "
Private Const INTERNET_DEFAULT_HTTP_PORT = 80 '// " " HTTP "
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443 '// " " HTTPS "
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080 '// default for SOCKS firewall servers.
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
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 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 FtpSetCurrentDirectory Lib "wininet.dll" _
Alias "FtpSetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" _
Alias "FtpGetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszCurrentDirectory As String, _
lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" _
Alias "FtpCreateDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" _
Alias "FtpRemoveDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" _
Alias "FtpRenameFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszExisting As String, _
ByVal lpszNew As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" _
Alias "FtpGetFileA" ( _
ByVal hConnect As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" _
Alias "FtpPutFileA" ( _
ByVal hConnect As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" _
Alias "FtpFindFirstFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags As Long, _
ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" _
Alias "InternetFindNextFileA" ( _
ByVal hFind As Long, _
lpvFindData As WIN32_FIND_DATA) As Long
Private Const PassiveConnection As Boolean = True
Private Const FtpServer As String = "ftp.census.gov/pub/" '//Değiştir
Private Const ERROR_NO_MORE_FILES = 18&
'// Logon constants
Private Const strLogon As String = "anonymous" '//Değiştir
Private Const strPwd As String = "guest" '//Değiştir
'// Some ftp sites to test
'// You will need your OWN Ftp Site
'// To Test this on as you will be
'// Creating / deleting Dir
'//
Sub Ftp_Test()
Dim hConnection As Long, hOpen As Long, sOrgPath As String
'// open an internet connection
hOpen = InternetOpen("Colo Example", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)
'// connect to the FTP server
hConnection = InternetConnect(hOpen, _
FtpServer, _
INTERNET_DEFAULT_FTP_PORT, _
strLogon, _
strPwd, _
INTERNET_SERVICE_FTP, _
IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), _
0)
'// create a buffer to store the original directory
sOrgPath = String(MAX_PATH, 0)
'// get the directory
FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
'// create a new directory 'testing'
FtpCreateDirectory hConnection, "testing"
'// set the current directory to 'root/testing'
FtpSetCurrentDirectory hConnection, "testing"
'// upload the file 'README.htm'
FtpPutFile hConnection, "C:\README.htm", "README.htm", FTP_TRANSFER_TYPE_UNKNOWN, 0
'// rename 'README.htm' to 'Colo.htm'
FtpRenameFile hConnection, "README.htm", "Colo.htm"
'// enumerate the file list from the current directory ('root/testing')
EnumFiles hConnection
'// retrieve the file from the FTP server
FtpGetFile hConnection, "Colo.htm", _
"c:\Colo.htm", _
False, _
0, _
FTP_TRANSFER_TYPE_UNKNOWN, _
0
'// delete the file from the FTP server
FtpDeleteFile hConnection, "Colo.htm"
'// set the current directory back to the root
FtpSetCurrentDirectory hConnection, sOrgPath
'// remove the direcrtory 'testing'
FtpRemoveDirectory hConnection, "testing"
'// close the FTP connection
InternetCloseHandle hConnection
'// close the internet connection
InternetCloseHandle hOpen
End Sub
Public Sub EnumFiles(hConnection As Long)
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
'//
'//
'// create a buffer
pData.cFileName = String(MAX_PATH, 0)
'// find the first file
hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
'// if there's no file, then exit sub
If hFind = 0 Then Exit Sub
'// show the filename
MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
Do
'// create a buffer
pData.cFileName = String(MAX_PATH, 0)
'// find the next file
lRet = InternetFindNextFile(hFind, pData)
'// if there's no next file, exit do
If lRet = 0 Then Exit Do
'// show the filename
MsgBox Left(pData.cFileName, InStr(1, pData.cFileName, _
String(1, 0), vbBinaryCompare) - 1)
Loop
'// close the search handle
InternetCloseHandle hFind
End Sub
Sub ShowError()
Dim lErr As Long, sErr As String, lenBuf As Long
'// get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'// create a buffer
sErr = String(lenBuf, 0)
'// retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'// show the last response info
MsgBox "Error " & CStr(lErr) & ": " & sErr, vbOKOnly + vbCritical
End Sub