Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 900 fois - Téléchargée 43 fois
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
21 oct. 2012 à 02:48
28 août 2005 à 11:58
23 sept. 2003 à 00:09
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
12 déc. 2002 à 19:17
Open "c:est.jpg" For Binary As #1
Put #1, , OuvrirURL("http://abcwallpaper.free.fr/car002.jpg",FichierBinaire)
Close #1
12 déc. 2002 à 15:40
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...
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.