1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. [vb6] vérifier qu'un fichier existe par son url

[vb6] vérifier qu'un fichier existe par son url

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 711 fois - Téléchargée 19 fois

Commenter

Contenu du snippet

C'est une variante de l'API FileExists mais pour l'internet. Avec la fonction "urlFileExists" le contrôle on-line est possible !

Source / Exemple : 


Private Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000

Private Const INTERNET_DEFAULT_FTP_PORT = 21   'Port FTP par défaut.
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70    'Port Gopher par défaut.
Private Const INTERNET_DEFAULT_HTTP_PORT = 80  'Port HTTP par défaut.
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443 'Port HTTPS par défaut.
Private Const INTERNET_DEFAULT_SOCKS_PORT = 1080   'Port Socks (firewall) par défaut.

Private Const INTERNET_SERVICE_FTP = 1     'Service FTP.
Private Const INTERNET_SERVICE_GOPHER = 2  'Service Gopher.
Private Const INTERNET_SERVICE_HTTP = 3    'Service HTTP.

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
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
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 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
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As _
    Long, ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Integer
    
Global rtGetHTTP As String

Public Function isConnected(sURL As String) As Boolean
    isConnceted = False
        If InternetCheckConnection("http://www.google.com", &H1, 0&) = 0 Then Exit Function
    isConnceted = True
End Function
    
Private Function urlGetStatus(ByVal sURL As String) As String
'Retourne deux parametres conca par un ;
'0 = Status
'1 = Status text
'Si ya besoin d'autre chose, faut changer ce code
urlGetStatus = "-1;Erreur fonction"

Dim myHTTP As WinHttpRequest
        
    Set myHTTP = New WinHttp.WinHttpRequest
        With myHTTP
            .Open "GET", sURL, True
            .Send
            .WaitForResponse 15
            Do Until .WaitForResponse = True
                DoEvents
            Loop
            'retour local
            urlGetStatus = .Status & ";" & .StatusText
            'retour global
            rtGetHTTP = .Status & ";" & .StatusText
        End With
    Set myHTTP = Nothing
    
End Function

Public Function urlFileExists(sURL As String) As Boolean
Dim rtGET As String, rtURL() As String
Dim hOpen As Long, hUrl As Long
Dim bufData As String, bytRead As Long

    bufData = Space(4096)
    hOpen = InternetOpen("IE", &H1, vbNullString, vbNullString, &H0)
        hUrl = InternetOpenUrl(hOpen, sURL, vbNullString, &H0, INTERNET_FLAG_EXISTING_CONNECT, &H0)
        
        'On split le retour dans un tableau
        rtGET = urlGetStatus(sURL)
        rtURL = Split(rtGET, ";")
            
            'Fichier trouvé ou autres
            If rtURL(0) = "200" Then
                urlFileExists = True
            Else
                urlFileExists = False
            End If
                
    InternetCloseHandle hOpen
    bufData = ""
    ReDim rtURL(0)
End Function

Function urlGetFiles(ByVal url As String, ByVal FileName As String) As Boolean
urlGetFiles = False
Dim value As Long

    If Dir$(FileName) <> "" Then
        Kill FileName
    End If
    
    Screen.MousePointer = 11
        value = URLDownloadToFile(0, url, FileName, 0, 0)
        DoEvents
    Screen.MousePointer = 1
        
urlGetFiles = True
End Function

Conclusion :


Exemple dans un bouton:

Private Sub Command1_Click()
Dim bReady As Boolean
Dim bDown As Boolean

Dim sTestURL As String
Dim sDestFileName As String, sDestFilePath As String, sDestPath As String

'INIT AR
sTestURL = "http://www.google.fr/intl/fr_fr/images/logo.gif"
sDestFilePath = "C:\Users\Public\Desktop\"
sDestFileName = Mid$(sTestURL, InStrRev(sTestURL, "/") + 1)
sDestPath = sDestFilePath & sDestFileName

bReady = urlFileExists(sTestURL)
If bReady = False Then
MsgBox "Fichier introuvable !", vbExclamation, "RT: " & modHTTP.rtGetHTTP
Else
MsgBox "Fichier trouvé !", vbInformation, "RT: " & modHTTP.rtGetHTTP
If MsgBox("Telechargez maintenant ?", vbQuestion + vbYesNo) = vbYes Then
bDown = modHTTP.urlGetFiles(sTestURL, sDestPath)
If bDown = True Then
MsgBox "Fichier telechargé avec succes:" & vbCrLf & sDestPath, vbInformation
Else
MsgBox "Erreur lors du telechargement !", vbExclamation
End If
End If
End If
End Sub

A voir également

Ajouter un commentaire

Commentaires

Signaler
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
 35
hors ERR.RAISE, une fonction ne doit pas faire apparaitre de MSGBOX, c'est à l'appelant de la fonction de le faire. la fonction peut en revanche renvoyer un enum au lieu d'un boolean

pour le 404 un test like "<title>*404*</title>" (bien qu'incomplet) serait sans doute déjà plus probant

après oui de toute façon c'est un terrain particulier souvent mêlé à la bidouille, ce qui n'empêche pas de faire quelques tests supplémentaires ;)

++
Signaler
Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
 3
Salut,

c'est du code fonctionnel après il faut le bidouiller a sa sauce. Mes fichiers sont des .EXE et donc si je retrouve une balise <html en retour; pour moi c'est du 404 (perso ou non).
L'idée: je propose une base de code pour une interrogation
sur l'existence d'un fichier en ligne.

Mon mérite serait que quelqu'un s'en sert pour le bidouiller, l'améliorer ou lui donne des idées...

Oui ^^ google :) c'est optionnel d'un sens mais bon...
C'est sympa pour le message d'erreur; entre <fichier n'existe pas puisque buffer vide> ET <vous n'etes pas connecté>.

Voilou++
Signaler
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
 35
salut,

je ne vois pas bien la démarche....

tu récupères une partie du fichier
s'il contient "<html" alors il n'existe pas? (404)

et si c'est un fichier texte qui contient cette balise?
ou juste une vrai page html, c'est pourtant bien un fichier
ou que le 404 a été personnalisé par une page sans balise?

et tu fais un premier test avec google (sympa pour eux) pour tester la connexion, il n'est pas utile non plus puisque de toute façon sans connexion ton buffer sera vide

peux-tu expliquer l'idée stp...

++
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 (Duke49)