http://www.lawebdelprogramador.com

##RESPUESTA A LA PREGUNTA 24383 - Visual Basic##
##Raúl Jiménez Jiménez - Raul_JJ@ono.com##

----------------------------------------------------------------------------------------

Option Explicit
Private Declare Function _
InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, _
                                    ByVal dwReserved As Long) As Long

Private Declare Function _
InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long

Private Declare Function _
InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, _
                                ByVal lpszConnectoid As String, _
                                ByVal dwFlags As Long, _
                                lpdwConnection As Long, _
                                ByVal dwReserved As Long) As Long

Private Declare Function _
InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, _
                                             ByVal dwReserved As Long) As Long
Private Declare Function _
InternetGoOnline Lib "wininet.dll" (ByVal lpszURL As String, _
                                     ByVal hwndParent As Long, _
                                     ByVal dwReserved As Long) As Long

Private Declare Function _
InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, _
                                  ByVal dwReserved As Long) As Long

Private Declare Function _
InternetSetDialState Lib "wininet.dll" (ByVal lpszConnectoid As String, _
                                        ByVal dwState As Long, _
                                        ByVal dwReserved As Long) As Long

Private Const INTERNET_DIAL_UNATTENDED = &H8000&  '0x8000

Private Const INTERENT_GOONLINE_REFRESH = &H1    '0x00000001
Private Const INTERENT_GOONLINE_MASK = &H1       '0x00000001

'// Flags for InternetAutodial
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4

'// Flags for InternetGetConnectedState
Private Const INTERNET_CONNECTION_MODEM = 1
Private Const INTERNET_CONNECTION_LAN = 2
Private Const INTERNET_CONNECTION_PROXY = 4
Private Const INTERNET_CONNECTION_MODEM_BUSY = 8

'// Flags for custom dial handler
Private Const INTERNET_CUSTOMDIAL_CONNECT = 0
Private Const INTERNET_CUSTOMDIAL_UNATTENDED = 1
Private Const INTERNET_CUSTOMDIAL_DISCONNECT = 2

'// Custom dial handler supported functionality flags
Private Const INTERNET_CUSTOMDIAL_SAFE_FOR_UNATTENDED = 1
Private Const INTERNET_CUSTOMDIAL_WILL_SUPPLY_STATE = 2
Private Const INTERNET_CUSTOMDIAL_CAN_HANGUP = 4

'// States for InternetSetDialState
Private Const INTERNET_DIALSTATE_DISCONNECTED = 1

Private Type RASENTRYNAME95
    dwSize As Long
    szEntryName(256) As Byte
End Type

Private Declare Function RasEnumEntriesA Lib "RasApi32.DLL" _
    (ByVal reserved As String, ByVal lpszPhonebook As String, _
    lprasentryname As Any, lpcb As Long, lpcEntries As Long) _
    As Long
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal HConRas As Long) As Long

Private Const RAS_MAXENTRYNAME As Integer = 256
Private Const RAS_MAXDEVICETYPE As Integer = 16
Private Const RAS_MAXDEVICENAME As Integer = 128
Private Const RAS_RASCONNSIZE As Integer = 412
Private Const ERROR_SUCCESS = 0&

Private Type RASCONN
    dwSize As Long
    HConRas As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

'---------------------------------------------------------------------------
'               PARA QUE FUNCIONE EL FTP
'---------------------------------------------------------------------------


Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4

Private Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" ( _
         hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( _
         hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)

Private Const MAX_PATH = 260
Private Const NO_ERROR = 0
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
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

Private Const ERROR_NO_MORE_FILES = 18

Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
    
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 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
Private Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean
Private 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

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
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

' User agent constant.
Private Const scUserAgent = "vb wininet"

' Use registry access settings.
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 FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H1
Private Const INTERNET_FLAG_PASSIVE = &H8000000

' Opens a HTTP session for a given site.
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 Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean

