主题：这段代码能用吗

在网上找了段代码，通过api实现ftp，可以直接放到全局代码里然后调用吗？

 

 

Private Declare Function GetProcessHeap Lib "kernel32" () As Long 
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long 
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long 
Private Const HEAP_ZERO_MEMORY = &H8  
Private Const HEAP_GENERATE_EXCEPTIONS = &H4  
Private Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)  
Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)  
Private Const MAX_PATH = 260  
Private Const NO_ERROR = 0  
Private Const FILE_ATTRIBUTE_READONLY = &H1  
Private Const FILE_ATTRIBUTE_HIDDEN = &H2  
Private Const FILE_ATTRIBUTE_SYSTEM = &H4  
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10  
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20  
Private Const FILE_ATTRIBUTE_NORMAL = &H80  
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100  
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800  
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000  
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 Const ERROR_NO_MORE_FILES = 18  
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long 
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 FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory 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 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 Const INTERNET_OPEN_TYPE_PRECONFIG = 0  
Private Const INTERNET_OPEN_TYPE_DIRECT = 1  
Private Const INTERNET_OPEN_TYPE_PROXY = 3  
Private Const INTERNET_INVALID_PORT_NUMBER = 0  
Private Const FTP_TRANSFER_TYPE_ASCII = &H1  
Private Const FTP_TRANSFER_TYPE_BINARY = &H1  
Private Const INTERNET_FLAG_PASSIVE = &H8000000  
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 Const ERROR_INTERNET_EXTENDED_ERROR = 12003  
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean 
Private Const INTERNET_DEFAULT_FTP_PORT = 21  
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70  
Private Const INTERNET_DEFAULT_HTTP_PORT = 80  
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443  
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080  
Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2  
Private Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6  
Private Const INTERNET_OPTION_SEND_TIMEOUT = 5  
Private Const INTERNET_OPTION_USERNAME = 28  
Private Const INTERNET_OPTION_PASSWORD = 29  
Private Const INTERNET_OPTION_PROXY_USERNAME = 43  
Private Const INTERNET_OPTION_PROXY_PASSWORD = 44  
Private Const INTERNET_SERVICE_FTP = 1  
Private Const INTERNET_SERVICE_GOPHER = 2  
Private Const INTERNET_SERVICE_HTTP = 3  
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long 
Private Const INTERNET_FLAG_RELOAD = &H80000000  
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000  
Private Const INTERNET_FLAG_MULTIPART = &H200000  
Private Const GENERIC_READ = &H80000000  
Private Const GENERIC_WRITE = &H40000000  
 
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Integer 
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer 
 
Private Const HTTP_QUERY_CONTENT_TYPE = 1  
Private Const HTTP_QUERY_CONTENT_LENGTH = 5  
Private Const HTTP_QUERY_EXPIRES = 10  
Private Const HTTP_QUERY_LAST_MODIFIED = 11  
Private Const HTTP_QUERY_PRAGMA = 17  
Private Const HTTP_QUERY_VERSION = 18  
Private Const HTTP_QUERY_STATUS_CODE = 19  
Private Const HTTP_QUERY_STATUS_TEXT = 20  
Private Const HTTP_QUERY_RAW_HEADERS = 21  
Private Const HTTP_QUERY_RAW_HEADERS_CRLF = 22  
Private Const HTTP_QUERY_FORWARDED = 30  
Private Const HTTP_QUERY_SERVER = 37  
Private Const HTTP_QUERY_USER_AGENT = 39  
Private Const HTTP_QUERY_SET_COOKIE = 43  
Private Const HTTP_QUERY_REQUEST_METHOD = 45  
Private Const HTTP_STATUS_DENIED = 401  
Private Const HTTP_STATUS_PROXY_AUTH_REQ = 407  
Private Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000  
Private Const HTTP_QUERY_FLAG_NUMBER = &H20000000  
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 InternetWriteFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer 
Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" (ByVal hFtpSession As Long, ByVal sFileName As String, ByVal lAccess As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long 
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean 
Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer 
Private Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer 
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer 
Private Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer 
Private Const INTERNET_OPTION_VERSION = 40  
Private Type tWinInetDLLVersion  
    lMajorVersion As Long 
    lMinorVersion As Long 
