Solved

Validating Login Names from a Primary Domain Controller

Posted on 2000-02-28
9
155 Views
Last Modified: 2008-02-20
Help me out guys
I want a code to check if the person loggin in to my program is the one who has logged on to the server, checking his loggin name to make show that he is the one who is supposed to be logged on.
Just like in outlook profiles.
0
Comment
Question by:seleejane
  • 5
  • 4
9 Comments
 
LVL 43

Accepted Solution

by:
TimCottee earned 300 total points
ID: 2568159
You can use the API functions to retrieve the currently logged in NT user:

Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function WhoAmI() As String
    Dim strUserName As String * 25
    Dim intReturn As Integer
'Get the logged on user
    intReturn = GetUserName(strUserName, 25)
'Trim out the trailing null character
    strUserName = Trim(Left(strUserName, InStr(1, strUserName, Chr(0)) - 1))
'Return the user name
    WhoAmI = strUserName
End Function

You should add this to a module, you can then check at any time using

If MyAppLoggedOnUser = WhoAmI Then
    'User is ok
Else
    'User should be rejected
End If
0
 

Author Comment

by:seleejane
ID: 2568474
Ok I have tried your solution and thats the error message I get,
Constants, fixed-length, arrays, and Declare statements not allowed as public members of objects module.
Sort that out and I hope you will get the points.
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 2568485
Did you paste this in a form? if so you should change the Public Declare to Private Declare, otherwise add a "Module" to your project and paste the lot as is.
0
 

Author Comment

by:seleejane
ID: 2568928
TimCottees you are great, one more things for you to be excellent, how do I check if the person logged in belongs to a particular group, say a group of secretaries in user manager for domain.
100 more points to earn
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 43

Expert Comment

by:TimCottee
ID: 2568954
This code already posted gives you a great start, all you really need to know is the user name which I have shown you and the PDC name. You then only need to return the level 0 information and check through the returned list of groups to see whether the user is a member of the specific one you want.

http://www.mvps.org/vb/code/NetUser.zip
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 2569254
seleejane, did you download this code, if so you may be thinking "do I really need all this?" the answer is no you don't if you would like me to trim it down and paste it in a slightly more focused way for you then I would be glad to.
0
 

Author Comment

by:seleejane
ID: 2571690
Please TimCottee, I would be glad, just send me the code to see how I can check if somebody belongs to a particular group of users. For the above code I have just copied and paste it in a module and it works fine for checking who is logged on.
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 2571871
seleejane, Here is the trimmed down code, you still need a fair amount of the class code: paste this into a class module called CNetUser

Option Explicit
'
' Win32 APIs to determine OS information.
'
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
'
' Win32 NetAPIs.
'
Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
Private Declare Function NetUserGetGroups Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal pBuffer As Long) As Long

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long

Private Type USER_INFO_3_API
   ' Level 0 starts here
   Name As Long
End Type

Private Type USER_INFO_3
   ' Level 0 starts here
   Name As String
End Type

Private Type GROUP_INFO_2_API
   Name As Long
   Comment As Long
   GroupID As Long
   Attributes As Long
End Type

Private Type GROUP_INFO_2
   Name As String
   Comment As String
   GroupID As Long
   Attributes As Long
End Type

Private Const FILTER_TEMP_DUPLICATE_ACCOUNT As Long = &H1&
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2&
Private Const FILTER_PROXY_ACCOUNT As Long = &H4&
Private Const FILTER_INTERDOMAIN_TRUST_ACCOUNT As Long = &H8&
Private Const FILTER_WORKSTATION_TRUST_ACCOUNT As Long = &H10&
Private Const FILTER_SERVER_TRUST_ACCOUNT As Long = &H20&

Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const TIMEQ_FOREVER = -1&             '((unsigned long) -1L)
Private Const USER_MAXSTORAGE_UNLIMITED = -1& '((unsigned long) -1L)
Private Const USER_NO_LOGOFF = -1&            '((unsigned long) -1L)
Private Const UNITS_PER_DAY = 24
Private Const UNITS_PER_WEEK = UNITS_PER_DAY * 7

Private Const USER_PRIV_MASK = 3
Private Const USER_PRIV_GUEST = 0
Private Const USER_PRIV_USER = 1
Private Const USER_PRIV_ADMIN = 2

Private Const UNLEN = 256         ' Maximum username length
Private Const GNLEN = UNLEN       ' Maximum groupname length
Private Const CNLEN = 15          ' Maximum computer name length
Private Const MAXCOMMENTSZ = 256  ' Multipurpose comment length
Private Const LG_INCLUDE_INDIRECT As Long = &H1&

Private m_UserInfo As USER_INFO_3
Private m_UserName As String
Private m_Server As String
Private m_Groups() As String
Private m_LocalGroups() As String
Private m_IsWinNT As Boolean

' *********************************************************
'  Initialization
' *********************************************************
Private Sub Class_Initialize()
   Dim os As OSVERSIONINFO
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)
   
   If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
      m_IsWinNT = True
   End If
End Sub

' *********************************************************
'  Public Properties
' *********************************************************
Public Property Get UserName() As String
   UserName = m_UserInfo.Name
End Property

