VB6.0FTP操作

' Constants - InternetOpen.lAccessType
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0&
Public Const INTERNET_OPEN_TYPE_DIRECT As Long = 1&
Public Const INTERNET_OPEN_TYPE_PROXY As Long = 3&
Public Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY As Long = 4&

' Constants - InternetOpen.dwFlags
Public Const INTERNET_FLAG_ASYNC As Long = &H10000000
Public Const INTERNET_FLAG_FROM_CACHE As Long = &H1000000
Public Const INTERNET_FLAG_OFFLINE As Long = INTERNET_FLAG_FROM_CACHE

' Constants - InternetConnect.nServerPort
Public Const INTERNET_INVALID_PORT_NUMBER As Long = 0&
Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21&
Public Const INTERNET_DEFAULT_GOPHER_PORT As Long = 70&
Public Const INTERNET_DEFAULT_HTTP_PORT As Long = 80&
Public Const INTERNET_DEFAULT_HTTPS_PORT As Long = 443&
Public Const INTERNET_DEFAULT_SOCKS_PORT As Long = 1080&

' Constants - InternetConnect.dwService
Public Const INTERNET_SERVICE_FTP As Long = 1&
Public Const INTERNET_SERVICE_GOPHER As Long = 2&
Public Const INTERNET_SERVICE_HTTP As Long = 3&

' Constants - InternetConnect.dwFlags
Public Const INTERNET_FLAG_PASSIVE As Long = &H8000000

' Constants - FtpGetFile.dwFlags (FTP TransferType)
' Constants - FtpPutFile.dwFlags (FTP TransferType)
Public Const FTP_TRANSFER_TYPE_UNKNOWN As Long = &H0&
Public Const FTP_TRANSFER_TYPE_ASCII As Long = &H1&
Public Const FTP_TRANSFER_TYPE_BINARY As Long = &H2&
Public Const INTERNET_FLAG_TRANSFER_ASCII As Long = FTP_TRANSFER_TYPE_ASCII
Public Const INTERNET_FLAG_TRANSFER_BINARY As Long = FTP_TRANSFER_TYPE_BINARY

' Constants - FtpGetFile.dwFlags (Cache Flags)
' Constants - FtpPutFile.dwFlags (Cache Flags)
Public Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800
Public Const INTERNET_FLAG_NEED_FILE As Long = &H10
Public Const INTERNET_FLAG_HYPERLINK As Long = &H400

' Constants - FtpGetFile.dwFlagsAndAttributes
Public Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Public Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000
Public Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Public Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Public Const FILE_ATTRIBUTE_READONLY As Long = &H1
Public Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Public Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Public Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800

'=================
' FILETIME 结构体
'=================
Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

'========================
' WIN32_FIND_DATA 结构体
'========================
Public Const MAX_PATH = 260
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

'=====================================
' 取得InternetHandle
'=====================================
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, _
ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long

'=====================
' 连接FTP
'=====================
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal HINTERNET 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 Long

'===================================
' 关闭InternetHandle
'===================================
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal HINTERNET As Long) As Integer

'===========================================
' 取得Server的CurrentDirectory
'===========================================
Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
(ByVal hConnect As Long, ByVal lpszCurrentDirectory As String, _
ByRef lpdwCurrentDirectory As Long) As Boolean

'===========================================
' 设定Server的CurrentDirectory
'===========================================
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hConnect As Long, ByVal lpszDirectory As String) As Long

'=================================
' 从Server取得文件
'=================================
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hConnect 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 Long

'===============================
' 向Server传送文件
'===============================
Public 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 Long

'===============================
' 删除Server上面的文件
'===============================
Public Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _
(ByVal hConnect As Long, ByVal lpszFileName As String) As Long

