Attribute VB_Name = "FTPModule"
Option Explicit
Const FTP_ConfigPath = "D:\ATE\Config\webConfig.ini"
'add at 2012-05-15 by songchunming
Public hConnect As Long
Public myDownLoadFile As String
Public downloadFlag As Boolean

Private Const MAX_PATH = 260                            ' 是由MFC定义的不要更改

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 INTERNET_FLAG_PASSIVE = &H8000000          ' 被动模式
Private Const INTERNET_FLAG_PORT = &O0                   ' 主动模式

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

Private Const ERROR_NO_MORE_FILES = 18

Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H1

Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000


Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

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 * 260
    cAlternate As String * 16    ' 是由MFC定义的不要更改
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


' Ftp目录操作命令
' **********************************************************************************************************
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Long) As Boolean

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String) As Boolean

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

 
'Ftp文件操作命令
' **********************************************************************************************************
' 查找文件或目录
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 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
    
'用于保存Ftp目录结构
'Ftp打开
'输入服务器ip，ftp用户名，ftp密码
'获取
'该主目录下文件多少，和hConnect
Public Function FTPOpen(ByVal ftpServer As String, ByVal ftpUser As String, ByVal ftpPassWord As String, itemString() As String, iniPath As String, Optional ftpFold As String = "\") As Long

    On Error GoTo Ftp_Err
    'Dim bActiveSession As Boolean                       ' 用于标记当前是否有活动会话
    Dim hOpen As Long                                   ' 用于保存当前会话的句柄
    Dim hConnection As Long                             ' 用于保存活动连接的句柄
    Dim EnumItemNameBag As New Collection
    Dim iniPathArr() As String
    iniPathArr = Split(iniPath, "\")
    Dim i
    'Dim EnumItemAttributeBag As New Collection
    ' 开始 FTP 会话。
    hOpen = InternetOpen("VB Wininet", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        ErrorOut err.LastDllError, "InternetOpen"
        GoTo Exit_Sub
    End If
    
    ' 连接到 FTP 服务器。
    Dim strServer As String, strUser As String, strPassword As String
    Dim nFlag As Long
    strServer = ftpServer
    strUser = ftpUser
    strPassword = ftpPassWord
    nFlag = INTERNET_FLAG_PASSIVE
    
    hConnection = InternetConnect(hOpen, strServer, INTERNET_INVALID_PORT_NUMBER, _
        strUser, strPassword, INTERNET_SERVICE_FTP, nFlag, 0)
    If hConnection = 0 Then
        ErrorOut err.LastDllError, "InternetConnect"
        GoTo Exit_Sub
    End If
    'bActiveSession = True
     
    '目录操作
    '变量。
    Dim bRet As Boolean
    Dim strRemoteFolder As String
    strRemoteFolder = iniPath
    Dim pData As WIN32_FIND_DATA
    Dim hFind As Long, nLastError As Long
    '更改为服务器上新的 FTP 目录。
    bRet = FtpSetCurrentDirectory(hConnection, strRemoteFolder)
    If bRet = False Then
        ErrorOut err.LastDllError, "FtpPutFile"
       GoTo Exit_Sub
    End If
    
    '设置pData
    pData.cFileName = String(MAX_PATH, 0)
    
    '获取 FTP 当前目录内容
    Dim strItem As String
    hFind = FtpFindFirstFile(hConnection, "", pData, 0, 0)     ' 查找第一个文件或目录
    nLastError = err.LastDllError                                 ' 没有错误返回0
    If hFind = 0 Then
        If (nLastError = ERROR_NO_MORE_FILES) Then
            MsgBox "This directory is empty!"
        Else
              ErrorOut nLastError, "FtpFindFirstFile"
        End If
        GoTo Exit_Sub
    End If
    strItem = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0)))
    strItem = Trim(strItem)
    If Left(strItem, 1) <> "." Then
    EnumItemNameBag.Add strItem '添加第一个文件或目录
    End If
    
    ' 查找 FTP 目录中的下一个文件。
    If hFind <> 0 Then bRet = True
    Do While bRet
        bRet = InternetFindNextFile(hFind, pData)
        If bRet Then
            strItem = Trim(Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0))))
            If Left(strItem, 1) <> "." Then
            EnumItemNameBag.Add strItem
            End If
        End If
    Loop
    ReDim itemString(EnumItemNameBag.Count - 1)
    For i = 1 To EnumItemNameBag.Count
        itemString(i - 1) = EnumItemNameBag.item(i)
    Next i
    FTPOpen = hConnection
    