Public Property Let UserName(NewVal As String)
   m_UserName = NewVal
   Me.Refresh
End Property

Public Property Get Server() As String
   Server = m_Server
End Property

Public Property Let Server(NewVal As String)
   m_Server = NewVal
End Property

Public Property Get GroupCount() As Long
    On Error Resume Next
   GroupCount = UBound(m_Groups) + 1
End Property

Public Property Get Group(ByVal Index As Long) As String
   If Index >= LBound(m_Groups) And Index <= UBound(m_Groups) Then
      Group = m_Groups(Index)
   End If
End Property

' *********************************************************
'  Public Methods
' *********************************************************
Public Function Refresh() As Boolean
   Dim lpBuffer As Long
   Dim yUserName() As Byte
   Dim yServer() As Byte
   Dim uUserApi As USER_INFO_3_API
   Dim nRet As Long
   
   yUserName = m_UserName & vbNullChar
   If m_Server = "" Then
      nRet = NetUserGetInfo(ByVal 0&, yUserName(0), 3, lpBuffer)
   Else
      If InStr(m_Server, "\\") = 1 Then
         yServer = m_Server & vbNullChar
      Else
         yServer = "\\" & m_Server & vbNullChar
      End If
      nRet = NetUserGetInfo(yServer(0), yUserName(0), 3, lpBuffer)
   End If
   
   If nRet = NERR_Success Then
      CopyMem uUserApi, ByVal lpBuffer, Len(uUserApi)
      '
      ' Transfer data to VB structure
      '
      m_UserInfo.Name = PointerToStringW(uUserApi.Name)
      '
      ' Return success
      '
      Refresh = True
   End If
   '
   ' Clean up
   '
   If lpBuffer Then
      Call NetApiBufferFree(lpBuffer)
      RefreshGroups
   End If
End Function

Public Function NetTimeToVbTime(NetDate As Long) As Double
   Const BaseDate# = 25569   'DateSerial(1970, 1, 1)
   Const SecsPerDay# = 86400
   NetTimeToVbTime = BaseDate + (CDbl(NetDate) / SecsPerDay)
End Function

Private Sub RefreshGroups()
   Dim lpBuffer As Long
   Dim yUserName() As Byte
   Dim yServer() As Byte
   Dim lpGroups() As Long
   Dim nRead As Long
   Dim nTotal As Long
   Dim nRet As Long
   Dim i As Long
   
   yUserName = m_UserName & vbNullChar
   If m_Server = "" Then
      nRet = NetUserGetGroups(ByVal 0&, yUserName(0), 0, lpBuffer, &H4000, nRead, nTotal)
   Else
      If InStr(m_Server, "\\") = 1 Then
         yServer = m_Server & vbNullChar
      Else
         yServer = "\\" & m_Server & vbNullChar
      End If
      nRet = NetUserGetGroups(yServer(0), yUserName(0), 0, lpBuffer, &H400, nRead, nTotal)
   End If
     
   If nRet = NERR_Success Then
      ReDim lpGroups(0 To nRead - 1) As Long
      ReDim m_Groups(0 To nRead - 1) As String
      CopyMem lpGroups(0), ByVal lpBuffer, nRead * 4
      For i = 0 To nRead - 1
         m_Groups(i) = PointerToStringW(lpGroups(i))
      Next i
   End If
   '
   ' Clean up
   '
   If lpBuffer Then
      Call NetApiBufferFree(lpBuffer)
   End If
End Sub

Private Function PointerToStringW(lpStringW As Long) As String
   Dim Buffer() As Byte
   Dim nLen As Long
   
   If lpStringW Then
      nLen = lstrlenW(lpStringW) * 2
      If nLen Then
         ReDim Buffer(0 To (nLen - 1)) As Byte
         CopyMem Buffer(0), ByVal lpStringW, nLen
         PointerToStringW = Buffer
      End If
   End If
End Function

Private Function PointerToDWord(lpDWord As Long) As Long
   Dim nRet As Long
   If lpDWord Then
      CopyMem nRet, ByVal lpDWord, 4
      PointerToDWord = nRet
   End If
End Function

Then all you need is a function such as:

Public Function CheckGroup(strServerName As String, strUserName As String, strGroupToCheck As String) As Boolean
    Dim i As Integer
    Dim grps As String
    Dim blnValid As Boolean
    Dim User As CNetUser
    Set User = New CNetUser
    User.Server = strServerName
    User.UserName = strUserName
   
    For i = 0 To User.GroupCount - 1
        If strGroupToCheck = User.Group(i) Then blnValid = True
    Next i
    Set User = Nothing
    CheckGroup = blnValid
End Function

Which you can put in a module or on a form or wherever really, call it using:

blnValue = CheckGroup ("\\Server","User","Group")

The return value is True for the user being a member of the group, false if they are not.
0
 

Author Comment

by:seleejane
ID: 2576097
Error 453  "Can't find DLL entry point NetUserGetInfo in netapi32"

I have netapi32.dll availabvle but there is no entry point to the module NetUserGetInfo, I tried on a windows 95 and windows 2000 workstation, but I encountered the same error, what could be wrong
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
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…

758 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

18 Experts available now in Live!

Get 1:1 Help Now