'=================================
' 变更Server上的文件名
'=================================
Public Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" _
(ByVal hConnect As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Long

'===================================
' 删除Server上的目录
'===================================
Public Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" _
(ByVal hConnect As Long, ByVal lpszDirectory As String) As Long

'======================================
' 检索指定的路径
'======================================
Public 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

'======================================
' 继续检索下一个路径
'======================================
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long


'===============================================
' 从FTP中取得指定的目录下的内容
'===============================================
Private Sub Sample()
  Dim hOpen As Long       'InternetServer的Handle
  Dim hConnection As Long 'InternetSession的Handle
  Dim result As Long
  hOpen = 0
  hConnection = 0

  Dim hFind As Long
  Dim w32FindData As WIN32_FIND_DATA
  Dim strFile As String

  Dim FileList() As String '文件名一栏
  Dim cnt As Long
  cnt = -1

  '取得InternetServer的Handle - hOpen
  hOpen = InternetOpen("FTPSample", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
  If (hOpen <> 0) Then 'Handle取得成功

    '取得InternetSession的Handle(连接FTPServer) - hConnection
    hConnection = InternetConnect(hOpen, "192.168.45.12", INTERNET_INVALID_PORT_NUMBER, _
        "UserName", "Password", INTERNET_SERVICE_FTP, 0, 0)
    If (hConnection <> 0) Then '连接成功

      '改变FTPServer的CurrentDirectory
      result = FtpSetCurrentDirectory(hConnection, "home/cadsvr/plan/plan14735")
      If (result <> 0) Then '变更成功

        '取得文件一览
        hFind = FtpFindFirstFile(hConnection, "*.*", w32FindData, INTERNET_FLAG_RELOAD, 0)
        If (hFind = 0) Then
          MsgBox "文件名取得失败" & Err.LastDllError
        Else
          Do
            strFile = Left(w32FindData.cFileName, InStr(w32FindData.cFileName, vbNullChar) - 1)
            strFile = Mid(strFile, InStrRev(strFile, " ") + 1) '删除文件名中无用的字符
            If ((w32FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = &H10) Then
              strFile = strFile & "/" '如果取得的是目录,在目录后面加上/
            End If
            cnt = cnt + 1
            ReDim Preserve FileList(cnt)
            FileList(cnt) = strFile '将取得的文件名或者目录名,追加到文件名一览中
          Loop Until InternetFindNextFile(hFind, w32FindData) = 0 '取得下一个文件名
        End If

      Else
        MsgBox "目录移动失败" & Err.LastDllError
      End If
    Else
      MsgBox "FTPServer连接失败" & Err.LastDllError
    End If
  Else
    MsgBox "FTPServer连接失败" & Err.LastDllError
  End If

  '关闭InternetSession
  If (hConnection <> 0) Then InternetCloseHandle hConnection

  '关闭InternetServer
  If (hOpen <> 0) Then InternetCloseHandle hOpen

End Sub

'---------------------------------------------------------------------------------
'---------------------------------------------------------------------------------
Function FTPFileDownload(strSvrIP As String, strFtpUser As String, strFtpPass As String, strDownPath As String, strNewFilePath As String, DelFlg As Boolean) As Boolean
'---------------------------------------------------------------------------------
'FTP文件删除
'参数:
' strSvrIP=FTPServer的IP
' strFtpUser=用户名
' strFtpPass=密码
' strDownPath=下载的文件的全名
' DelFlg=删除Flag True:删除 False:不删除
'---------------------------------------------------------------------------------
Dim lnghInet                            As Long
Dim lnghConnect                         As Long
Dim lnghFile                            As Long
Dim lngReturn                           As Long
Dim udtFindData                         As WIN32_FIND_DATA
Dim booReturn                           As Boolean
'---------------------------------------------------------------------------------
Dim ret
'---------------------------------------------------------------------------------

    FTPFileDownload = False
    
    '初始化
    lnghInet = InternetOpen(App.EXEName, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)

    '连接FTP
    lnghConnect = InternetConnect(lnghInet, strSvrIP, INTERNET_INVALID_PORT_NUMBER, strFtpUser, strFtpPass, INTERNET_SERVICE_FTP, 0, 0)
    
    '文件存在确认
    lnghFile = FtpFindFirstFile(lnghConnect, strDownPath, udtFindData, INTERNET_FLAG_RELOAD, 0)
    ret = Left(udtFindData.cFileName, InStr(udtFindData.cFileName, vbNullChar) - 1)
    If ret = "" Then Exit Function
    
    '文件取得
    ret = FtpGetFile(lnghConnect, strDownPath, strNewFilePath, False, FILE_ATTRIBUTE_NORMAL, INTERNET_FLAG_RELOAD, 0&)
    If ret = 0 Then Exit Function
    
    '文件删除
    If DelFlg = True Then
        booReturn = FtpDeletefile(lnghConnect, strDownPath)
        Sleep (500)
        If booReturn = False Then Exit Function
    End If
    
    lngReturn = InternetCloseHandle(lnghInet)
    lngReturn = InternetCloseHandle(lnghConnect)
    lngReturn = InternetCloseHandle(lnghFile)
    
    FTPFileDownload = True
    
End Function
'---------------------------------------------------------------------------------
Function FTPFileUpload(strSvrIP As String, strFtpUser As String, strFtpPass As String, strUpPath As String, strNewFilePath As String, DelFlg As Boolean) As Boolean
'---------------------------------------------------------------------------------
'FTP文件上传
'参数:
' strSvrIP=FTPServer的IP
' strFtpUser=用户名
' strFtpPass=密码
' strUpPath=上传文件在FTP上的保存路径
' DelFlg=删除Flag True:删除 False:不删除
'---------------------------------------------------------------------------------
Dim lnghInet                            As Long
Dim lnghConnect                         As Long
Dim lnghFile                            As Long
Dim lngReturn                           As Long
Dim udtFindData                         As WIN32_FIND_DATA
Dim booReturn                           As Boolean
'---------------------------------------------------------------------------------
Dim ret
'---------------------------------------------------------------------------------

    FTPFileUpload = False
    
    '初始化
    lnghInet = InternetOpen(App.EXEName, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)

    '连接FTP
    lnghConnect = InternetConnect(lnghInet, strSvrIP, INTERNET_INVALID_PORT_NUMBER, strFtpUser, strFtpPass, INTERNET_SERVICE_FTP, 0, 0)
    
'    '文件存在确认
'    lnghFile = FtpFindFirstFile(lnghConnect, strUpPath, udtFindData, INTERNET_FLAG_RELOAD, 0)
'    ret = Left(udtFindData.cFileName, InStr(udtFindData.cFileName, vbNullChar) - 1)
'    If ret = "" Then Exit Function
    
    '上传
    ret = FtpPutFile(lnghConnect, strUpPath, strNewFilePath, INTERNET_FLAG_RELOAD, 0&)
    If ret = 0 Then Exit Function
    
'    '删除
'    If DelFlg = True Then
'        booReturn = FtpDeletefile(lnghConnect, strUpPath)
'        Sleep (500)
'        If booReturn = False Then Exit Function
'    End If
    
    lngReturn = InternetCloseHandle(lnghInet)
    lngReturn = InternetCloseHandle(lnghConnect)
'    lngReturn = InternetCloseHandle(lnghFile)
    
    FTPFileUpload = True
    
End Function


  • 3
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
'模板: Option Explicit 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 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 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 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 Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _ (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean Public Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" _ (ByVal hFtpSession As Long, ByVal lpszExsiting As String, ByVal lpszNew As String) As Boolean Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Public 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 Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _ (ByVal hFind As Long, lpvFndData As WIN32_FIND_DATA) As Long Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public Type WIN32_FIND_DATA dwFilAttributes 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 * 260 cAlternate As String * 14 End Type Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type '窗体: Private Sub Command1_Click() 'FTP下载 lnginet = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, _ vbNullString, vbNullString, 0&) If lnginet Then lnginetconn = InternetConnect(lnginet, "219.131.192.243", 0, _ "posui", "djposui", 1, 0, 0) If lnginetconn Then blnRC = FtpGetFile(lnginetconn, "/load.txt", "c:\load.txt", 0, 0, 1, 0) If blnRC Then MsgBox "download ok!!!" End If InternetCloseHandle lnginetconn InternetCloseHandle lnginet MsgBox "close ok!!!" Else MsgBox "can't connect" End If Else MsgBox "ftp wrong" End If End Sub Private Sub Command2_Click() 'FTP上传 lnginet = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, _ vbNullString, vbNullString, 0&) If lnginet Then lnginetconn = InternetConnect(lnginet, "219.131.192.243", 0, _ "administrator", "vai8888", 1, 0, 0) If lnginetconn Then blnRC = FtpPutFile(lnginetconn, "c:\1.txt", "/1.txt", 0, 0) If blnRC Then MsgBox "download ok!!!" End If InternetCloseHandle lnginetconn InternetCloseHandle lnginet MsgBox "close ok!!!" Else MsgBox "can't connect" End If Else MsgBox "ftp wrong" End If End Sub 方法2: '部件INET Private Sub Command1_Click() Me.Inet1.Execute Me.Inet1.URL, "send c:\11.txt /1.txt" '保存 End Sub Private Sub Command2_Click() Me.Inet1.Execute Me.Inet1.URL, "get /2.txt c:\2.txt" '下载 End Sub
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值