' Number of the TCP/IP port on the server to connect to.
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080

Private Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Private Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Private Const INTERNET_OPTION_SEND_TIMEOUT = 5

Private Const INTERNET_OPTION_USERNAME = 28
Private Const INTERNET_OPTION_PASSWORD = 29
Private Const INTERNET_OPTION_PROXY_USERNAME = 43
Private Const INTERNET_OPTION_PROXY_PASSWORD = 44

' Type of service to access.
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3

' Opens an HTTP request handle.
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

' Brings the data across the wire even if it locally cached.
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000

' Sends the specified request to the HTTP server.
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _
String, ByVal lOptionalLength As Long) As Integer

' Queries for information about an HTTP request.
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer

' The possible values for the lInfoLevel parameter include:
Private Const HTTP_QUERY_CONTENT_TYPE = 1
Private Const HTTP_QUERY_CONTENT_LENGTH = 5
Private Const HTTP_QUERY_EXPIRES = 10
Private Const HTTP_QUERY_LAST_MODIFIED = 11
Private Const HTTP_QUERY_PRAGMA = 17
Private Const HTTP_QUERY_VERSION = 18
Private Const HTTP_QUERY_STATUS_CODE = 19
Private Const HTTP_QUERY_STATUS_TEXT = 20
Private Const HTTP_QUERY_RAW_HEADERS = 21
Private Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Private Const HTTP_QUERY_FORWARDED = 30
Private Const HTTP_QUERY_SERVER = 37
Private Const HTTP_QUERY_USER_AGENT = 39
Private Const HTTP_QUERY_SET_COOKIE = 43
Private Const HTTP_QUERY_REQUEST_METHOD = 45
Private Const HTTP_STATUS_DENIED = 401
Private Const HTTP_STATUS_PROXY_AUTH_REQ = 407

' Add this flag to the about flags to get request header.
Private Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Private Const HTTP_QUERY_FLAG_NUMBER = &H20000000
' Reads data from a handle opened by the HttpOpenRequest function.
Private Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer

Private Declare Function InternetWriteFile Lib "wininet.dll" _
        (ByVal hFile As Long, ByVal sBuffer As String, _
        ByVal lNumberOfBytesToRead As Long, _
        lNumberOfBytesRead As Long) As Integer

Private Declare Function FtpOpenFile Lib "wininet.dll" Alias _
        "FtpOpenFileA" (ByVal hFtpSession As Long, _
        ByVal sFileName As String, ByVal lAccess As Long, _
        ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer
Private Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer

' Closes a single Internet handle or a subtree of Internet handles.
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

' Queries an Internet option on the specified handle
Private Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer

' Returns the version number of Wininet.dll.
Private Const INTERNET_OPTION_VERSION = 40

' Contains the version number of the DLL that contains the Windows Internet
' functions (Wininet.dll). This structure is used when passing the
' INTERNET_OPTION_VERSION flag to the InternetQueryOption function.
Private Type tWinInetDLLVersion
    lMajorVersion As Long
    lMinorVersion As Long
End Type

' Adds one or more HTTP request headers to the HTTP request handle.
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" _
(ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _
ByVal lModifiers As Long) As Integer

' Flags to modify the semantics of this function. Can be a combination of these values:

' Adds the header ONLYif it does not already exist; otherwise, an error is returned.
Private Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000

' Adds the header if it does not exist. Used with REPLACE.
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000

' Replaces or removes a header. If the header value is empty and the header is found,
' it is removed. If not empty, the header value is replaced
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
'------------------------------------------------------------------------------------
'               PARA PODER TRABAJAR CON SOCKETS
'------------------------------------------------------------------------------------

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type

Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADescription_Len) As Byte
    szSystemStatus(0 To WSASYS_Status_Len) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

'-------------------------------------------------------------------------------------------


