Anzeige
Archiv - Navigation
508to512
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
508to512
508to512
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Feststellen ob Onlineverbindung besteht

Feststellen ob Onlineverbindung besteht
30.10.2004 22:41:20
Frank
Hallo Excelfreunde,
kann ich irgendwie mit VBA feststellen, ob eine Onlineverbindung besteht?
Gruß Frank

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Feststellen ob Onlineverbindung besteht
30.10.2004 23:00:20
Josef
Hallo Frank!
Das script kommt von hier.
http://www.activevb.de/tipps/vb6tipps/tipp0021.html
Ich hab's ein bischen verändert um nur den Onlinstatus zu Cheken (True/False).
Option Explicit
'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.
'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!
' Die Komponente 'Microsoft Winsock Control 6.0 (SP6) (MSWINSCK.OCX)'
' wird benötigt.
' Korrekturen by GFi http://www.ispf.de 14.12.2002
Private Declare Function RasEnumConnections Lib "RasApi32.dll" _
Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As _
Long, lpcConnections As Long) As Long

Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" _
Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, _
lpStatus As Any) As Long

Const RAS_MaxEntryName = 256
Const RAS_MaxDeviceType = 16
Const RAS_MaxDeviceName = 128 'Änderung am 14.12.2002: nicht 32!
'Änderung am 14.12.2002: Für RasEnumConnections Rückgabewert
Private Const ERROR_BUFFER_TOO_SMALL = 603
Private Type RASType
dwSize As Long
hRasCon As Long
szEntryName(RAS_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
' Die magische Zahl 412...
' dwSize Long 4 Byte
' hRasCon Long 4 Byte
' szEntryName Byte 257 Byte (257, weil 0 mitzählt!)
' szDeviceType Byte 17 Byte
' szDeviceName Byte 129 Byte
' ============================
' 411 Byte
' 411 ist ungerade, daher auf nächte Long Grenze aufrunden
' 411 + ((4 - 411 Mod 4)) Mod 4 = 412
Private Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
' + GFi Verbindungs Status
Private Enum RasConnState
RASCS_PAUSED = &H1000&
RASCS_DONE = &H2000&
RASCS_OpenPort = 0&
RASCS_PortOpened = 1&
RASCS_ConnectDevice = 2&
RASCS_DeviceConnected = 3&
RASCS_AllDevicesConnected = 4&
RASCS_Authenticate = 5&
RASCS_AuthNotify = 6&
RASCS_AuthRetry = 7&
RASCS_AuthCallback = 8&
RASCS_AuthChangePassword = 9&
RASCS_AuthProject = 10&
RASCS_AuthLinkSpeed = 11&
RASCS_AuthAck = 12&
RASCS_ReAuthenticate = 13&
RASCS_Authenticated = 14&
RASCS_PrepareForCallback = 15&
RASCS_WaitForModemReset = 16&
RASCS_WaitForCallback = 17&
RASCS_Projected = 18&
RASCS_StartAuthentication = 19& ' nur Win 95
RASCS_CallbackComplete = 20& ' nurWin 95
RASCS_LogonNetwork = 21& ' nur Win 95
RASCS_SubEntryConnected = 22&
RASCS_SubEntryDisconnected = 23&
RASCS_Interactive = RASCS_PAUSED
RASCS_RetryAuthentication = RASCS_PAUSED + 1&
RASCS_CallbackSetByCaller = RASCS_PAUSED + 2&
RASCS_PasswordExpired = RASCS_PAUSED + 3&
RASCS_Connected = RASCS_DONE
RASCS_Disconnected = RASCS_DONE + 1&
End Enum

Private Function StripNull(ByRef strNullTerminatedstring) As String
StripNull = Left(strNullTerminatedstring, InStr(1, _
strNullTerminatedstring, Chr(0)) - 1)
End Function

Private Function DFÜStatus() As Boolean
' Änderung am 14.12.2002: Dim RAS(255) As RASType
' Warum gleich 255?
' Die Funktion RasEnumConnections gibt einen Fehler zurück,
' wenn der Speicher nicht reicht. Daher...
Dim RAS() As RASType
' entspricht in C++ Pointer anlegen
Dim RASStatus As RASStatusType
Dim lg&, lpcon&, Result&
' Änderung am 14.12.2002:
Dim i As Long
ReDim RAS(1)
' Änderung am 14.12.2002: RAS(0).dwSize = 412 Falsch!
' Der Fehler ist von Microsoft übernommen und weltweit verbreitet worden.
RAS(0).dwSize = LenB(RAS(0)) + (4 - (LenB(RAS(0)) Mod 4)) Mod 4
' Änderung am 14.12.2002: lg = 256 * RAS(0).dwSize
' lg ist ein Rückgabewert von der Funktion und wird nicht gesetzt!
Result = RasEnumConnections(RAS(0), lg, lpcon)
' Änderung am 14.12.2002:
If (Result = ERROR_BUFFER_TOO_SMALL) And (lpcon > 0) Then
' Fehler, zuwenig Speicher.
' In diesem Fall einfach das Array vergrößern.
ReDim Preserve RAS(UBound(RAS()) + 1)
Result = RasEnumConnections(RAS(0), lg, lpcon)
' Kommentar am 14.12.2002: man könnte dies auch in eine While Wend
' Schleife setzen. Ich bin mir allerdings nicht sicher,
' ob das Funktioniert und ob es je mehr als eine Verbindung
' geben kann. Die Funktion ist jedenfalls dafür ausgelegt.
End If
' Änderung am 14.12.2002: Funktionsrückkehr ohne Fehler!
If Result = 0 Then
If lpcon = 0 Then
DFÜStatus = False
Else
' 'Änderung am 14.12.2002: RASStatus.dwSize = 160 ' Falsch!
' Der Fehler ist von Microsoft übernommen und weltweit
' verbreitet worden.
RASStatus.dwSize = LenB(RASStatus) + (4 - (LenB(RASStatus) Mod _
4)) Mod 4
' Änderung am 14.12.2002: Alle Verbindungen durchgehen...
For i = 0 To lpcon - 1
' Änderung am 14.12.2002: RAS(0).hRasCon enhält das Handle
' der 1. DFü-Verbindung
Result = RasGetConnectStatus(RAS(i).hRasCon, RASStatus)
' Änderung am 14.12.2002: GFi RASStatus.RasConnState
' vergleich mit Enum RasConnState
If RASStatus.RasConnState = RasConnState.RASCS_Connected Then
DFÜStatus = True
Else
DFÜStatus = False
End If
Next i
End If
End If
End Function

Sub test()
MsgBox DFÜStatus
End Sub

Gruß Sepp
Anzeige
@Nepumuk,@Josef
Ramses
Hallo ihr beiden
Ich glaube prinzipiell ja schon das der Code funktioniert,... aber hat jemand von euch beiden einen ADSL Anschluss und geht über einen Router online ?
Ich erhalte bei beiden Varianten den Hinweis, dass KEINE Online Verbindung besteht.
Gruss Rainer
AW: @Nepumuk,@Josef
30.10.2004 23:11:45
Nepumuk
Hi Rainer,
nee DSL und da geht's. Wenn du natürlich mit so einem exotischem wie hieß das noch mal?
Gruß
Nepumuk
AW: @Nepumuk,@Josef
Ramses
Hallo Nepumuk
dann gehst du direkt mit einem ADSL-Modem online ?
Dann interpretiere ich deinen Code also auch richtig, dass nur der RAS - Status eines Modems abgefragt wird.
Gruss Rainer
Anzeige
AW: @Nepumuk,@Josef
30.10.2004 23:20:20
Nepumuk
Hallo Rainer,
richtig!!!!!!!!
Gruß
Nepumuk
AW: @Nepumuk,@Josef
30.10.2004 23:12:46
Josef
Hallo Rainer!
Ich bin mit ADSL und Router Online und der Status wird korrekt angezeigt.
Gruß Sepp
AW: @Nepumuk,@Josef
Ramses
Hallo Josef
hast du ein ADSL- Modem am Router dranhängen ?
Denn bei dir wird eigentlich auch nur der Modem-Status abgefragt.
Ich bin Wireless, über einen Access-Point der an einen Switch angeschlossen ist, connected.
Der ADSL Router ist als Gateway definiert
Gruss Rainer
AW: @Nepumuk,@Josef
30.10.2004 23:20:58
Josef
Hallo Rainer!
War natürlich quatsch!
Sollte ADSL und Splitter heisen ;-(
Gruß Sepp
Gerade gefunden....
Ramses
Hallo
... bei Nicolai, getestet und funktioniert.
Bringt auch den richtigen Status bei LAN-Verbindungen
Option Explicit
'****************************************************
'Von Nicolai Stiehl. Dort ebenfalls unbekannter Autor
'Start Code Sequenz
'-
'Check internet connection state
'Internetverbindung überprüfen
'There is plenty of code around to show you
'how to detect connections to the internet
'when using Dial Up Networking.'
'But how about internet connections over a LAN?
'This code solves your problems.
'Add this code to a module :
'Es gibt genug Code um zu prüfen,
'ob eine Verbindung zum Internet besteht,
'wenn eine DFÜ Verbindung besteht.
'Dieser Code prüft, ob eine Internetverbindung
'über das LAN besteht.
'Fügen Sie diesen Code in ein Modul:
Public Declare Function InternetGetConnectedState _ Lib "wininet.dll" (ByRef lpSFlags As Long, _ ByVal dwReserved As Long) As Long Public Const INTERNET_CONNECTION_LAN As Long = &H2 Public Const INTERNET_CONNECTION_MODEM As Long = &H1 Public

Function Online() As Boolean
'If you are online it will return True, otherwise False
Online = InternetGetConnectedState(0&, 0&)
End Function

Public

Function ViaLAN() As Boolean
Dim SFlags As Long
'return the flags associated with the connection
Call InternetGetConnectedState(SFlags, 0&)
'True if the Sflags has a LAN connection
ViaLAN = SFlags And INTERNET_CONNECTION_LAN
End Function

Public

Function ViaModem() As Boolean
Dim SFlags As Long
'return the flags associated with the connection
Call InternetGetConnectedState(SFlags, 0&)
'True if the Sflags has a modem connection
ViaModem = SFlags And INTERNET_CONNECTION_MODEM
End Function

' Den Code einem Formular mit einer Befehlsschaltfläche und 3 Textfeldern hinzufügen
' Der Wert "True" wird für die entsprechende Verbindung zurückgegeben

Sub Check_Online_State()
' Diesen Code der Befehlsschaltfläche hinterlegen
If ViaLAN() = True Then MsgBox "Connect via LAN möglich"
If ViaModem() = True Then MsgBox "Connect via LAN möglich"
If Online() = True Then MsgBox "Sie sind bereits DRIN "
End Sub

'****************************
'Ende Code Sequenz
Gruss Rainer
Anzeige
Kleine Korrektur....
Ramses
Hallo
Kopierfehler beim zusammenbasteln :-)
Statt
If ViaModem() = True Then MsgBox "Connect via LAN möglich"
muss es natürlich
If ViaModem() = True Then MsgBox "Connect via MODEM möglich"
Gruss Rainer
AW: Feststellen ob Onlineverbindung besteht
30.10.2004 23:02:21
Nepumuk
Hallo Frank,
so geht's:


Option Explicit
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As LongAs Long
Private Enum Constant
    RAS_MaxEntryName = 256
    RAS_MaxDeviceType = 16
    RAS_MaxDeviceName = 32
    Max_Fill = 96
End Enum
Private Type RASType
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS_MaxEntryName) As Byte
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS_MaxDeviceName) As Byte
    dwFill(Max_Fill) As Byte
End Type
Public Sub Test()
    Dim RAS(255) As RASType
    Dim lg As Long, lpcon As Long
    RAS(0).dwSize = 412
    lg = 256 * RAS(0).dwSize
    RasEnumConnections RAS(0), lg, lpcon
    If lpcon = 0 Then
        MsgBox "Keine Online-Verbindung gefunden", 64, "Information"
    Else
        MsgBox "Online-Verbindung steht", 64, "Information"
    End If
End Sub


Gruß
Nepumuk
Anzeige
AW: Feststellen ob Onlineverbindung besteht
K.Rola
Hallo,
trotz prominenter Gesellschaft dies von mir, wenn auch ziemlich spät:
Option Explicit
Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef K As Long, ByVal Rola As Long) As Long
Sub teste_online()
Dim ol As Boolean
ol = InternetGetConnectedState(0&, 0&)
If ol Then
MsgBox "Verbindung besteht!"
Else
MsgBox "Nix da!"
End If
End Sub

Gruß K.Rola
Lieber spät als nie :-) o.T.
Ramses
...
Danke an alle für eure Beiträge mT
Frank
Muss erstmal versuchen, das zu verdauen.
Gruß Frank

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige