' Rapid-Q by William Yu (c)1999-2000 . ' ================================================================================ ' Upload_il_tuo_script_su_Rapidq.it ' connessioni_internet 'From: "Gregg Morrison" 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 Long, lpcb As Long, lpcConnections As Long) As Long Declare Function RasGetConnectStatus Lib "RasApi32.DLL" Alias _ "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Long) 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 Integer 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 print "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 Integer Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Integer ' ************** '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 ' =============================================================================== ' 2003 Holyguard.net - 2007_Abruzzoweb