我使用ftpputfile函数去上传文件到internet ftp服务器,发现总是返回false
能设置当前目录,就是传不上文件,文件才几十KB,
我能在IE上访问这个ftp服务器,并能拷贝本地文件到服务器上,
而同样的程序我能上传文件到局域网的ftp服务器
有没有高手帮我分析一下原因Private Sub TransferToFTP()
Dim fso As New FileSystemObject
Dim strFolder As String
Dim strFile As String
Dim lngINet As Long
Dim lngINetConn As Long
Dim blnRC As Boolean
Dim strFTPAddr As String
Dim strFTPFolder As String
Dim strFTPUserName As String
Dim strFTPPassWord As String
Dim strLocalFolder As String
On Error GoTo ErrMsg
strFTPAddr = GetIniStr("FTP", "addr")
strFTPFolder = GetIniStr("FTP", "folder")
strFTPUserName = GetIniStr("FTP", "username")
strFTPUserName = Decrypt(strFTPUserName, G_CryptPwd)
strFTPPassWord = GetIniStr("FTP", "password")
strFTPPassWord = Decrypt(strFTPPassWord, G_CryptPwd)
strLocalFolder = GetIniStr("FTP", "local")
strFolder = App.Path & "\data\" & Format(Date, "yyyymmdd") & "\" & strLocalFolder
'strFolder = App.Path & "\data\20081209\zip\"
lngINet = InternetOpen("FTP Control", 1, vbNullString, vbNullString, 0)
If lngINet = 0 Then
MsgBox "Occur error when transfer file to FTP,Reason:Can not Open Internet Session!"
Exit Sub
End If
lngINetConn = InternetConnect(lngINet, strFTPAddr, 0, strFTPUserName, strFTPPassWord, 1, 0, 0)
If lngINetConn = 0 Then
MsgBox "Occur error when transfer file to FTP,Reason:Can not Connect FTP Server!"
Exit Sub
End If
blnRC = FtpSetCurrentDirectory(lngINetConn, strFTPFolder)
If blnRC = False Then
MsgBox "Occur error when transfer file to FTP,Reason:Can not Change directory of FTP Server!"
Exit Sub
End If
If fso.FolderExists(strFolder) Then
strFile = Dir(strFolder, vbDirectory)
While Len(strFile) > 0
If strFile <> "." And strFile <> ".." Then
blnRC = FtpPutFile(lngINetConn, strFolder & strFile, strFile, &H2, 0)
If blnRC = False Then
MsgBox "Occur error when transfer file to FTP,Reason:Not Transfer file(" & strFile & ") to FTP Server!"
Exit Sub
End If
End If
strFile = Dir
Wend
End If
InternetCloseHandle lngINetConn
InternetCloseHandle lngINet
Exit Sub
ErrMsg:
MsgBox "Occur error when transfer file to FTP, Reason:" & Err.Description
End Sub
能设置当前目录,就是传不上文件,文件才几十KB,
我能在IE上访问这个ftp服务器,并能拷贝本地文件到服务器上,
而同样的程序我能上传文件到局域网的ftp服务器
有没有高手帮我分析一下原因Private Sub TransferToFTP()
Dim fso As New FileSystemObject
Dim strFolder As String
Dim strFile As String
Dim lngINet As Long
Dim lngINetConn As Long
Dim blnRC As Boolean
Dim strFTPAddr As String
Dim strFTPFolder As String
Dim strFTPUserName As String
Dim strFTPPassWord As String
Dim strLocalFolder As String
On Error GoTo ErrMsg
strFTPAddr = GetIniStr("FTP", "addr")
strFTPFolder = GetIniStr("FTP", "folder")
strFTPUserName = GetIniStr("FTP", "username")
strFTPUserName = Decrypt(strFTPUserName, G_CryptPwd)
strFTPPassWord = GetIniStr("FTP", "password")
strFTPPassWord = Decrypt(strFTPPassWord, G_CryptPwd)
strLocalFolder = GetIniStr("FTP", "local")
strFolder = App.Path & "\data\" & Format(Date, "yyyymmdd") & "\" & strLocalFolder
'strFolder = App.Path & "\data\20081209\zip\"
lngINet = InternetOpen("FTP Control", 1, vbNullString, vbNullString, 0)
If lngINet = 0 Then
MsgBox "Occur error when transfer file to FTP,Reason:Can not Open Internet Session!"
Exit Sub
End If
lngINetConn = InternetConnect(lngINet, strFTPAddr, 0, strFTPUserName, strFTPPassWord, 1, 0, 0)
If lngINetConn = 0 Then
MsgBox "Occur error when transfer file to FTP,Reason:Can not Connect FTP Server!"
Exit Sub
End If
blnRC = FtpSetCurrentDirectory(lngINetConn, strFTPFolder)
If blnRC = False Then
MsgBox "Occur error when transfer file to FTP,Reason:Can not Change directory of FTP Server!"
Exit Sub
End If
If fso.FolderExists(strFolder) Then
strFile = Dir(strFolder, vbDirectory)
While Len(strFile) > 0
If strFile <> "." And strFile <> ".." Then
blnRC = FtpPutFile(lngINetConn, strFolder & strFile, strFile, &H2, 0)
If blnRC = False Then
MsgBox "Occur error when transfer file to FTP,Reason:Not Transfer file(" & strFile & ") to FTP Server!"
Exit Sub
End If
End If
strFile = Dir
Wend
End If
InternetCloseHandle lngINetConn
InternetCloseHandle lngINet
Exit Sub
ErrMsg:
MsgBox "Occur error when transfer file to FTP, Reason:" & Err.Description
End Sub
解决方案 »
- mshflexgrid 记录集传递
- 2+2=?
- 日期类型数据的问题!!!
- execl鑷姩璋冩暣鍒楀
- 如何取消打印 简单题
- 晕啊.快来帮帮我啊
- 谁能给我一个width,scalewidth和height,scaleheight的详细区别
- 我快急死了!帮帮忙
- 怎样识别95,98,Me,NT,2000,XP这几种操作系统??并实现休眠功能??
- 我把form的BorderStyle属性设置成0-None.请教大哥,当我打开FORM时,怎样才能使点击win98的工具栏上的窗口使FORM变成最小化,(就想普通的FORM一样).
- 阿泰请进 CrystalReport 6.0
- 各位大哥大姐帮我看下用VB对文件进行重命名,这里错在哪里了
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 FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
'* 模块名称:FTP.cls
'* 模块功能:使用wininet API进行FTP操作
'* 作者:lyserver
'* 联系方式:http://blog.csdn.net/lyserver
'* ******************************************************* *
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime(1) As Long
ftLastAccessTime(1) As Long
ftLastWriteTime(1) As Long
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
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 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 InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory 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 Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Long
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 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 Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_FLAG_ASYNC = &H10000000
Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_CONNECTION_MODEM = &H1
Private Const INTERNET_CONNECTION_LAN = &H2
Private Const INTERNET_CONNECTION_PROXY = &H4
Private Const FTP_TRANSFER_TYPE_ASCII = 1
Private Const FTP_TRANSFER_TYPE_BINARY = 2
Private Const ERROR_NO_MORE_FILES = 18&
Private Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20Public Event EnumFileProc(ByVal FileName As String, FileAttr As VbFileAttribute)Dim m_hInternet As Long, m_hConnect As LongPrivate Sub Class_Initialize()
m_hInternet = InternetOpen("FTP Appliction", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, INTERNET_FLAG_NO_CACHE_WRITE)
End SubPrivate Sub Class_Terminate()
If m_hConnect <> 0 Then InternetCloseHandle m_hConnect
InternetCloseHandle m_hInternet
End SubPublic Function Login(Server As String, Optional Port As Integer = 21, Optional UserName As String = "anonymous", Optional Password = "") As Boolean
If m_hInternet = 0 Then Exit Function
If m_hConnect <> 0 Then Logout
m_hConnect = InternetConnect(m_hInternet, Server, Port, UserName, Password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE Or INTERNET_FLAG_EXISTING_CONNECT, 0)
Login = (m_hConnect <> 0)
End FunctionPublic Function Logout() As Boolean
If m_hConnect <> 0 Then
InternetCloseHandle m_hConnect
m_hConnect = 0
Logout = True
End If
End FunctionPublic Function GetDirectory() As String
Dim strPath As String, nLen As Long
If m_hConnect = 0 Then Exit Function
nLen = 260
strPath = String(nLen, vbNullChar)
FtpGetCurrentDirectory m_hConnect, strPath, nLen
GetDirectory = Left(strPath, InStr(strPath, vbNullChar) - 1)
End FunctionPublic Function SetDirectory(ByVal FtpPath As String) As Boolean
If m_hConnect = 0 Then Exit Function
FtpSetCurrentDirectory m_hConnect, FtpPath
SetDirectory = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End FunctionPublic Function CreateDirectory(ByVal FtpPath As String) As Boolean
FtpCreateDirectory m_hConnect, FtpPath
CreateDirectory = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End FunctionPublic Function DeleteDirectory(ByVal FtpPath As String) As Boolean
FtpRemoveDirectory m_hConnect, FtpPath
DeleteDirectory = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End FunctionPublic Function EnumFile() As String()
Static s() As String
Dim strFile As String
Dim wfd As WIN32_FIND_DATA
Dim hFind As Long, i As Long
Erase s
hFind = FtpFindFirstFile(m_hConnect, ".", wfd, INTERNET_FLAG_RELOAD, 0)
Do While GetLastError() <> ERROR_NO_MORE_FILES
ReDim Preserve s(i)
s(i) = Left(wfd.cFileName, InStr(wfd.cFileName, Chr(0)) - 1)
If (wfd.dwFileAttributes Or FILE_ATTRIBUTE_DIRECTORY) = wfd.dwFileAttributes Then
RaiseEvent EnumFileProc(s(i), vbDirectory)
Else
RaiseEvent EnumFileProc(s(i), vbArchive)
End If
If InternetFindNextFile(hFind, wfd) = 0 Then Exit Do
i = i + 1
Loop
EnumFile = s
End FunctionPublic Function Rename(ByVal FtpOldName As String, ByVal FtpNewName As String) As Boolean
FtpRenameFile m_hConnect, FtpOldName, FtpNewName
Rename = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End FunctionPublic Function DeleteFile(ByVal FtpFile As String) As Boolean
FtpDeleteFile m_hConnect, FtpFile
DeleteFile = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End FunctionPublic Function UpFile(ByVal LocalFile As String, Optional ByVal FtpFile As String) As Boolean
If m_hConnect = 0 Then Exit Function
If Len(Dir(LocalFile)) = 0 Or Left(Dir(LocalFile), 1) = "." Then Exit Function
If Len(FtpFile) = 0 Then
If InStr(LocalFile, "\") = 0 Then
FtpFile = LocalFile
Else
FtpFile = StrReverse(LocalFile)
FtpFile = StrReverse(Left(FtpFile, InStr(FtpFile, "\") - 1))
End If
End If
FtpPutFile m_hConnect, LocalFile, FtpFile, 1, 0
UpFile = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End FunctionPublic Function DownFile(ByVal FtpFile As String, Optional ByVal LocalFile As String) As Boolean
If m_hConnect = 0 Then Exit Function
If Len(LocalFile) = 0 Then
If InStr(FtpFile, "\") = 0 Then
LocalFile = FtpFile
Else
LocalFile = StrReverse(FtpFile)
LocalFile = StrReverse(Left(LocalFile, InStr(LocalFile, "\") - 1))
End If
End If
FtpGetFile m_hConnect, FtpFile, LocalFile, False, FILE_ATTRIBUTE_ARCHIVE, FTP_TRANSFER_TYPE_BINARY, 0
DownFile = (GetLastError <> ERROR_INTERNET_EXTENDED_ERROR)
End Function
Occur error when transfer file to FTP,Reason:(0) Not Transfer file(20090612S01bom.txt) to FTP Server!