Solved

Get DUN og LAN connection duration time

Posted on 2001-06-11
6
220 Views
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.
0
Comment
Question by:tdaugaard
  • 3
  • 3
6 Comments
 
LVL 2

Accepted Solution

by:
WalterM earned 300 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

Public Enum NET_API_STATUS
    NERR_Success = 0&
    ERROR_ACCESS_DENIED = 5&
    ERROR_INVALID_LEVEL = 124&
    ERROR_INVALID_PARAMETER = 87&
    ERROR_NOT_ENOUGH_MEMORY = 8&
    ERROR_BAD_NETPATH = 53
    ERROR_MORE_DATA = 234
    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

Public Enum FORMAT_MESSAGE_FLAGS
    FORMAT_MESSAGE_NONE = 0
    FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF&
    FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100&
    FORMAT_MESSAGE_IGNORE_INSERTS = &H200&
    FORMAT_MESSAGE_FROM_STRING = &H400&
    FORMAT_MESSAGE_FROM_HMODULE = &H800&
    FORMAT_MESSAGE_FROM_SYSTEM = &H1000&
    FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000&
End Enum

Public Enum LOAD_LIBRARY_FLAGS
    DONT_RESOLVE_DLL_REFERENCES = &H1
    LOAD_LIBRARY_AS_DATAFILE = &H2
    LOAD_WITH_ALTERED_SEARCH_PATH = &H8
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
    Else
        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 Flags As FORMAT_MESSAGE_FLAGS
    Dim hModule As Long

    Flags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK
    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
        Loop
    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
    Else
        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
    Else
        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
                Err.Clear
                J = J + 1
                'Add session count to key
                mSessions.Add CurrentSession, Key + Trim(CStr(J))
            Loop
        Next I
    Else
        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
   .Refresh
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 ;-)

Michel
0
 

Author Comment

by:tdaugaard
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 ...)
0
 
LVL 2

Expert Comment

by:WalterM
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?

Michel
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:tdaugaard
ID: 6191855
Wow ... never ? Well .. I'll try look up the API you suggested..
0
 
LVL 2

Expert Comment

by:WalterM
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 ;-)

Michel
0
 

Author Comment

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

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

747 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now