Private m_conexion As String
Private m_IPLocal As String ' Dirección IP local
Private m_IPInternet As String ' Dirección IP de la conexión a Internet
Private m_HOpen As Long ' Handle de la sesión de Internet
Private m_Proxy As String ' Nombre del servidor proxy
Private m_Servidor As String
Private m_HConexion As Long ' Handle de la conexión con el servidor
Private m_UsuFTP As String ' Usuario FTP
Private m_ContraFTP As String ' Contraseña FTP
Private m_SesionActiva As Boolean ' indica si tenemos una sesión activa de FTP
Public ColFicheros As Collection

Public Sub LlenaEntradasRas(RASArray() As String)

Dim s As Long, ln As Long, Nomconex As String, i As Long
Dim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
    
Call RasEnumEntriesA(vbNullString, vbNullString, r(0), s, ln)
ln = ln - 1
ReDim RASArray(ln)
For i = 0 To ln
    Nomconex = StrConv(r(i).szEntryName(), vbUnicode)
    RASArray(i) = Left$(Nomconex, InStr(Nomconex, _
          vbNullChar) - 1)
Next i
End Sub

Public Property Get NumeroConexionesAbiertas() As Long
Dim lprasconn(0 To 1) As Long
Dim rc As Long
Dim lpcb As Long
Dim lpcConnections As Long

lprasconn(0) = 32
lpcb = 0
  
rc = RasEnumConnections(lprasconn(0), lpcb, lpcConnections)
NumeroConexionesAbiertas = lpcConnections

End Property
Public Property Get HandleConexion() As Long
Dim lprasconn(0 To 1) As Long
Dim rc As Long
Dim lpcb As Long
Dim lpcConnections As Long

lprasconn(0) = 32
lpcb = 0
  
rc = RasEnumConnections(lprasconn(0), lpcb, lpcConnections)

HandleConexion = lprasconn(0)
MsgBox HandleConexion
End Property
Public Function Desconectar() As Long
Dim i As Long
Dim RasCon(255) As RASCONN
Dim lpcb As Long
Dim lpcConnections As Long
Dim HConRas As Long
Dim Retorno
RasCon(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * RasCon(0).dwSize
lpcConnections = 0
Retorno = RasEnumConnections(RasCon(0), lpcb, lpcConnections)
If Retorno = ERROR_SUCCESS Then
    Retorno = RasHangUp(ByVal RasCon(0).HConRas)
End If
Desconectar = Retorno
End Function


Public Sub LlenaComboRas(ByRef Cb As ComboBox)
Dim i As Integer
Dim SArray() As String
LlenaEntradasRas SArray
Cb.Clear
For i = 0 To UBound(SArray)
    Cb.AddItem SArray(i)
Next
End Sub

Public Sub Conectar()
Dim NumeroConexion As Long
Dim Contador As Integer ' Cuenta las veces que intentamos conectar a Internet
' Conecta a Internet si no estamos ya conectados
Contador = 0
If NumeroConexionesAbiertas() = 0 Then
    NumeroConexion = InternetDial(MDIMengen.hwnd, m_conexion$, 2, NumeroConexion&, 0&)
    While NumeroConexionesAbiertas() = 0 And Contador < 10
        Contador = Contador + 1
        NumeroConexion = InternetDial(MDIMengen.hwnd, m_conexion$, 2, NumeroConexion&, 0&)
    Wend
End If
 
If NumeroConexionesAbiertas = 0 And Contador >= 10 Then
    Err.Raise 0, "Internet.Conectar", "Imposible Conectar con el servidor"
End If
End Sub
Public Property Get EstamosConectados() As Boolean
EstamosConectados = CBool(NumeroConexionesAbiertas)
End Property
Public Property Let Conexion(P_conexion As String)
m_conexion = P_conexion
End Property

Public Property Get IPLocal() As String
IPLocal = m_IPLocal

End Property
Public Property Get IPInternet() As String
IPInternet = m_IPInternet
End Property
Public Sub CalculaIPs()
InicializaSockets
CalculaIP
LiberaSockets
End Sub
Public Sub IniciaSesion()
If Len(m_Proxy) <> 0 Then
    m_HOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, m_Proxy, vbNullString, 0)