Exit_Sub:
    ' 结束 FTP 会话。
    Exit Function
Ftp_Err:
    MsgBox err.LastDllError, vbCritical, "Test Ftp Client by WinInet.dll"
    GoTo Exit_Sub
    
End Function

'错误处理
Function ErrorOut(dError As Long, szCallFunction As String)
    Dim strErrInf As String
    Select Case dError
        Case 12014
            strErrInf = "The User Name or PassWord is wrong!"
        Case 12007
            strErrInf = ""
        Case 12003
            strErrInf = "The Fold is wrong!"
        Case 12110
            strErrInf = "The file is exist!"
    End Select
    
    MsgBox "The error number:" & str(dError) & vbCrLf & vbCrLf & strErrInf & vbCrLf & vbCrLf & szCallFunction, vbCritical, "WinINet FTP Client"
    err.Clear
    
End Function
'关闭
Public Function FTPClose(hConnection As Long) As Boolean

    FTPClose = False
    If hConnection <> 0 Then
        InternetCloseHandle hConnection
        FTPClose = True
    End If
    
End Function
'获取文件
Public Function GetFTPFile(hConnection As Long, strFileRemote As String, youFold As String) As Boolean

    Dim strFileLocal As String
    Dim dwType As Integer
    Dim bRet As Boolean
    strFileLocal = youFold '+ strFileRemote
    bRet = FTPGetFile(hConnection, strFileRemote, strFileLocal, False, _
        INTERNET_FLAG_RELOAD, dwType, 0)
    If bRet = False Then
        GetFTPFile = False
    Else
        GetFTPFile = True
    End If
        
End Function
'copy confirm ini files to at 2012-06-15 by songchunming
Public Sub IniFileCopy()
    
    Dim FTPFile As New CIniFile
    Dim ServerIP As String
    Dim UserName As String
    Dim UserPassWord As String
    Dim iniPath As String
    Dim StatesPath As String
    Dim allFile() As String
    Dim CopyIni As String
    Dim i
    Dim bRet
    
    Call FTPFile.SpecifyIni("D:\ATE\Config\webConfig.ini")
    ServerIP = FTPFile.ReadString("FTP", "ServerIP", 20)
    UserName = FTPFile.ReadString("FTP", "UserName", 20)
    UserPassWord = FTPFile.ReadString("FTP", "UserPassWord", 20)
    iniPath = FTPFile.ReadString("Path", "Config", 60)
    CopyIni = FTPFile.ReadString("Path", "BackIni", 40)
    
    Dim fileString() As String
    hConnect = FTPOpen(ServerIP, UserName, UserPassWord, allFile, iniPath)
    For i = 0 To UBound(allFile)
        bRet = GetFTPFile(hConnect, iniPath + allFile(i), CopyIni + allFile(i))
    Next
    FTPClose hConnect
    
End Sub
'copy confirm ini files to at 2012-06-15 by songchunming
Public Sub StateFileCopy()
    
    Dim FTPFile As New CIniFile
    Dim ServerIP As String
    Dim UserName As String
    Dim UserPassWord As String
    Dim StatesPath As String
    Dim CopyStates As String
    Dim allFile() As String
    Dim i As Integer
    Dim bRet
    
    Call FTPFile.SpecifyIni(FTP_ConfigPath)
    ServerIP = FTPFile.ReadString("FTP", "ServerIP", 20)
    UserName = FTPFile.ReadString("FTP", "UserName", 20)
    UserPassWord = FTPFile.ReadString("FTP", "UserPassWord", 20)
    StatesPath = FTPFile.ReadString("Path", "States", 60)
    CopyStates = FTPFile.ReadString("Path", "BackStates", 40)
    
    Dim fileString() As String
    hConnect = FTPOpen(ServerIP, UserName, UserPassWord, allFile, StatesPath)
    'get all State file
    For i = 0 To UBound(allFile)
        bRet = GetFTPFile(hConnect, StatesPath + allFile(i), CopyStates + allFile(i))
        If bRet = False Then
            MsgBox "Can't Download ini file!", vbOKOnly + vbCritical, "Error!"
        Else
            '""""Frm_UpData.UpBarProgress ((i + 1) / (UBound(allFile) + 1))
        End If
    Next i
    FTPClose hConnect
    
End Sub