Get DUN og LAN connection duration time

Hey :-)

I've searched, looked and asked people I know who knows VB but I've not yet found the answer to my question, so I thought I'd give it a shot here :-)

If possible, how do I find the duration time for a particular DUN og LAN connection ?

I found a piece of code on that would get me bytes transmitted (Tx & Rx), but it could not tell me how long the connection has been connected.
Who is Participating?
WalterMConnect With a Mentor Commented:
I don't know about DUN connections, but the uptime for LAN connections can be retrieved from either a CONNECTION_INFO_10 or a CONNECTION_INFO_50 structure, as returned by a NetConnectionEnum call.

Unfortunately, the NetXXX API isn't quite that easy to use from VB. I have written a library for it some time ago, here's the (partial) code:

*** code starts here ***

' -------------------------------------
' Module modDeclarations
' -------------------------------------

Option Explicit

'Session Info declarations

Public Enum SessionInfoLevel
    SesInfLevel0 = 0
    SesInfLevel10 = 10
    SesInf_Microsoft_NT = 10
    SesInfLevel50 = 50
    SesInf_Netware = 50
End Enum

Public Type SESSION_INFO_0
    lpClientName As Long
End Type

Public Type SESSION_INFO_10
    lpClientName As Long
    lpUserName As Long
    Time As Long
    IdleTime As Long
End Type

Public Type SESSION_INFO_50
    lpClientName As Long
    lpUserName As Long
    Key As Long
    NumConns As Integer
    NumOpens As Integer
    Time As Long
    IdleTime As Long
    Protocol As Byte
    Pad As Byte
End Type

'Net errors

    NERR_Success = 0&
    NERR_UserNotFound = 2221
    NERR_GroupExists = 2223
    NERR_UserExists = 2224
    NERR_NotPrimary = 2226
    NERR_PasswordTooShort = 2245
    NERR_ClientNameNotFound = 2312
    NERR_InvalidComputer = 2351
End Enum

Public Const NERR_BASE = 2100
Public Const MAX_NERR = NERR_BASE + 899

'FormatMessage declarations

End Enum

End Enum

'Net API declarations

Public Declare Function NetSessionEnum Lib "svrapi.dll" _
              (ByVal Server As String, _
               ByVal Level As Integer, _
               Buffer As Any, _
               ByVal BufferSize As Integer, _
               EntriesRead As Integer, _
               TotalAvail As Integer) As NET_API_STATUS

'Miscellaneous API declarations

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
              (Destination As Any, _
               Source As Any, _
               ByVal Length As Long)

Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
              (ByVal dwFlags As FORMAT_MESSAGE_FLAGS, _
               lpSource As Any, _
               ByVal dwMessageId As Long, _
               ByVal dwLanguageId As Long, _
               ByVal lpBuffer As String, _
               ByVal nSize As Long, _
               Arguments As Long) As Long

Public Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" _
              (ByVal lpLibFileName As String, _
               ByVal hFile As Long, _
               ByVal dwFlags As LOAD_LIBRARY_FLAGS) As Long

Public Declare Function FreeLibrary Lib "kernel32" _
              (ByVal hLibModule As Long) As Long

Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
              (ByVal RetVal As String, ByVal Ptr As Long) As Long

Public Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
              (ByVal Ptr As Long) As Long

Public Function GetSession(Buffer() As Byte, ByVal Index As Long, _
                            Optional ByVal Level As SessionInfoLevel = SesInfLevel50) As SESSION_INFO_50
    'Extracts and returns SESSION_INFO_50 structure stored in buffer at requested index
    Dim L As Long
    Dim S50 As SESSION_INFO_50
    Dim S10 As SESSION_INFO_10
    Dim S0 As SESSION_INFO_0

    Select Case Level
        Case 50
            L = Len(S50)
            CopyMemory S50, Buffer(Index * L), L
            GetSession = S50
        Case 10
            L = Len(S10)
            CopyMemory S10, Buffer(Index * L), L
            With S50
                .lpClientName = S10.lpClientName
                .lpUserName = S10.lpUserName
                .Time = S10.Time
                .IdleTime = S10.IdleTime
            End With
            GetSession = S50
        Case 0
            L = Len(S0)
            CopyMemory S0, Buffer(Index * L), L
            S50.lpClientName = S0.lpClientName
            GetSession = S50
        Case Else
            Err.Raise ERROR_INVALID_LEVEL, "GetSession", GetApiErrMsg(ERROR_INVALID_LEVEL)
    End Select

End Function

