'From:  "Gregg Morrison" <greggmor@b...>  Thu Sep 19, 2002  3:40 pm
'Subject:  Re: [rapidq] Check for internet connection
'There're Lots of easy ways to do this. Cut and paste and use as desired.
'(Sorry that this is VisualBasic - But should not be too hard to patch up for
'RapidQ)


'4 Pieces here - Mix and Match them to do many things.

'-----------------
'Part 1: Are you Attached to the Internet?
'-----------------

 Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias _
"RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As _
Long) As Long

 Declare Function RasGetConnectStatus Lib "RasApi32.DLL" Alias _
"RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long

' RAS = Remote Access Service
 Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

 Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type


'***********************************************************
' Returns Connected to Internet status
'***********************************************************
 Function Connected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95

TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)

If RetVal <> 0 Then
MsgBox "Error " & Err & " Has Occured!", vbOKOnly + vbCritical, _
"Error!"
Exit Function
End If

Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)

If Tstatus.RasConnState = &H2000 Then
Connected = True
Else
Connected = False
End If

End Function





'-----------------
'Part 2: Attach or Disconnect the Internet Your Way.
'-----------------

 Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As _
Long, ByVal dwReserved As Long) As Boolean

 Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal _
dwReserved As Long) As Boolean

' **************
'INTERNET_AUTODIAL_FORCE_ONLINE Forces an online Connection.
'INTERNET_AUTODIAL_FORCE_UNATTENDED Forces an unattended Internet dial-up.
' DISCONNECT Needs no explanation
' **************
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2

 Enum InternetConnect
DISCONNECT = 0
PROMPT_USER = INTERNET_AUTODIAL_FORCE_ONLINE
SILENT_MODE = INTERNET_AUTODIAL_FORCE_UNATTENDED
End Enum


'***********************************************************
' Implements Connection and Disconnect from the Internet
'***********************************************************
 Function AttachInternet(ByVal iMode As InternetConnect) As Boolean

AttachInternet = False

Select Case iMode
Case PROMPT_USER:
'To prompt the user to connect to the Net
If InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE, 0) Then _
AttachInternet = True

Case SILENT_MODE:
'To automatically start dialling
If InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) Then _
AttachInternet = True

Case DISCONNECT:
'To disconnect an automatically dialled connection
If InternetAutodialHangup(0) Then AttachInternet = True
End Select

End Function


'-----------------
'Part 3: Open Browser to any desired URL
'-----------------


' **************
' vbHide Window is hidden and focus is passed to the hidden window.
' vbNormalFocus Window has focus and is restored to its original size and position.
' vbMinimizedFocus Window is displayed as an icon with focus.
' vbMaximizedFocus Window is maximized with focus.
' vbNormalNoFocus Window is restored to its most recent size and position. 
' The currently active window remains active.
' vbMinimizeNoFocus Window is displayed as an icon. The currently active window remains active.
' **************

Const vbHide = 0
Const vbNormalFocus = 1
Const vbMinimizedFocus = 2
Const vbMaximizedFocus = 3
Const vbNormalNoFocus = 4
Const vbMinimizeNoFocus = 6

'***********************************************************
' Open Browser to specific Web Page
'***********************************************************
 Sub OpenUrl(URL As String)
Shell ("Explorer " & URL), vbNormalNoFocus
End Sub


'-----------------
'Part 4: Retrieve Any URL into a String
'-----------------


 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

 Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
"InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal _
sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal _
lContext As Long) As Long

 Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As _
Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer

 Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet _
As Long) As Integer



Dim sAUTO_AGENT_ID as String

'***********************************************************
' Retrieves a specific URL into a string
'***********************************************************
 Function GetURL(sUrl As String) As String
On Error Resume Next
Dim hOpen As Long
Dim hOpenUrl As Long
Dim bDoLoop As Boolean
Dim bRet As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long
Dim sBuffer As String


' Automatically Configure AGENT to Identify this app
If Len(sAUTO_AGENT_ID) = 0 Then sAUTO_AGENT_ID = "Your App Signature Here"


' Try Direct - bypasses AOL and MSN unles Firewall
hOpen = InternetOpen(sAUTO_AGENT_ID, INTERNET_OPEN_TYPE_DIRECT, _
vbNullString, vbNullString, 0)
If hOpen = 0 Then ' Try Preconfigured Proxy
hOpen = InternetOpen(sAUTO_AGENT_ID, INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, vbNullString, 0)
End If
If InStr(1, sUrl, "tp://", vbTextCompare) > 0 Then
hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, _
INTERNET_FLAG_RELOAD, 0)
Else
hOpenUrl = InternetOpenUrl(hOpen, "HTTP://" & sUrl, vbNullString, 0, _
INTERNET_FLAG_RELOAD, 0)
End If
bDoLoop = True
While bDoLoop
sReadBuffer = ""
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), _
lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
GetURL = Trim$(sBuffer)

End Function