用VB实现FTP上传、下载

Question

================================================================
'上传下载放在模快中
Option Explicit
Public Declare Function FtpGetFile Lib "WinInet" Alias "FtpGetFileA" _
(ByVal hFtpSessions As Long, ByVal lpszRemoteFile As String, ByVal _
  lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal _
  dwLocalFlagAndAttributes As Long, ByVal dwInternetFlags As Long, _
  ByVal dwContext As Long) As Long
  
Public Declare Function InternetOpen Lib "WinInet" Alias "InternetOpenA" _
(ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName _
As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As LongPublic Declare Function InternetConnect Lib "WinInet" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nServerPort _
As Integer, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal _
dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As LongPublic Declare Function InternetCloseHandle Lib "WinInet" _
Alias "InternetCloseHandleA" (ByVal hInet As Long) As LongPublic Declare Function InternetGetLastResponseInfo Lib "WinInet" _
Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Long, _
ByVal lpszBuffer As String, ByRef lpdwBufferLength As Long) As BooleanPublic Declare Function FtpPutFile Lib "WinInet" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile _
As String, ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanPublic Declare Function GetLastError Lib "kernel32" () As LongPublic Declare Function FtpGetCurrentDirectory Lib "WinInet" Alias _
"FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectoty _
 As String, ByRef lpdwCurrentDirectory As Long) As LongPublic Declare Function FtpSetCurrentDirectory Lib "WinInet" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory _
As String) As BooleanPublic Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions _
As Long, ByVal samDesired As Long, phkResult As Long) As LongPublic Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As Long, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2
Public ftpvr As Integer
Public firRun As Boolean
'==========================================================
下面是一上传的实列，上传的你自己看
   buff1 = Space$(64): buff2 = Space$(128)
'打开一个ftp联接
    hInter = InternetOpen("wydrwtedr", 4, vbNullString, vbNullString, 0)
'连到ftp服务器
    hInterSi = InternetConnect(hInter, Trim(TxtIP.Text), 21, Trim(TxtUser1.Text), Trim(TxtPwd1.Text), 1, 0, 0)
'设置路径
    FtpSetCurrentDirectory hInterSi, TxtPath.Text
    FtpGetCurrentDirectory hInterSi, buff1, Len(buff1)
'上传
    FtpPutFile hInterSi, App.Path & "\temp.txt", FileName, 1, 0
'下载的用ftpgetfile

Answer 1

在窗体上放一个Internet Transfer Control，两个按钮cmdUpload，cmdDownload，三个文本框txtServerName，txtPassword，txtUser.Text和一个StatusBar。上传的代码
Private Sub cmdUpload_Click()
    
    If txtUploadFile.Text = "" Then
        MsgBox "Please select a file.", vbInformation
    Else
        
        With Inet
            cmdUpload.Enabled = False
            .Cancel
            .URL = txtServerName.Text
            .Password = txtPassword.Text
            .UserName = txtUser.Text
            .RemotePort = 21
            .AccessType = icUseDefault
            .Protocol = icFTP
            
            'Upload
            Exe "put """ & txtUploadFile.Text & """ " & GetFileNameFromPathString(txtUploadFile.Text)
        End With
    End If
End Sub下载的代码
Private Sub cmdDownLoad_Click()
    If txtDownLoadFile.Text = "" Then
        MsgBox "Please input a file.", vbInformation
    Else
        
        With Inet
            cmdDownLoad.Enabled = False
            .Cancel
            .URL = txtServerName.Text
            .Password = txtPassword.Text
            .UserName = txtUser.Text
            .RemotePort = 21
            .AccessType = icUseDefault
            .Protocol = icFTP
            
            'Download file,save it in apppath            Exe "get " & txtDownLoadFile.Text & " " & IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") & txtDownLoadFile.Text
        End With
    End If
End SubInternet Transfer Control事件StateChanged中的代码
Private Sub Inet_StateChanged(ByVal State As Integer)
    Dim strStatus As String
    Dim strResult As String
    Dim strAll As String
    
    Dim aryDownload() As Byte
    
    Select Case State
    Case icNone
        strStatus = "无状态可报告。"
    'Case icHostResolvingHost
        'strStatus = "正在查询所指定的主机的 IP 地址。"
    Case icHostResolved
        strStatus = "已成功地找到所指定的主机的 IP 地址。"
    Case icConnecting
        strStatus = "正在与主机连接。"
    Case icConnected
        strStatus = "已与主机连接成功。"
    Case icRequesting
        strStatus = "正在向主机发送请求。"
    Case icRequestSent
        strStatus = "发送请求已成功。"
    Case icReceivingResponse
        strStatus = "正在接收主机的响应。"
    Case icResponseReceived
        strStatus = "已成功地接收到主机的响应。"
        'MsgBox Inet.GetChunk(1024)
    Case icDisconnecting
        strStatus = "正在解除与主机的连接。"
    Case icDisconnected
        strStatus = "已成功地与主机解除了连接。"
    Case icError
        strStatus = "与主机通讯时出现了错误。"
        MsgBox strStatus, vbInformation
        cmdDownLoad.Enabled = True
        cmdUpload.Enabled = True
    Case icResponseCompleted
        strStatus = "该请求已经完成，并且所有数据均已接收到。"
        
        Select Case OperateMode
        Case wzCommand
            '从缓冲区取得命令返回的内容
            strAll = ""
            strResult = Inet.GetChunk(1024, icString)
            
            Do While LenB(strResult) > 0
                strAll = strAll & strResult
                strResult = Inet.GetChunk(1024, icString)
            Loop
            
            '这里只是简单的显示了取得的内容，往往需要对它再处理
            Dim aryT() As String
            Dim lngI As Long
            
            MsgBox strAll
            
            aryT = Split(strAll, vbCrLf)
            lvwFolder.ListItems.Clear
            For lngI = LBound(aryT) To UBound(aryT)
                If aryT(lngI) <> "" Then
                    Select Case Right(aryT(lngI), 1)
                    Case "/"
                        lvwFolder.ListItems.Add , "_" & aryT(lngI), Left(aryT(lngI), Len(aryT(lngI)) - 1), "Folder"
                    Case Else
                        lvwFolder.ListItems.Add , "_" & aryT(lngI), aryT(lngI), "File"
                    End Select
                End If
            Next
            cmdBrowse.Enabled = True
        Case wzDownload
            MsgBox "File download finished.", vbInformation
            cmdDownLoad.Enabled = True
        Case wzUpload
            MsgBox "File upload finished.", vbInformation
            cmdUpload.Enabled = True
        Case Else
        End Select
    End Select
    
    StatusBar1.SimpleText = strStatus
End Sub

Answer 2

我有一个例子可以发给你，功能比较全
[email protected]

Answer 3

回复： ch21st(风尘鸟) ：好象有错误不能成功运行，而且没有时间定义不能进行自动上传和下载吗？谢谢

Answer 4

在指定的时间自动上传、下载得你自己用代码实现。
比如，程序一直运行，定时检查系统时间，到时候了调FTP的函数。

Answer 5

使用INTERNET TRANSFER控件，用法参见msdn那里写的很清楚

Answer 6

Windows的API不能用,要用Socket去写!!!!
Windows的API会在本地的磁盘上生成垃圾文件!!!!!!!!!

Answer 7

哥们，可否也给我一份，让我学学，万分感谢，愿主保佑你！
  [email protected]

Answer 8

我有个例子
可以给你
[email protected]