Else
    m_HOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
End If
If m_HOpen = 0 Then Int_Error Err.LastDllError, "IniciaSesion"
    
End Sub
Public Sub TerminaSesion()
    'If hConnection <> 0 Then InternetCloseHandle (hConnection)
    If m_HOpen <> 0 Then InternetCloseHandle (m_HOpen)
    'hConnection = 0
    m_HOpen = 0
    

End Sub
Public Property Let Proxy(P_Proxy As String)
' Establecemos un servidor proxy para las conexiones
m_Proxy = P_Proxy
End Property
Function Int_Error(dError As Long, szCallFunction As String)
    Dim dwIntError As Long, dwLength As Long
    Dim strBuffer As String
    If dError = ERROR_INTERNET_EXTENDED_ERROR Then
        InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
        strBuffer = String(dwLength + 1, 0)
        InternetGetLastResponseInfo dwIntError, strBuffer, dwLength
        
        'Err.Raise 0, "Internet." & szCallFunction, " Extd Err: " & dwIntError & " " & strBuffer
        
    End If
    If MsgBox(szCallFunction & " Err: " & dError & _
        vbCrLf & "¿Cerrar Sesión y Conexión?", vbYesNo) = vbYes Then
        If m_HConexion Then InternetCloseHandle m_HConexion
        If m_HOpen Then InternetCloseHandle m_HOpen
        m_HConexion = 0
        m_HOpen = 0
        
        m_SesionActiva = False
    End If
End Function

Public Property Let Servidor(P_Servidor As String)
m_Servidor = P_Servidor
End Property
Public Property Let UsuFTP(P_UsuFTP As String)
m_UsuFTP = P_UsuFTP
End Property
Public Property Let ContraFTP(P_ContraFTP As String)
m_ContraFTP = P_ContraFTP
End Property
Public Sub Conecta_Servidor()
Dim nFlag As Long
If m_HOpen <> 0 Then
    If m_Servidor = "" Then
        Err.Raise 0, "Internet.Conecta_Servidor", "No se encuentra nombre de servidor"
        Exit Sub
    End If
    'If chkPassive.Value Then
        'nFlag = INTERNET_FLAG_PASSIVE
    'Else
        nFlag = 0
    'End If
    m_HConexion = InternetConnect(m_HOpen, m_Servidor, INTERNET_INVALID_PORT_NUMBER, _
        m_UsuFTP, m_ContraFTP, INTERNET_SERVICE_FTP, nFlag, 0)
        If m_HConexion = 0 Then
            Int_Error Err.LastDllError, "Conecta_Servidor"
        Else
            m_SesionActiva = True
            
       End If
    End If
End Sub

Public Sub Envia_Fichero(P_DirRemoto As String, P_NomFicRemoto As String, _
        P_NomFicLocal As String)
' Copia un fichero desde nuestro ordenador al Servidor FTP
' P_DirRemoto=Carpeta del servidor
'P_NomFicRemoto= Nombre que tendrá el fichero en el servidor
' P_NomFicLocal= Nombre del fichero a copiar (Path incluido)
Dim OK As Boolean
Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
Dim szTempString As String
Dim nPos As Long, nTemp As Long
If m_SesionActiva Then
    RCD szDirRemote
        
    OK = FtpPutFile(m_HConexion, P_NomFicLocal, P_NomFicRemoto, _
    FTP_TRANSFER_TYPE_BINARY, 0)
    If OK = False Then
        Int_Error Err.LastDllError, "FtpPutFile"
        Exit Sub
    End If
        
End If
End Sub
Private Sub RCD(P_DirR As String)
' Nos coloca en el directorio correspondiente en el servidor FTP
Dim PathR As String ' Path desde Directorio Raiz Remoto
Dim OK As Boolean
If InStr(1, P_DirR, m_Servidor) Then
    PathR = Mid(P_DirR, Len(m_Servidor) + 1, Len(P_DirR) - Len(m_Servidor))
