VERSION 5.00
Begin VB.UserControl oDFC_Ftp 
   ClientHeight    =   600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3180
   ScaleHeight     =   600
   ScaleWidth      =   3180
   ToolboxBitmap   =   "oDFC_Ftp.ctx":0000
   Begin VB.Frame Frame1 
      Height          =   585
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3165
      Begin Store2000ServerVb.oDFC_Led UCLedCn 
         Height          =   405
         Left            =   60
         TabIndex        =   2
         Top             =   120
         Width           =   315
         _ExtentX        =   556
         _ExtentY        =   714
         Caption         =   "Cn"
      End
      Begin VB.TextBox txtLastCommand 
         BeginProperty Font 
            Name            =   "Small Fonts"
            Size            =   6
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   1290
         Locked          =   -1  'True
         TabIndex        =   1
         Top             =   180
         Width           =   1815
      End
      Begin Store2000ServerVb.oDFC_Led UCLedUp 
         Height          =   405
         Left            =   360
         TabIndex        =   3
         Top             =   120
         Width           =   315
         _ExtentX        =   556
         _ExtentY        =   714
         Caption         =   "Up"
      End
      Begin Store2000ServerVb.oDFC_Led UCLedDw 
         Height          =   405
         Left            =   660
         TabIndex        =   4
         Top             =   120
         Width           =   315
         _ExtentX        =   556
         _ExtentY        =   714
         Caption         =   "Dw"
      End
      Begin Store2000ServerVb.oDFC_Led UCLedEr 
         Height          =   405
         Left            =   960
         TabIndex        =   5
         Top             =   120
         Width           =   315
         _ExtentX        =   556
         _ExtentY        =   714
         Caption         =   "Er"
      End
   End
End
Attribute VB_Name = "oDFC_Ftp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Const BUFFERSIZE = 255

Private hOpen As Long
Private hConnection As Long
Private hFile As Long
Private dwType As Long
Private dwSeman As Long

Private szErrorMessage As String

Private mDirCol As New DFCcDirList

'Valori predefiniti proprietà:
Const m_def_UserName = ""
Const m_def_ServerName = ""
Const m_def_UserPassword = ""
Const m_def_Directory = 0
'Variabili proprietà:
Dim m_Altezza As Long
Dim m_UserName As String
Dim m_ServerName As String
Dim m_UserPassword As String
Dim m_LastErrorMessage As String
Dim m_Directory As DFCcDirList
'Eventi
Public Event FileTransferProgress(lCurrentBytes As Long, lTotalBytes As Long)

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Sub CloseConnection()
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Close connection"
    If hConnection <> 0 Then
        UCLedCn.Spegni
        UCLedEr.Spegni
        UCLedDw.Spegni
        UCLedUp.Spegni
        InternetCloseHandle hConnection
    End If
    hConnection = 0
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "CloseConnection", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function CreateFTPDirectory(sDirectory As String) As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Create FTP directory"
    If (FtpCreateDirectory(hConnection, sDirectory) = False) Then
        ErrorOut Err.LastDllError, "CreateFTPDirectory"
        CreateFTPDirectory = False
        Exit Function
    Else
        CreateFTPDirectory = True
    End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "CreateFTPDirectory", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function DeleteFTPFile(sRemote As String) As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Delete FTP directory "
    If (FtpDeleteFile(hConnection, sRemote) = False) Then
        ErrorOut Err.LastDllError, "DeleteFTPFile"
        DeleteFTPFile = False
        Exit Function
    Else
        DeleteFTPFile = True
    End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "DeleteFTPFile", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function FTPDownloadFile(sLocal As String, sRemote As String) As Boolean
