Lire un fichier sur internet - 69vobd3

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 515 fois - Téléchargée 41 fois

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

Ajouter un commentaire

Commentaires

Signaler
cs_leparrain3
Messages postés
4
Date d'inscription
mercredi 25 décembre 2002
Statut
Membre
Dernière intervention
10 octobre 2010
 -
Impeccable !!! rien à dire ...
Signaler
AlexPoulard
Messages postés
39
Date d'inscription
vendredi 2 avril 2004
Statut
Membre
Dernière intervention
17 juillet 2006
 -
Absolument GENIAL ! Bravo ! 10/10
Signaler
cs_Hobby
Messages postés
116
Date d'inscription
mercredi 5 juin 2002
Statut
Membre
Dernière intervention
17 septembre 2008
 -
Impecable fonction nickel.

Mais, de plus en plus sur le web les url ne pointe pas sur un fichier mais un vers un script qui retourne un fichier, je vous rassure je resoit bien le fichier avec la routine, mais je connait pas forcément le type de fichier que je vais recevoir, il y a un moyen de le connaitre (ainsi que le nom).

Merci
Olivier
Signaler
DivXPVobD
Messages postés
18
Date d'inscription
lundi 1 juillet 2002
Statut
Membre
Dernière intervention
18 juin 2003
 -
met ceci :

Open "c:est.jpg" For Binary As #1
Put #1, , OuvrirURL("http://abcwallpaper.free.fr/car002.jpg",FichierBinaire)
Close #1
Signaler
cs_Jin
Messages postés
30
Date d'inscription
mercredi 4 décembre 2002
Statut
Membre
Dernière intervention
1 février 2003
 -
J'arrive pas à le faire marcher car je débute sur VB.
Il faut tous mettre dans le module, et juste çà dans le form-load :
Open "c: est.jpg" For Binary As #1
Put #1, , OuvrirURL("http://abcwallpaper.free.fr/car002.jpg")
Close #1

j'ai "compile error" "argument not optional" et OuvrirURL qui est surligné.
Comprends pas...
Afficher les 8 commentaires
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)