Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0383: Gesendete und Empfangene Bytes unter Win2K

 von 

Beschreibung 

Was in Tipp 55 beschrieben wurde, funktioniert ab Windows 2000 nicht mehr, hier die spezielle Lösung in Form einer neu eingeführten API.

Update am 29.12.2008: Dieser Tipp wurde von Kai mithilfe des Tippuploads überarbeitet und ersetzt.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

RasEnumConnectionsA (RasEnumConnections), RasGetConnectStatusA (RasGetConnectStatus), RasGetConnectionStatistics, SetWindowPos, lstrcpyA (StrCopyA), lstrlenA (StrLenA)

Download:

Download des Beispielprojektes [3,41 KB]

'Dieser Quellcode 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!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
Option Explicit

'Autor: Sven Putzönius
'E-Mail: support@putcom.de

'Update 19.09.2006 by Kai@ActiveVB.de

Private Const RASCS_PAUSED As Long = &H1000&
Private Const RASCS_DONE As Long = &H2000&

Private Enum RasConnectionState
    RASCS_OpenPort = 0
    RASCS_PortOpened
    RASCS_ConnectDevice
    RASCS_DeviceConnected
    RASCS_AllDevicesConnected
    RASCS_Authenticate
    RASCS_AuthNotify
    RASCS_AuthRetry
    RASCS_AuthCallback
    RASCS_AuthChangePassword
    RASCS_AuthProject
    RASCS_AuthLinkSpeed
    RASCS_AuthAck
    RASCS_ReAuthenticate
    RASCS_Authenticated
    RASCS_PrepareForCallback
    RASCS_WaitForModemReset
    RASCS_WaitForCallback
    RASCS_Projected
    RASCS_StartAuthentication
    RASCS_CallbackComplete
    RASCS_LogonNetwork
    RASCS_SubEntryConnected
    RASCS_SubEntryDisconnected
    RASCS_Interactive = RASCS_PAUSED
    RASCS_RetryAuthentication
    RASCS_CallbackSetByCaller
    RASCS_PasswordExpired
    RASCS_InvokeEapUI
    RASCS_Connected = RASCS_DONE
    RASCS_Disconnected
End Enum

Private Declare Function RasGetConnectionStatistics Lib "RasApi32.DLL" ( _
    ByVal hRasConn As Long, ByRef lpStatistics As RASSTATS2000) As Long

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, _
    ByRef lpStatus As Any) As Long

Private Declare Function StrLenA Lib "kernel32.dll" Alias "lstrlenA" ( _
    ByVal lpString As Long) As Long