'    On Error GoTo Err_Proc
    Dim Data(BUFFERSIZE - 1) As Byte ' array of 100 elements 0 to 99
    Dim Written As Long
    Dim Size As Long
    Dim Sum As Long
    Dim lBlock As Long
        txtLastCommand.Text = "FTP Download File"
        FTPDownloadFile = False
        ' accendo il led intermittente
        UCLedDw.Accendi
        UCLedDw.Interval = 1000
        
        Sum = 0
        lBlock = 0
        
        sLocal = Trim(sLocal)
        sRemote = Trim(sRemote)
        
        If sLocal <> "" And sRemote <> "" Then
            Size = GetFTPFileSize(sRemote)
            If Size > 0 Then
                hFile = FtpOpenFile(hConnection, sRemote, GENERIC_READ, dwType, 0)
                If hFile = 0 Then
                    ErrorOut Err.LastDllError, "FtpOpenFile:GetFile"
                    GoTo EXIT_ERR
                End If
                
                Open sLocal For Binary Access Write As #1
                Seek #1, 1
                Sum = 1
                For lBlock = 1 To Size \ BUFFERSIZE
                    If (InternetReadFile(hFile, Data(0), BUFFERSIZE, Written) = 0) Then
                        ErrorOut Err.LastDllError, "InternetReadFile"
                        Close #1
                        GoTo EXIT_ERR
                    End If
                    Put #1, , Data
                    DoEvents
                    Sum = Sum + BUFFERSIZE
                    RaiseEvent FileTransferProgress(Sum, Size)
                Next lBlock
                
                'Check for leftovers
                If Size Mod BUFFERSIZE <> 0 Then
                    ReDim Data2((Size Mod BUFFERSIZE) - 1) As Byte
                    If (InternetReadFile(hFile, Data2(0), Size Mod BUFFERSIZE, Written) = 0) Then
                        ErrorOut Err.LastDllError, "InternetReadFile2"
                        Close #1
                        GoTo EXIT_ERR
                    End If
                End If
                
                Put #1, , Data2
                
                Sum = Sum + (Size Mod BUFFERSIZE)
                Size = Sum
                RaiseEvent FileTransferProgress(Sum, Size)
                Close #1
                InternetCloseHandle (hFile)
                FTPDownloadFile = True
                ' spengo il led
                UCLedDw.Interval = 0
                UCLedDw.Spegni
            End If
        End If
   Exit Function

EXIT_ERR:
    ' spengo il led
    UCLedDw.Interval = 0
    UCLedDw.Spegni
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "FTPDownloadFile", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function FTPUploadFile(sLocal As String, sRemote As String) As Boolean
'    On Error GoTo Err_Proc
    Dim Data(BUFFERSIZE - 1) As Byte
    Dim Written As Long
    Dim Size As Long
    Dim Sum As Long
    Dim lBlock As Long
        txtLastCommand.Text = "FTP Upload File"
        ' accendo il led intermittente
        UCLedUp.Accendi
        UCLedUp.Interval = 1000
            
        Sum = 0
        lBlock = 0
        sLocal = Trim(sLocal)
        sRemote = Trim(sRemote)
        
        If sLocal <> "" And sRemote <> "" Then
            hFile = FtpOpenFile(hConnection, sRemote, GENERIC_WRITE, dwType, 0)
            If hFile = 0 Then
                ErrorOut Err.LastDllError, "FtpOpenFile:PutFile"
                FTPUploadFile = False
                GoTo EXIT_ERR
            End If
            
            Open sLocal For Binary Access Read As #1
            Size = LOF(1)
            For lBlock = 1 To Size \ BUFFERSIZE
                Get #1, , Data
                If (InternetWriteFile(hFile, Data(0), BUFFERSIZE, Written) = 0) Then
                    FTPUploadFile = False
                    ErrorOut Err.LastDllError, "InternetWriteFile"
                    GoTo EXIT_ERR
                End If
                DoEvents
                Sum = Sum + BUFFERSIZE
                
                RaiseEvent FileTransferProgress(Sum, Size)
            Next lBlock
            
            'check for leftovers
            If Size Mod BUFFERSIZE <> 0 Then
                Get #1, , Data
                If (InternetWriteFile(hFile, Data(0), Size Mod BUFFERSIZE, Written) = 0) Then
                    FTPUploadFile = False
                    ErrorOut Err.LastDllError, "InternetWriteFile2"
                    GoTo EXIT_ERR
                End If
            End If
            
            Sum = Sum + (Size Mod BUFFERSIZE)
            Size = Sum
            RaiseEvent FileTransferProgress(Sum, Size)
            Close #1
            InternetCloseHandle (hFile)
            FTPUploadFile = True
            ' spengo il led
            UCLedUp.Spegni
            UCLedUp.Interval = 0
        End If
   Exit Function
