VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFtp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
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 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 FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory 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 Long
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
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
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 FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Boolean
Private 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 Boolean
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) 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 FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Const MAX_PATH = 260
Const MAXDWORD = 2 ^ 32

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
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

Public Event Error(Number As Long, Description As String)

Dim hConnection As Long, hOpen As Long

Public Function DownloadFile(sourceFile As String, destFile As String, Optional OverWrite As Boolean = True)

If FtpGetFile(hConnection, sourceFile, destFile, OverWrite, 0, FTP_TRANSFER_TYPE_UNKNOWN, 0) = False Then
    DeleteFile = -1
    ShowError
End If

End Function

Public Function DeleteFile(FileName As String)

If FtpDeleteFile(hConnection, FileName) = False Then
    DeleteFile = -1
    ShowError
End If

End Function

Public Function RemoveDirectory(DirName As String)

If FtpRemoveDirectory(hConnection, DirName) = False Then
    RemoveDirectory = -1
    ShowError
End If

End Function

Public Function CreateDirectory(DirName As String)

If FtpCreateDirectory(hConnection, DirName) = False Then
    CreateDirectory = -1
    ShowError
End If

End Function

Public Function UploadFile(sourceFile As String, destFile As String)

If FtpPutFile(hConnection, sourceFile, destFile, FTP_TRANSFER_TYPE_UNKNOWN, 0) = False Then
    UploadFile = -1
    ShowError
End If

End Function

Public Function RenameFile(sourceFile As String, ToFileName As String)

If FtpRenameFile(hConnection, sourceFile, ToFileName) = False Then
    RenameFile = -1
    ShowError
End If

End Function

Public Function EnumFiles(lArray() As PropertyBag, Optional FileExtention As String = "*.*") As Long

Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
Dim lCnt As Long, lSystemTime As SYSTEMTIME

pData.cFileName = String(MAX_PATH, 0)
hFind = FtpFindFirstFile(hConnection, FileExtention, pData, 0, 0)

If hFind = 0 Then
    EnumFiles = -1
    ShowError
    Exit Function
End If

lCnt = -1
lRet = 1

Do While lRet <> 0

    lCnt = lCnt + 1
    ReDim Preserve lArray(lCnt)
    
    Set lArray(lCnt) = New PropertyBag
    
    lArray(lCnt).WriteProperty "Name", Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1), ""
    lArray(lCnt).WriteProperty "Attributes", pData.dwFileAttributes, 0
    
    FileTimeToSystemTime pData.ftCreationTime, lSystemTime
    lArray(lCnt).WriteProperty "CreationTime", ConvertToDate(lSystemTime)
    
    FileTimeToSystemTime pData.ftLastAccessTime, lSystemTime
    lArray(lCnt).WriteProperty "LastAccessTime", ConvertToDate(lSystemTime)
    
    FileTimeToSystemTime pData.ftLastWriteTime, lSystemTime
    lArray(lCnt).WriteProperty "LastWriteTime", ConvertToDate(lSystemTime)
    lArray(lCnt).WriteProperty "FileSize", (pData.nFileSizeHigh * MAXDWORD) + pData.nFileSizeLow

    pData.cFileName = String(MAX_PATH, 0)
    
    ' Finn neste fil
    lRet = InternetFindNextFile(hFind, pData)
Loop

InternetCloseHandle hFind
EnumFiles = lCnt

End Function

Private Function ConvertToDate(lSystemTime As SYSTEMTIME) As Date

ConvertToDate = DateSerial(lSystemTime.wYear, lSystemTime.wMonth, lSystemTime.wDay) + TimeSerial(lSystemTime.wHour, lSystemTime.wMinute, lSystemTime.wSecond)

End Function

Private Sub ShowError()

Dim lErr As Long, sErr As String, lenBuf As Long

InternetGetLastResponseInfo lErr, sErr, lenBuf

sErr = String(lenBuf, 0)
InternetGetLastResponseInfo lErr, sErr, lenBuf

RaiseEvent Error(lErr, sErr)

End Sub

Public Function Connect(ServerName As String, UserName As String, Password As String, Optional PassiveConnection As Boolean = True)

hConnection = InternetConnect(hOpen, ServerName, INTERNET_DEFAULT_FTP_PORT, UserName, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)

If hConnection = 0 Then
    Connect = -1
    ShowError
End If

End Function

Public Sub CloseConnection()

InternetCloseHandle hConnection

End Sub

Private Sub Class_Initialize()

hOpen = InternetOpen("Sample", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)

End Sub

Public Property Get CurrentDirectory() As String

Dim Buff$

Buff = String(MAX_PATH, 0)
If FtpGetCurrentDirectory(hConnection, Buff, Len(Buff)) = False Then ShowError

CurrentDirectory = Buff

End Property

Public Property Let CurrentDirectory(ByVal vNewValue As String)

If FtpSetCurrentDirectory(hConnection, vNewValue) = False Then ShowError

End Property

Private Sub Class_Terminate()

InternetCloseHandle hConnection
InternetCloseHandle hOpen

End Sub