Else
    PathR = P_DirR
End If
If PathR = "" Then PathR = "/"
OK = FtpSetCurrentDirectory(m_HConexion, PathR)
If OK = False Then Int_Error Err.LastDllError, "RCD"

End Sub
Public Sub Recoge_Fichero(P_DirRemoto As String, P_NomFicRemoto As String, _
        P_NomFicLocal As String)
' Copia un fichero desde nuestro ordenador al Servidor FTP
' P_DirRemoto=Carpeta del servidor
'P_NomFicRemoto= Nombre que tendrá el fichero en el servidor
' P_NomFicLocal= Nombre del fichero a copiar (Path incluido)
Dim OK As Boolean
Dim StrTmp As String
Dim nPos As Long, nTemp As Long

If m_SesionActiva Then
    StrTmp = P_NomFicRemoto
    nPos = 0
    nTemp = 0
    RCD P_DirRemoto
    OK = FtpGetFile(m_HConexion, P_NomFicRemoto, P_NomFicLocal, False, _
        INTERNET_FLAG_RELOAD, FTP_TRANSFER_TYPE_BINARY, 0)
    
        
        If OK = False Then Int_Error Err.LastDllError, "FtpGetFile"
    Else
        MsgBox "No hay Sesión Abierta"
    End If
End Sub
Public Sub Borra_Fichero(P_NomFicRemoto As String)
' Borra un fichero

'P_NomFicRemoto= Nombre que tendrá el fichero en el servidor

Dim OK As Boolean
Dim StrTmp As String
Dim nPos As Long, nTemp As Long

If m_SesionActiva Then
    StrTmp = P_NomFicRemoto
    nPos = 0
    nTemp = 0
    OK = FtpDeleteFile(m_HConexion, P_NomFicRemoto)
        If OK = False Then Int_Error Err.LastDllError, "FtpGetFile"
    Else
        MsgBox "No hay Sesión Abierta"
    End If
End Sub
Public Sub DesconectarServidor()
' Desconecta del servidor

If m_HConexion <> 0 Then InternetCloseHandle m_HConexion
m_HConexion = 0
m_SesionActiva = False

End Sub
Public Sub FinSesion()
If m_HConexion <> 0 Then DesconectarServidor
If m_HOpen <> 0 Then InternetCloseHandle (m_HOpen)
m_HOpen = 0
m_SesionActiva = False

End Sub

Public Function DirFtp(P_Carpeta As String, Optional P_Filtro As String) As Integer
' Devuelve el nº de ficheros que hay en la carpeta especificada
' por P_Carpeta y con el Filtro P_filtro
' Almacena en una colección los nombres y datos de los ficheror
' Encontrados

Dim hFind           As Long
Dim nLastError      As Long
Dim dError          As Long
Dim ptr             As Long
Dim pData As WIN32_FIND_DATA
Dim NumFicheros As Integer

VaciaColeccion
If IsMissing(P_Filtro) Or P_Filtro = "" Then
    P_Filtro = "*.*"
End If
If Len(P_Carpeta) > 0 Then RCD (P_Carpeta)
    pData.cFileName = String(MAX_PATH, 0)
    hFind = FtpFindFirstFile(m_HConexion, P_Filtro, pData, 0, 0)
    nLastError = Err.LastDllError
    If hFind = 0 Then
        If (nLastError = ERROR_NO_MORE_FILES) Then
            ' El directorio está vacío
            NumFicheros = 0
            
        Else
            Int_Error nLastError, "DirFTP"
        End If
        Exit Function
    End If
    
    dError = NO_ERROR
    Dim bRet As Boolean
    Dim StrItem As String
    
    
    StrItem = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    F.Nombre = StrItem
    'F.Fecha = pData.ftCreationTime
    ColFicheros.Add StrItem
    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
                ' Ya no hay más ficheros, los hemos pasado todos
                Exit Do
            Else
                Int_Error dError, "InternetFindNextFile"
                InternetCloseHandle (hFind)
               Exit Function
            End If
        Else
            
            StrItem = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            F.Nombre = StrItem
            'F.Fecha = pData.ftCreationTime
            ColFicheros.Add StrItem
       End If
    Loop
    InternetCloseHandle (hFind)
    DirFtp = ColFicheros.Count
