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

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

 von Kai

'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-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

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.