End Type  
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer 
Private Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000  
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000  
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000  
'=====================================================================  
'软件版本  
'=====================================================================  
Private Const scUserAgent = "CMSDreamFTP ActiveX V1.0" 
 
Private hConnection     As Long 
Public LocalFile        As String 
Public RemoteFile       As String 
Public ServerName       As String 
Public UserName         As String 
Public Password         As String 
 
'=====================================================================  
'连接服务器  
'=====================================================================  
Public Function Connect(Optional m_ServerName As String, _  
                        Optional m_UserName As String, _  
                        Optional m_Password As String) As Boolean 
    Dim hOpen As Long 
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)  
    If Trim(m_ServerName) <> "" Then ServerName = m_ServerName  
    If Trim(m_UserName) <> "" Then UserName = m_UserName  
    If Trim(m_Password) <> "" Then Password = m_Password  
    hConnection = InternetConnect(hOpen, _  
                                  ServerName, _  
                                  INTERNET_INVALID_PORT_NUMBER, _  
                                  UserName, _  
                                  Password, _  
                                  INTERNET_SERVICE_FTP, _  
                                  INTERNET_FLAG_PASSIVE, _  
                                  0)  
    Connect = CBool(hConnection)  
    If Not Connect Then Err.Raise vbObjectError + 510, "Connect Function", "Connect to server failed:" & Err.Description  
End Function 
 
'=====================================================================  
'从服务器断开连接  
'=====================================================================  
Public Function DisConnect() As Boolean 
    DisConnect = True 
    If hConnection <> 0 Then 
        hConnection = 0  
        DisConnect = CBool(InternetCloseHandle(hConnection))  
    End If 
End Function 
 
'=====================================================================  
'文件传送  
'=====================================================================  
Public Function Transfer(Optional v_LocalFile As String, _  
                         Optional v_RemoteFile As String, _  
                         Optional m_ServerName As String, _  
                         Optional m_UserName As String, _  
                         Optional m_Password As String) As Boolean 
                           
    If Trim(v_LocalFile) <> "" Then LocalFile = v_LocalFile  
    If Trim(v_RemoteFile) <> "" Then RemoteFile = v_RemoteFile  
      
    If Err.Number <> 0 Then Err.Clear  
    On Error Resume Next 
    Dim v_RemotePath As String: v_RemotePath = GetRemoteFolder(RemoteFile)  
      
    If hConnection = 0 Then 
        If Trim(m_ServerName) <> "" Then ServerName = m_ServerName  
        If Trim(m_UserName) <> "" Then UserName = m_UserName  
        If Trim(m_Password) <> "" Then Password = m_Password  
        Call Connect(ServerName, UserName, Password)  
    End If 
    '=========================  
    '创建远程文件夹  
    '=========================  
    If v_RemotePath <> "" Then 
        If Right(v_RemotePath, 1) <> "/" Then v_RemotePath = v_RemotePath & "/" 
        Call CreateRemoteFolder(v_RemotePath)  
    End If 
      
    If Dir(LocalFile) = "" Then 
        Err.Raise vbObjectError + 512, "Transfer Function", "The local file is not exists:" & LocalFile  
        Err.Clear  
    End If 
      
    Transfer = FtpPutFile(hConnection, LocalFile, RemoteFile, FTP_TRANSFER_TYPE_BINARY, 0)  
    If Err Then 
        Err.Raise vbObjectError + 513, "Transfer Function", "Transfer the file failed:" & Err.Description  
        Err.Clear  
    End If 
End Function 
 