Private Declare Function StrCopyA Lib "kernel32.dll" Alias "lstrcpyA" ( _
    ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Private Declare Function SetWindowPos Lib "user32.dll" ( _
    ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
    ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
    ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST As Long = -1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1

Private Type RASSTATS2000
    dwSize As Long
    dwBytesXmited As Long
    dwBytesRcved As Long
    dwFramesXmited As Long
    dwFramesRcved As Long
    dwCrcErr As Long
    dwTimeoutErr As Long
    dwAlignmentErr As Long
    dwHardwareOverrunErr As Long
    dwFramingErr As Long
    dwBufferOverrunErr As Long
    dwCompressionRatioIn As Long
    dwCompressionRatioOut As Long
    dwBps As Long
    dwConnectDuration As Long
End Type

Private Const RAS_MaxEntryName As Long = 256
Private Const RAS_MaxDeviceType As Long = 16
Private Const RAS_MaxDeviceName As Long = 128

Private Type RASType
    dwSize As Long
    hRasCon As Long
    szEntryName(0 To RAS_MaxEntryName) As Byte
    szDeviceType(0 To RAS_MaxDeviceType) As Byte
    szDeviceName(0 To RAS_MaxDeviceName) As Byte
End Type

Private Type RASStatusType
    dwSize As Long
    dwRasConnState As RasConnectionState
    dwError As Long
    szDeviceType(0 To RAS_MaxDeviceType) As Byte
    szDeviceName(0 To RAS_MaxDeviceName) As Byte
End Type

Private Sub Form_Load()

    Label1.Caption = "stopped"
    Label1.Top = 240: Label1.Left = 1680
    Label1.Height = 255: Label1.Width = 2775
    Label2.Caption = "stopped"
    Label2.Top = 600: Label2.Left = 1680
    Label2.Height = 255: Label2.Width = 2775
    Label3.Caption = "gesendete Bytes:"
    Label3.Top = 240: Label3.Left = 120
    Label3.Height = 255: Label3.Width = 1455
    Label4.Caption = "empfangene Bytes:"
    Label4.Top = 600: Label4.Left = 120
    Label4.Height = 255: Label4.Width = 1455
    
    Me.Height = 1395
    Me.Width = 4770
    
    Timer1.Interval = 200
    Timer1.Enabled = True
    Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub

Private Sub Timer1_Timer()
    Call ActiveConnection
End Sub

Private Function ActiveConnection() As Boolean
    Dim RAS(255) As RASType, RASStatus As RASStatusType
    Dim lg As Long, lpcon As Long, Result As Long
    Dim myStats As RASSTATS2000, sDefault As String
    
    RAS(0).dwSize = LenB(RAS(0))
    lg = 256 * RAS(0).dwSize
    Result = RasEnumConnections(RAS(0), lg, lpcon)
    
    If lpcon = 0 Then
        'Offline
        Me.Caption = "no Connection"
        sDefault = "no RAS-Connection or Error (" & CStr(Result) & ")"
        Form1.Label2.Caption = sDefault
        Form1.Label1.Caption = sDefault
    Else
        RASStatus.dwSize = LenB(RASStatus)
        Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
        
        If RASStatus.dwRasConnState = RASCS_Connected Then
            'Online
            myStats.dwSize = LenB(myStats)
            Result = RasGetConnectionStatistics(RAS(0).hRasCon, myStats)
            If Result = 0 Then
                ActiveConnection = True
                Me.Caption = PtrStr(VarPtr(RAS(0).szEntryName(0))) & " - " & _
                    PtrStr(VarPtr(RASStatus.szDeviceName(0)))
                Form1.Label2.Caption = CStr(myStats.dwBytesRcved) & " Bytes"
                Form1.Label1.Caption = CStr(myStats.dwBytesXmited) & " Bytes"
            Else
                Me.Caption = "Error"
                Form1.Label2.Caption = "State (" & GetStateStr(RASStatus.dwRasConnState) & ")"
                Form1.Label1.Caption = "GetStatistics faild, Error (" & CStr(Result) & ")"
            End If
        Else
            'DFÜ-Einwahl oder -Trennen
            sDefault = "State (" & GetStateStr(RASStatus.dwRasConnState) & _
                "), Error (" & CStr(Result) & ")"
            Form1.Label2.Caption = sDefault
            Form1.Label1.Caption = sDefault
        End If
    End If
End Function

' Hilfsfunktionen
Private Function PtrStr(ByVal lpString As Long) As String
    If lpString Then
        PtrStr = String$(StrLenA(lpString), 0)
        If LenB(PtrStr) Then Call StrCopyA(PtrStr, lpString)
    End If
End Function

Private Function GetStateStr(lState As RasConnectionState) As String
    Select Case lState
    Case RASCS_OpenPort: GetStateStr = "OpenPort"
    Case RASCS_PortOpened: GetStateStr = "PortOpened"
    Case RASCS_ConnectDevice: GetStateStr = "ConnectDevice"
    Case RASCS_DeviceConnected: GetStateStr = "DeviceConnected"
    Case RASCS_AllDevicesConnected: GetStateStr = "AllDevicesConnected"
    Case RASCS_Authenticate: GetStateStr = "Authenticate"
    Case RASCS_AuthNotify: GetStateStr = "AuthNotify"
    Case RASCS_AuthRetry: GetStateStr = "AuthRetry"
    Case RASCS_AuthCallback: GetStateStr = "AuthCallback"
    Case RASCS_AuthChangePassword: GetStateStr = "AuthChangePassword"
    Case RASCS_AuthProject: GetStateStr = "AuthProject"
    Case RASCS_AuthLinkSpeed: GetStateStr = "AuthLinkSpeed"
    Case RASCS_AuthAck: GetStateStr = "AuthAck"
    Case RASCS_ReAuthenticate: GetStateStr = "ReAuthenticate"
    Case RASCS_Authenticated: GetStateStr = "Authenticated"
    Case RASCS_PrepareForCallback: GetStateStr = "PrepareForCallback"
    Case RASCS_WaitForModemReset: GetStateStr = "WaitForModemReset"
    Case RASCS_WaitForCallback: GetStateStr = "WaitForCallback"
    Case RASCS_Projected: GetStateStr = "Projected"
    Case RASCS_StartAuthentication: GetStateStr = "StartAuthentication"
    Case RASCS_CallbackComplete: GetStateStr = "CallbackComplete"
    Case RASCS_LogonNetwork: GetStateStr = "LogonNetwork"
    Case RASCS_SubEntryConnected: GetStateStr = "SubEntryConnected"
    Case RASCS_SubEntryDisconnected: GetStateStr = "SubEntryDisconnected"
    Case RASCS_Interactive: GetStateStr = "Interactive"
    Case RASCS_RetryAuthentication: GetStateStr = "RetryAuthentication"
    Case RASCS_CallbackSetByCaller: GetStateStr = "CallbackSetByCaller"
    Case RASCS_PasswordExpired: GetStateStr = "PasswordExpired"
    Case RASCS_InvokeEapUI: GetStateStr = "InvokeEapUI"
    Case RASCS_Connected: GetStateStr = "Connected"
    Case RASCS_Disconnected: GetStateStr = "Disconnected"
    Case Else: GetStateStr = "wrong state"
    End Select
End Function


'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 17 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von XoRiC am 24.10.2004 um 01:02

Bei mir stürzt VB durch eine kritische Fehlermeldung ab, sobald der Timer die Abfrage aufruft...

Kommentar von am 01.06.2004 um 12:33

Bei mir ist VB6 immer wieder abgestürzt bis ich die Boolean-Rückgabeparameter von ActiveConnection() auskomentiert habe(diese werden ja nicht gebraucht)

Kommentar von Ykiam am 26.04.2004 um 06:14

es liegt ja nich an deinem datentyp den du nimmst...
sondern den, den windoof benutzt

Kommentar von Spider am 26.04.2004 um 01:47

Hallo,

hat es vieleicht schon mal einer mit Decimal probiert?

Geht ja bis +/-79.228.162.514.264.337.593.543.950.335

Das sollte definitiv reichen ;)

Cu

Kommentar von Ykiam ;) am 10.10.2003 um 17:58

