FONCTIONS DE CONNEXION À INTERNET

Public Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
 Public Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
 Public Const SOCKET_ERROR As Long = -1
 Public Const ERROR_SUCCESS = 0
 Public Const MAX_WSADescription = 256
 Public Const MAX_WSASYSStatus = 128
 Public Const MIN_SOCKETS_REQD As Long = 1
 Public Const WS_VERSION_REQD As Long = &H101
 Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
 Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
 Public Const RAS95_MaxEntryName = 256
 Public Const RAS95_MaxDeviceType = 16
 Public Const RAS95_MaxDeviceName = 32
 Public Const LVM_FIRST = &H1000
 Public Const LVM_SETCOLUMNWIDTH = LVM_FIRST + 30
 Public Const LVSCW_AUTOSIZE = -1
 
 Public Type RASCONN95
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
  End Type
  Public Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
  End Type
  Public Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
End Type
 Public Type Hostent
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
 Public Type IP_OPTION_INFORMATION
    TTL As Byte
    Tos As Byte
    Flags As Byte
    OptionsSize As Long
    OptionsData As String * 128
End Type
 Public Type IP_ECHO_REPLY
    Address(0 To 3) As Byte
    Status As Long
    RoundTripTime As Long
    DataSize As Integer
    Reserved As Integer
    Data As Long
    Options As IP_OPTION_INFORMATION
End Type
 Public Declare Function WSACleanup Lib "WSOCK32" () As Long
 Public Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
 Public Declare Function WSAGetLastError Lib "WSOCK32" () As Long
 Public Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
 Public Declare Function GetHostByName Lib "WSOCK32" Alias "gethostbyname" (ByVal szHost As String) As Long
 Public Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
 Public Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSAdata As WSAdata) As Long
 Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
 Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
 Public Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
 Public Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
 Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
 Public Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
 Public Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
'-------------------------------------------------------------
Function WebConnect() As Boolean
    If InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE, 0) Then 'affiche la feuille"Se connecter"
        WebConnect = True 'true si connecté
    Else
        WebConnect = False
    End If
End Function
Function WebDeconnect() As Boolean 'Se déconnecte automatiquement
  If InternetAutodialHangup(0) Then
    WebDeconnect = True
  Else
    WebDeconnect = False
  End If
End Function
Function WebAutoConnect() As Boolean 'affiche la feuille "Se connecter" et se connecte automatiquement
    If InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) Then
      WebAutoConnect = True
    Else
      WebAutoConnect = False
    End If
End Function
Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
                    MsgBox "ERROR", vbExclamation, "ERROR"
                    Exit Function
                    End If
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
                         IsConnected = True
                         Else
                         IsConnected = False
                         End If
End Function