'=====================================================================  
'创建远程文件夹  
'=====================================================================  
Public Sub CreateRemoteFolder(ByVal RemotePath As String)  
    If Trim(RemotePath) = "" Then Exit Sub 
    On Error Resume Next 
    Dim v_RemotePath As String: v_RemotePath = RemotePath  
    Dim aFolder As String, sPosition As Long 
    Dim i As Long: i = 0  
    sPosition = InStr(v_RemotePath, "/")  
    aFolder = "" 
    Do While sPosition > 0 And i < 100  
        sPosition = InStr(v_RemotePath, "/")  
        aFolder = aFolder & Left(v_RemotePath, sPosition)  
        v_RemotePath = Mid(v_RemotePath, sPosition + 1)  
        If Not (aFolder = "/" Or aFolder = "") Then 
            If Not FtpCreateDirectory(hConnection, aFolder) Then 
                Err.Raise vbObjectError + 511, "CreateRemoteFolder Sub", "Create a remote folder failed:" & Err.Description  
                Err.Clear  
            End If 
        End If 
        i = i + 1  
    Loop 
End Sub 
 
Private Function GetRemoteFolder(ByVal RemoteFilePath As String) As String 
    GetRemoteFolder = RemoteFilePath  
    If Trim(RemoteFilePath) = "" Then Exit Function 
    RemoteFilePath = Replace(RemoteFilePath, "\", "/") 
    If Right(RemoteFilePath, 1) = "/" Then Exit Function 
    GetRemoteFolder = Left(RemoteFilePath, InStrRev(RemoteFilePath, "/"))  
End Function 
 
Private Sub Class_Initialize()  
    '  
End Sub 
 
Private Sub Class_Terminate()  
    DisConnect  
End Sub  

 

 

不支持any怎么办？

'///////////////////////////////////////////////////////////
'ftp
'判断当前是否有活动会话
Public activeftp As Boolean
'当前会话句柄变量                      
Public connecttingno As Long
' 活动连接句柄变量                                  
Public connectinglink As Long                            

Public successflag As Boolean

'设置函数环境api
Public 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
Public Const INTERNET_FLAG_PASSIVE = &H8000000          ' 被动
Public Const INTERNET_FLAG_PORT = &O0                   ' 主动
'连接服务端api
Public 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
Public Const INTERNET_INVALID_PORT_NUMBER = 0

Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3

'打开并连接服务端会话
Public Sub connectftpserver(ByVal fserver As String, ByVal fuser As String, ByVal fps As String)
connecttingno = InternetOpen("VB Wininet", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
'保存当前活动连接的句柄
connectinglink = InternetConnect(connecttingno, fserver, INTERNET_INVALID_PORT_NUMBER, fuser, fps, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0) '连接并取得句柄
activeftp = True '标记为活动
End Sub

'关闭连接api
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
'关闭并结束服务端会话
Public Sub shutftpserver
If connectinglink <> 0 Then
InternetCloseHandle(connectinglink)
connectinglink = 0
End If
connectinglink = 0
activeftp = False
End Sub

'上传api
Public 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
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
'上传文件
Public Sub upload(ByVal cfile As String, ByVal hfile As String)
successflag = FtpPutFile(connectinglink, cfile, hfile, FTP_TRANSFER_TYPE_ASCII, 0)
End Sub

'下载api
Public 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
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000
'下载文件
Public Sub Download(ByVal cfile As String, ByVal hfile As String)
successflag = FtpGetFile(connectinglink, hfile, cfile, False, INTERNET_FLAG_RELOAD, FTP_TRANSFER_TYPE_ASCII, 0)
End Sub

 

 

那这个呢，我们服务端对ftp不支持，又不能换，我把上面的代码写在全局代码里了，在调用的时候是不是哪有问题啊

FtpPutFile总是False,请帮我看下

 

我调用为

connectftpserver("200.200.200.190","anonymous","User's-mailname")
upload("d:\text.txt","\HardDisk\UserSetting\Script1a.csv" )
If activeftp = True Then
shutftpserver()
End If

e.Form.Controls("Label1").text = connecttingno
e.Form.Controls("Label2").text = connectinglink
e.Form.Controls("Label3").text = activeftp