' Uscita per Errore
EXIT_ERR:
    UCLedEr.Accendi
    ' spengo il led
    UCLedUp.Spegni
    UCLedUp.Interval = 0
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "FTPUploadFile", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function GetDirectoryListing(sFilter As String) As Boolean
'    On Error GoTo Err_Proc
    Dim szDir As String
    Dim hFind As Long
    Dim nLastError As Long
    Dim dError As Long
    Dim ptr As Long
    Dim pData As WIN32_FIND_DATA
    Dim sFileName As String
    
    txtLastCommand.Text = "Get Directory Listing"
    Set mDirCol = Nothing
    hFind = FtpFindFirstFile(hConnection, sFilter, pData, 0, 0)
    nLastError = Err.LastDllError
    If hFind = 0 Then
        If (nLastError <> ERROR_NO_MORE_FILES) Then
            ErrorOut Err.LastDllError, "FtpFindFirstFile"
        End If
        GetDirectoryListing = False
        GoTo EXIT_FUNC:
    End If
    
    dError = NO_ERROR
    Dim bRet As Boolean

    sFileName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    mDirCol.Add pData.dwFileAttributes, Win32ToVbTime(pData.ftCreationTime), Win32ToVbTime(pData.ftLastAccessTime), Win32ToVbTime(pData.ftLastWriteTime), pData.nFileSizeLow, sFileName
    Do
        pData.cFileName = String(MAX_PATH, 0)
        bRet = InternetFindNextFile(hFind, pData)
        If Not bRet Then
            dError = Err.LastDllError
            If dError = ERROR_NO_MORE_FILES Then
                Exit Do
            Else
                ErrorOut Err.LastDllError, "InternetFindNextFile"
                InternetCloseHandle (hFind)
                GetDirectoryListing = False
                Exit Function
            End If
        Else
            sFileName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            mDirCol.Add pData.dwFileAttributes, Win32ToVbTime(pData.ftCreationTime), Win32ToVbTime(pData.ftLastAccessTime), Win32ToVbTime(pData.ftLastWriteTime), pData.nFileSizeLow, sFileName
        End If
    Loop
    
    
EXIT_FUNC:
    GetDirectoryListing = True
    Set m_Directory = mDirCol
    InternetCloseHandle (hFind)
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "GetDirectoryListing", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function GetFTPDirectory() As String
'    On Error GoTo Err_Proc
    Dim szDir As String
        txtLastCommand.Text = "Get FTP Directory"
        szDir = String(1024, Chr$(0))
        If (FtpGetCurrentDirectory(hConnection, szDir, 1024) = False) Then
            ErrorOut Err.LastDllError, "FtpGetCurrentDirectory"
            Exit Function
        Else
            GetFTPDirectory = Left(szDir, InStr(1, szDir, String(1, 0), vbBinaryCompare) - 1)
        End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "GetFTPDirectory", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function GetFTPFileSize(sFile As String) As Long
'    On Error GoTo Err_Proc
    Dim szDir As String
    Dim hFind As Long
    Dim nLastError As Long
    Dim pData As WIN32_FIND_DATA
        txtLastCommand.Text = "Get FTP File Size"
        hFind = FtpFindFirstFile(hConnection, sFile, pData, 0, 0)
        nLastError = Err.LastDllError
        If hFind = 0 Then
            If (nLastError = ERROR_NO_MORE_FILES) Then
                GetFTPFileSize = -1  ' File not found
            Else
                GetFTPFileSize = -2  ' Other error
                ErrorOut Err.LastDllError, "FtpFindFirstFile"
            End If
            Exit Function
        End If
               
        GetFTPFileSize = pData.nFileSizeLow
        InternetCloseHandle (hFind)
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "GetFTPFileSize", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function OpenConnection() As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Open connection"
    If hConnection <> 0 Then
        InternetCloseHandle hConnection
    End If
    hConnection = InternetConnect(hOpen, m_ServerName, INTERNET_INVALID_PORT_NUMBER, m_UserName, m_UserPassword, INTERNET_SERVICE_FTP, dwSeman, 0)
    If hConnection = 0 Then
        ErrorOut Err.LastDllError, "InternetConnect"
        OpenConnection = False
        Exit Function
    Else
        OpenConnection = True
        ' accendi
        UCLedCn.Accendi
    End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "OpenConnection", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function RemoveFTPDirectory(sDirectory As String) As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Remove FTP Directory"
    If (FtpRemoveDirectory(hConnection, sDirectory) = False) Then
        ErrorOut Err.LastDllError, "RemoveFTPDirectory"
        RemoveFTPDirectory = False
        Exit Function
    Else
        RemoveFTPDirectory = True
    End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "RemoveFTPDirectory", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function RenameFTPFile(sExisting As String, sNewName As String) As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Rename FTP File"
    If (FtpRenameFile(hConnection, sExisting, sNewName) = False) Then
        ErrorOut Err.LastDllError, "RenameFTPFile"
        RenameFTPFile = False
        Exit Function
    Else
        RenameFTPFile = True
    End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "RenameFTPFile", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function SimpleFTPGetFile(sLocal As String, sRemote As String) As Boolean