Public Function Ptr2Str(ByVal lpStr As Long) As String
    'Resolves string pointer to string value

    If lpStr <> 0 Then
        Ptr2Str = Space$(StrLen(lpStr))
        PtrToStr Ptr2Str, lpStr
        Ptr2Str = vbNullString
    End If

End Function

Public Function GetApiErrMsg(ByVal ErrCode As Long) As String
    'Returns windows system or network error description
    Dim Description As String * 256
    Dim Provider As String * 256
    Dim Result As Long
    Dim hModule As Long

    If (ErrCode >= NERR_BASE) And (ErrCode <= MAX_NERR) Then
        hModule = LoadLibraryEx("Netmsg.dll", 0&, LOAD_LIBRARY_AS_DATAFILE)
        If hModule Then Flags = Flags Or FORMAT_MESSAGE_FROM_HMODULE
    End If
    Result = FormatMessage(Flags, ByVal hModule, ErrCode, 0&, Description, Len(Description), ByVal 0&)
    If Result Then GetApiErrMsg = Left(Description, Result)
    If hModule Then FreeLibrary hModule

End Function

' -------------------------------------
' Class clsNetSession
' -------------------------------------

Option Explicit

Private SesInfo As SESSION_INFO_50
Private bClientName() As Byte
Private bUserName() As Byte

Private Sub Class_Initialize()
    'Debug.Print "clsNetSession Initialize"
End Sub

Private Sub Class_Terminate()
    'Debug.Print "clsNetSession Terminate"
End Sub

Friend Property Get Struct() As SESSION_INFO_50
    Struct = SesInfo
End Property

Friend Property Let Struct(NewValue As SESSION_INFO_50)

    'Copy member values
    SesInfo = NewValue

    'The first two members of the structure are string pointers,
    'pointing to a buffer containing the string values. Because this
    'buffer is not part of the object, it might be released before
    'the object is terminated. The string values would then be destroyed
    'too. Therefore we have to copy the buffer contents to local buffers.

    'Reserve some local space for descriptions
    ReDim bClientName(0 To 255)
    ReDim bUserName(0 To 255)
    'Copy string values to locals
    With NewValue
        CopyMemory bClientName(0), ByVal .lpClientName, 256
        CopyMemory bUserName(0), ByVal .lpUserName, 256
    End With
    'Adjust string pointers
    With SesInfo
        .lpClientName = VarPtr(bClientName(0))
        .lpUserName = VarPtr(bUserName(0))
    End With

End Property

Public Property Get ClientName() As String
    ClientName = Ptr2Str(SesInfo.lpClientName)
End Property

Public Property Get UserName() As String
    UserName = Ptr2Str(SesInfo.lpUserName)
End Property

Public Property Get Key() As Long
    Key = SesInfo.Key
End Property

Public Property Get NumConns() As Integer
    NumConns = SesInfo.NumConns
End Property

Public Property Get NumOpens()
    NumOpens = SesInfo.NumOpens
End Property

Public Property Get Time() As Long
    Time = SesInfo.Time
End Property

Public Property Get IdleTime() As Long
    IdleTime = SesInfo.IdleTime
End Property

Public Property Get Protocol() As Byte
    Protocol = SesInfo.Protocol
End Property

Public Property Get Pad() As Byte
    Pad = SesInfo.Pad
End Property

' -------------------------------------
' Class clsNetSessions
' -------------------------------------

Option Explicit

Private mSessions As Collection
Private mBufferSize As Long
Private mLevel As SessionInfoLevel
Private mServerName As String

Private Sub Class_Initialize()
    Set mSessions = New Collection
    mBufferSize = 16384
    mLevel = SesInfLevel50
    'Debug.Print "clsNetSessions Initialize"
End Sub

Private Sub Class_Terminate()
    Dim Index As Long
    On Error Resume Next
    With mSessions
        Index = .Count
        Do While Index > 0
            .Remove Index
            Index = Index - 1
    End With
    Set mSessions = Nothing
    'Debug.Print "clsNetSessions Terminate"
End Sub

Public Function Item(ByVal Index As Variant) As clsNetSession
    Set Item = mSessions(Index)
End Function

Public Function SessionActive(ByVal ClientName As String) As Boolean
    'Returns true when client has a session on the current server
    On Error Resume Next
    Dim Session As clsNetSession
    Set Session = mSessions(ClientName)
    SessionActive = Not (Session Is Nothing)
End Function

Public Function Count() As Long
    Count = mSessions.Count
End Function

Friend Sub Add(Item As clsNetSession, _
                    Optional ByVal Key As String)

    If Key = vbNullString Then
        mSessions.Add Item
        mSessions.Add Item, Key
    End If

End Sub

Friend Function Remove(ByVal Index As Variant)
    mSessions.Remove Index
