[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now


Get DUN og LAN connection duration time

Posted on 2001-06-11
Medium Priority
Last Modified: 2008-02-01
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 www.planetsourcecode.com that would get me bytes transmitted (Tx & Rx), but it could not tell me how long the connection has been connected.
Question by:tdaugaard
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3

Accepted Solution

WalterM earned 900 total points
ID: 6182001
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 ;-)


Author Comment

ID: 6182995
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 ...)

Expert Comment

ID: 6191832
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?

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.


Author Comment

ID: 6191855
Wow ... never ? Well .. I'll try look up the API you suggested..

Expert Comment

ID: 6194338
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 ;-)


Author Comment

ID: 6284762
Sorry for not accepting your comment .. I've completely forgot this question :-(

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

656 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question