'    On Error GoTo Err_Proc
   ' MsgBox "Loc.:" + sLocal + " " + sRemote
    txtLastCommand.Text = "Simple FTP Get File"
    ' accendo il led
    UCLedDw.Accendi
    UCLedDw.Interval = 1000
   ' add INTERNET_FLAG_NO_CACHE_WRITE to avoid local caching 0x04000000 (hex)
    If (FtpGetFile(hConnection, sRemote, sLocal, False, FILE_ATTRIBUTE_NORMAL, dwType Or INTERNET_FLAG_RELOAD, 0) = False) Then
        ErrorOut Err.LastDllError, "SimpleFtpGetFile"
        SimpleFTPGetFile = False
        UCLedEr.Accendi
    Else
        SimpleFTPGetFile = True
    End If
    ' spegni il led
    UCLedDw.Spegni
    UCLedDw.Interval = 0
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "SimpleFTPGetFile", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function SimpleFTPPutFile(sLocal As String, sRemote As String) As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Simple FTP Put File"
    ' accendo il led intermittente
    UCLedUp.Accendi
    UCLedUp.Interval = 1000
    If (FtpPutFile(hConnection, sLocal, sRemote, dwType, 0) = False) Then
        ErrorOut Err.LastDllError, "SimpleFtpPutFile"
        SimpleFTPPutFile = False
        UCLedEr.Accendi
    Else
        SimpleFTPPutFile = True
    End If
    ' spengo il led
    UCLedUp.Spegni
    UCLedUp.Interval = 0
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "SimpleFTPPutFile", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function


'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Function SetFTPDirectory(sDir As String) As Boolean
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Set FTP Directory"
    If (FtpSetCurrentDirectory(hConnection, sDir) = False) Then
        ErrorOut Err.LastDllError, "FtpSetCurrentDirectory"
        SetFTPDirectory = False
        Exit Function
    Else
        SetFTPDirectory = True
    End If
Exit_Proc:
Exit Function


Err_Proc:
    Err_Handler "oDFC_Ftp", "SetFTPDirectory", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Function

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Sub SetTransferASCII()
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Set ASCII"
    dwType = FTP_TRANSFER_TYPE_ASCII
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "SetTransferASCII", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Sub SetTransferBinary()
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Set BINARY"
    dwType = FTP_TRANSFER_TYPE_BINARY
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "SetTransferBinary", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Sub SetModeActive()
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Set Active Mode"
    dwSeman = 0
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "SetModeActive", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=0
Public Sub SetModePassive()
'    On Error GoTo Err_Proc
    txtLastCommand.Text = "Set Passive Mode"
    dwSeman = INTERNET_FLAG_PASSIVE
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "SetModePassive", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=9,1,2,0
Public Property Get Directory() As DFCcDirList
Attribute Directory.VB_MemberFlags = "400"
    Set Directory = m_Directory
End Property

Private Sub Frame1_Click()
'    On Error GoTo Err_Proc
    If Frame1.Height = 1155 Then
        Frame1.Height = 735
    Else
        Frame1.Height = 1155
    End If
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "Frame1_Click", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

Private Sub txtLastCommand_Change()
'    On Error GoTo Err_Proc
    txtLastCommand.Refresh
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "txtLastCommand_Change", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