End Function

Private Sub Class_Initialize()
Set ColFicheros = New Collection
End Sub
Private Sub VaciaColeccion()
 Dim Conta As Integer
 
 For Conta = 1 To ColFicheros.Count
    ColFicheros.Remove (Conta)
 Next Conta
 
End Sub
Private Sub Class_Terminate()
Set ColFicheros = Nothing
End Sub
Public Property Get NumFicheros() As Integer
NumFicheros = ColFicheros.Count
End Property
Public Property Get ExisteFichero(P_NomFic As String)
Dim Conta As Integer
Dim F As EFichero
Dim NomFic As String
DirFtp "\", P_NomFic
For Conta = 0 To ColFicheros.Count - 1
    NomFic = ColFicheros(Conta)
    If NomFic = P_NomFic Then
        ExisteFichero = True
        Exit For
    End If
Next Conta
End Property

Private Sub InicializaSockets()
Dim WSAD As WSADATA
Dim iReturn As Integer
Dim sLowByte As String, sHighByte As String, sMsg As String
iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

If iReturn <> 0 Then
    MsgBox "Winsock.dll Error."
    End
End If
If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
    WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
    sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
    sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
    sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
    'sMsg = sMsg & " winsock.dll tarafindan desteklenmiyor. "
    MsgBox sMsg
    End
End If

End Sub

Function hibyte(ByVal wParam As Integer)
    hibyte = wParam \ &H100 And &HFF&
End Function

Function lobyte(ByVal wParam As Integer)
    lobyte = wParam And &HFF&
End Function

Private Sub CalculaIP()
' Tipo="L" ->Local
'Tipo="I"->Internet
Dim hostname As String * 256
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim i As Integer
Dim ip_address As String
Dim IP As String
Dim Externa As String
Dim Interna As String
Dim LaIP As String

If gethostname(hostname, 256) = SOCKET_ERROR Then
    MsgBox "Windows Socket Error " & Str(WSAGetLastError())
    Exit Sub
Else
    hostname = Trim$(hostname)
End If
hostent_addr = gethostbyname(hostname)

If hostent_addr = 0 Then
    MsgBox "Winsock.dll error."
    Exit Sub
End If
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
   
Do
   ReDim temp_ip_address(1 To host.hLength)
   RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
   
   For i = 1 To host.hLength
       ip_address = ip_address & temp_ip_address(i) & "."
   Next
   ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    
    Interna = LaIP       ' Send ONLYthe External IP to the CurrentIP Function
    Externa = ip_address   ' Send the External IP to the  function parameter External
    LaIP = ip_address     ' Send LAN IP to the function para Internal
        

    ip_address = ""
    host.hAddrList = host.hAddrList + LenB(host.hAddrList)
    RtlMoveMemory hostip_addr, host.hAddrList, 4
Loop While (hostip_addr <> 0)
    
    
'If Tipo = "I" Then
    m_IPInternet = Interna
'    CurrentIP = EXTERNAL
'Else
    m_IPLocal = Externa
 '   CurrentIP = Internal
'End If
End Sub

Sub LiberaSockets()
    Dim lReturn As Long
    lReturn = WSACleanup()

    If lReturn <> 0 Then
        MsgBox "Socket Error " & Trim$(Str$(lReturn))
        End
    End If
End Sub

Public Sub EnviaCorreo()

End Sub