End Function

Public Function NewEnum() As IUnknown
   Set NewEnum = mSessions.[_NewEnum]
End Function

Public Property Get BufferSize() As Long
    BufferSize = mBufferSize
End Property

Public Property Let BufferSize(NewValue As Long)
    Dim SesInf As SESSION_INFO_50
    If NewValue > Len(SesInf) Then
        mBufferSize = NewValue
        Err.Raise 380, "BufferSize", "Buffersize must be at least " & Trim(CStr(Len(SesInf))) & " bytes."
    End If
End Property

Public Property Get InfoLevel() As SessionInfoLevel
    InfoLevel = mLevel
End Property

Public Property Let InfoLevel(NewValue As SessionInfoLevel)
    Select Case NewValue
        Case SesInfLevel0, SesInfLevel10, SesInfLevel50
            mLevel = NewValue
        Case Else
            Err.Raise 380, "InfoLevel", "Level " & CStr(NewValue) & " is not a valid SessionInfo level"
    End Select
End Property

Property Get ServerName() As String
    ServerName = mServerName
End Property

Property Let ServerName(NewValue As String)
    mServerName = NewValue
    Set mSessions = New Collection
End Property

Public Sub Refresh()
    'Enumerates and returns server sessions, using current ServerName and Level property values
    Dim Result As NET_API_STATUS
    Dim Entries As Integer
    Dim Total As Integer
    Dim SesInf50 As SESSION_INFO_50
    Dim CurrentSession As clsNetSession
    Dim Buffer() As Byte
    Dim I As Long, J As Long
    Dim Key As String
    On Error Resume Next

    If mServerName = vbNullString Then Err.Raise 380, "Refresh", "Please supply a servername first"

    Set mSessions = New Collection
    ReDim Buffer(0 To BufferSize - 1)

    Result = NetSessionEnum(mServerName, mLevel, Buffer(0), mBufferSize, Entries, Total)

    If (Result = ERROR_INVALID_LEVEL) And (mLevel = 50) Then
        'Decrease info level and try again
        mLevel = 10
        Result = NetSessionEnum(mServerName, mLevel, Buffer(0), mBufferSize, Entries, Total)
    End If

    If ((Result = NERR_Success) Or (Result = ERROR_MORE_DATA)) Then
        For I = 0 To Entries - 1
            Set CurrentSession = New clsNetSession
            CurrentSession.Struct = GetSession(Buffer, I, mLevel)
            J = 0
            Key = Trim(CStr(CurrentSession.UserName))
            mSessions.Add CurrentSession, Key
            Do While Err = 457
                'Collection key already present, meaning user has multiple sessions
                J = J + 1
                'Add session count to key
                mSessions.Add CurrentSession, Key + Trim(CStr(J))
        Next I
        On Error GoTo 0
        Err.Raise Result, "NetSessionEnum", GetApiErrMsg(Result)
    End If

End Sub

' -------------------------------------
' Test code
' -------------------------------------

Dim Sessions As clsNetSessions
Set Sessions = New clsNetSessions

With Sessions
   'First set the servername property (always start with a double backslash)
   .ServerName = "\\SERVERNAME"

   'Now fill the collection with the list of active server sessions
End With

'Display the results
For Each Session In Sessions
    With Session
        Debug.Print .UserName, .ClientName, .Time
    End With
Next Session

*** code ends here ***

I know, it's a bit much but I didn't have time to strip the code downto the bare bones. It should do the trick however, so i'll leave the cleaning up to you ;-)

tdaugaardAuthor Commented:
hmm ... it is a bit much, yeah ... and I was hoping for a solution for DUN connections (as that's the only thing I have ...)
Sorry, tdaugaard, but I have never used a modem (!) - strictly LAN surfing...

You could try to use the API function "RasGetConnectionStatistics", but since I have no modem access, I can't test it myself.

Anyone else?

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

tdaugaardAuthor Commented:
Wow ... never ? Well .. I'll try look up the API you suggested..
Yes, never used a modem whatsoever...

In university I surfed the net using their T1 connection. And the company I am currently employed is in the process of upgrading from a quadruple-ISDN to an ADSL connection.

A friend of mine gave me an old 56k modem a couple a months ago, but I've never had the urge to connect it because I suspect it would be a huge disappointment compared to what I've come to expect. A high speed connection is somewhat like a remote control; you get used to and forget about it very quickly, until the day comes that you have to do without...

Besides, not having an internet connection at home is about the only thing that keeps me from becoming a totally alienated computer geek ;-)

tdaugaardAuthor Commented:
Sorry for not accepting your comment .. I've completely forgot this question :-(
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.