Private Sub UserControl_Initialize()
'    On Error GoTo Err_Proc
    hOpen = InternetOpen("DacFTP Client", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hOpen = 0 Then
        ErrorOut Err.LastDllError, "InternetOpen"
    End If
    dwType = FTP_TRANSFER_TYPE_ASCII
    dwSeman = 0
    hConnection = 0
    ' connessione
    UCLedCn.ColoreAcceso = cVERDE
    UCLedCn.ColoreSpento = cGRIGIO
    ' errore
    UCLedEr.ColoreAcceso = cROSSO
    UCLedEr.ColoreSpento = cGRIGIO
    ' download
    UCLedDw.ColoreAcceso = cGIALLO
    UCLedDw.ColoreSpento = cGRIGIO
    ' upload
    UCLedUp.ColoreAcceso = cBLU
    UCLedUp.ColoreSpento = cGRIGIO
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "UserControl_Initialize", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'Carica i valori delle proprietà dalla posizione di memorizzazione.
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'    On Error GoTo Err_Proc
    Set m_Directory = PropBag.ReadProperty("Directory", Nothing)
    m_LastErrorMessage = PropBag.ReadProperty("LastErrorMessage", "")
    m_UserName = PropBag.ReadProperty("UserName", m_def_UserName)
    m_ServerName = PropBag.ReadProperty("ServerName", m_def_ServerName)
    m_UserPassword = PropBag.ReadProperty("UserPassword", m_def_UserPassword)
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "UserControl_ReadProperties", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

Private Sub UserControl_Terminate()
'    On Error GoTo Err_Proc
    InternetCloseHandle hOpen
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "UserControl_Terminate", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'Scrive i valori delle proprietà nella posizione di memorizzazione.
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'    On Error GoTo Err_Proc
    Call PropBag.WriteProperty("Directory", m_Directory, Nothing)
    Call PropBag.WriteProperty("LastErrorMessage", m_LastErrorMessage, Nothing)
    Call PropBag.WriteProperty("UserName", m_UserName, m_def_UserName)
    Call PropBag.WriteProperty("ServerName", m_ServerName, m_def_ServerName)
    Call PropBag.WriteProperty("UserPassword", m_UserPassword, m_def_UserPassword)
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "UserControl_WriteProperties", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=9,1,2,0
Public Property Get LastErrorMessage() As String
Attribute LastErrorMessage.VB_MemberFlags = "400"
    LastErrorMessage = m_LastErrorMessage
End Property

Private Sub ErrorOut(ByVal dwError As Long, ByRef szFunc As String)
'    On Error GoTo Err_Proc
    Dim dwRet As Long
    Dim dwTemp As Long
    Dim szString As String * 2048
    dwRet = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, _
                      GetModuleHandle("wininet.dll"), dwError, 0, _
                      szString, 256, 0)
    szErrorMessage = szFunc & " error code: " & dwError & " Message: " & szString
    If (dwError = 12003) Then
        ' Extended error information was returned
        dwRet = InternetGetLastResponseInfo(dwTemp, szString, 2048)
        szErrorMessage = szString
    End If
    m_LastErrorMessage = szErrorMessage
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "ErrorOut", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=13,0,0,
Public Property Get UserName() As String
    UserName = m_UserName
End Property

Public Property Let UserName(ByVal New_UserName As String)
    m_UserName = New_UserName
    PropertyChanged "UserName"
End Property

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=13,0,0,
Public Property Get ServerName() As String
    ServerName = m_ServerName
End Property

Public Property Let ServerName(ByVal New_ServerName As String)
    m_ServerName = New_ServerName
    PropertyChanged "ServerName"
End Property

'AVVISO: NON RIMUOVERE O MODIFICARE LE SEGUENTI RIGHE DI COMMENTO
'MemberInfo=13,0,0,
Public Property Get UserPassword() As String
    UserPassword = m_UserPassword
End Property

Public Property Let UserPassword(ByVal New_UserPassword As String)
    m_UserPassword = New_UserPassword
    PropertyChanged "UserPassword"
End Property

'Inizializza le proprietà di UserControl.
Private Sub UserControl_InitProperties()
'    On Error GoTo Err_Proc
    m_UserName = m_def_UserName
    m_ServerName = m_def_ServerName
    m_UserPassword = m_def_UserPassword
Exit_Proc:
Exit Sub


Err_Proc:
    Err_Handler "oDFC_Ftp", "UserControl_InitProperties", Err.Number, Err.Description, Err_Handle_Mode
Resume Exit_Proc

End Sub

