INetConnection

Option Compare Text
Option Explicit
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Declare Function InternetOpen _
Lib "wininet.dll" Alias "InternetOpenW" _
(ByVal lpszAgent As Long, _
ByVal dwAccessType As Long, _
ByVal lpszProxyName As Long, _
ByVal lpszProxyBypass As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl _
Lib "wininet.dll" Alias "InternetOpenUrlW" _
(ByVal hInet As Long, _
ByVal lpszUrl As Long, _
ByVal lpszHeaders As Long, _
ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" (ByVal hInet As Long) As Long
Public Function TestConnection(stSite As String) As Boolean
Dim hInet As Long
Dim hUrl As Long
Dim lFlags As Long
Dim url As Variant
hInet = InternetOpen(StrPtr(App.Title), INTERNET_OPEN_TYPE_PRECONFIG, 0&, 0&, 0&)
If hInet Then
lFlags = INTERNET_FLAG_KEEP_CONNECTION Or _
INTERNET_FLAG_NO_CACHE_WRITE Or _
INTERNET_FLAG_RELOAD
hUrl = InternetOpenUrl(hInet, StrPtr(stSite), 0&, 0, lFlags, 0)
If hUrl Then
TestConnection = True
Call InternetCloseHandle(hUrl)
hUrl = 0
End If
End If
Call InternetCloseHandle(hInet)
hInet = 0
End Function