Lire un fichier sur internet - 69vobd3

Commenter

Contenu du snippet


Source / Exemple : 


Option Explicit

' --- Module qui lis le contenu d'un fichier et vous le renvoie...
' ---
' --- Fonction OuvrirURL(sURL As String, TypeDeFichier) As String
' --- Renvoie FALSE en cas d'erreur, ou le contenu du fichier...
' ---
' --- Adapatation d'un code de Mr Mariotte (Kiriasse.fr)
' --- Merci à CyBeRoN pour l'adaptation pour les fichiers binaires
' --- Publié par Mr 69VobD3 (David CHANIAL)

Public Enum TypeDeFichier
    FichierAscii = False
    FichierBinaire = True
End Enum

Public Declare Function InternetOpen Lib "wininet.dll" _
     Alias "InternetOpenA" _
     (ByVal lpszAgent As String, _
      ByVal dwAccessType As Long, _
      ByVal lpszProxyName As String, _
      ByVal lpszProxyBypass As String, _
      ByVal dwFlags As Long) _
      As Long
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet.dll" _
     Alias "InternetOpenUrlA" _
     (ByVal hInternetSession As Long, _
      ByVal lpszUrl As String, _
      ByVal lpszHeaders As String, _
      ByVal dwHeadersLength As Long, _
      ByVal dwFlags As Long, _
      ByVal dwContext As Long) _
      As Long
Public Declare Function InternetReadFile Lib "wininet.dll" _
     (ByVal hFile As Long, _
      ByVal lpBuffer As String, _
      ByVal dwNumberOfBytesToRead As Long, _
      lNumberOfBytesRead As Long) _
      As Long
Public Declare Function DeleteUrlCacheEntry Lib "wininet.dll" _
     Alias "DeleteUrlCacheEntryA" _
     (ByVal lpszUrlName As String) _
      As Integer

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_FLAG_RELOAD = &H80000000

Public hSession As Long
Public hUrlFile As Long
    
    

Public Function OuvrirURL(sURL As String, FileType As TypeDeFichier) As String
    Dim Buffer As String * 256
    Dim Info As String
    Dim NombreOctets As Long
    Dim ValRet As Long
    Dim R As Integer
    
    Screen.MousePointer = vbHourglass
    On Error GoTo Err_Lecture
    
    DeleteUrlCacheEntry sURL

    hSession = InternetOpen(App.Title, _
        INTERNET_OPEN_TYPE_PRECONFIG, _
        vbNullString, _
        vbNullString, _
        0)
    hUrlFile = InternetOpenUrl(hSession, _
        sURL, _
        vbNullString, _
        0, _
        INTERNET_FLAG_RELOAD, _
        0)
    Select Case FileType
    Case True
        Do
            ValRet = InternetReadFile(hUrlFile, _
                Buffer, _
                Len(Buffer), _
                NombreOctets)
            If NombreOctets > 0 Then Info = Info & Buffer
            DoEvents
        Loop Until NombreOctets = 0
        InternetCloseHandle (hUrlFile)
        InternetCloseHandle (hSession)
        If Len(Info) = 0 Then
            OuvrirURL = False
            Screen.MousePointer = vbNormal
            Exit Function
        End If
    Case False
              ValRet = InternetReadFile(hUrlFile, _
                Buffer, _
                Len(Buffer), _
                NombreOctets)
        InternetCloseHandle (hUrlFile)
        InternetCloseHandle (hSession)
        If NombreOctets = 0 Then
                OuvrirURL = False
                Screen.MousePointer = vbNormal
                Exit Function
        End If
        Info = Left$(Buffer, NombreOctets)
    End Select
    DeleteUrlCacheEntry sURL
    Screen.MousePointer = vbNormal
    OuvrirURL = Info
    Exit Function
    
Err_Lecture:
    OuvrirURL = False
    Screen.MousePointer = vbNormal
    Exit Function

End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (DivXPVobD)