HeyHo!!!
Hat jemand ne gloreiche Loesung fuer das 2GB-Problem?
Ich haette was (umstaendliches parat...)
das ware dann so ca. bei ueberlaufcrash form entldaen, ne andere laden(natuerlich merken wieviel's schon war!) und dann das orginal wieder laden...

-> hab ich aber noch nich umgesetzt - dachte ich haette das prob rausbekommen :..(

Kommentar von De Mischi am 12.09.2003 um 12:12

Moin zusamme...

Bei mir hats eigentlich geklappt, also die Anzeige der Bytes. Wenn ich allerdings auf die anderen wichtigen Statistiken, wie z.B. dwBps (Geschwindigkeit) oder dwConnectDuration (Onlinedauer), zugreifen will, dann bringt er mir immer ein Speicherzuweisungsfehler. Bin grad dabei meinen eigenen Online Stunden Zähler zu schreiben und da bräuchte ich ne verlässliche Uhr. Klaro könnte man das auch alles mit nem simplen Timmer realisieren, aber wenn die Statistiken direkt von Windows kommen wäre dat scho besser. Kenne mich zwar noch net so gut aus mit Dll Funktionen, aber is scho mächtig kompliziert. Hier gibts mehr Infos zu der Funktion:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/rras/rras/rasgetconnectionstatistics.asp

Danke scho ma

Kommentar von Haehnchen am 10.08.2003 um 17:36

Also ich wüßte auch gern wie man diese Daten bei einer LAN Verbindung anzeigen läßt.
Zusätzlich noch die aktuelle Up/Down-Rate der Lan-Conn wäre auch ned schlecht :D

Kommentar von TTornado am 26.05.2003 um 17:44

also bei mir ticken die bytes net hoch, hab Win2k Sp1 VB6 SP5, kann da wer helfen???

Kommentar von FanatiX am 23.04.2003 um 10:18

es gibt da n echtes problem mit den variablen....da ich ein power user bin schick ich tag täglich so um die 1,5gb daten über die leitung-die variablen sind zu klein für sowas
die schaffen die länge des werts der bytes nich

Kommentar von Markus am 28.01.2003 um 20:04

Hatte das gleiche Problem, aber dank Gunter Schmidts Info hats geklappt.

Kommentar von Michael am 23.01.2003 um 15:19

Direkt in VB stützt es ab, aber wenn mans kompiliert geht es.

Kommentar von Puri am 12.01.2003 um 02:21

Tut doch problemlos unter XP (SP1)

Kommentar von Gunter Schmidt am 10.12.2002 um 22:41

im Tipp 383 sind diese Zeilen zuviel:
szInBytes As Double
syOutbytes As Double

Die Struktur ist zu lang und führt beim RASPPPOE-Treiber unter W2K zum Absturz.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/rras/rras/rasconnstatus_str.asp

Kommentar von Teker am 19.11.2002 um 14:59

Bei mir gehts ned. Der sagt immer read konnte da und da hin nicht ausgeführt werden. Win2000Pro SP3 VB6

Kommentar von siml am 08.08.2002 um 16:27

hi!
ich brauch sowas für windows nt!!(version 4)
kennt jemand für nt sowas? oda funktioniert dies unter nt auch?(das kreuz sagt zwar nein aber könnte ja sein nt und w2k sind ja sehr ähnlich ;))
cu
siml

Kommentar von MasterFX am 06.02.2002 um 14:26

Also ich habe festgestellt, das diese API Funktion nicht mehr geht, wenn man mehr als 2.147.483.647 Bytes übertragen/empfangen hat. Das liegt ja anscheinend an dem Datentyp "Long", aber man kann nicht Long einfach in Single umbennen, weiss vielleicht jemand wie man das realisieren könnte?

Kommentar von Daniel Koch am 07.08.2001 um 17:11

Gibt es auch eine Möglichkeit, diese Statistiken für eine LAN Verbindung abzurufen?