NT Authentication within VB app


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 11 of 11

Thread: NT Authentication within VB app

  1. #1
    Amy Guest

    NT Authentication within VB app


    Can anyone tell me the API call to use to find the domain and username of
    the currently logged on user to use to authenticate wen allowing access to
    a VB app? The person before me tried to use LookupAccountName but it doesn't
    seem to be working, it's returning the machine name instead of the domain.
    Any ideas?

  2. #2
    Ajith Guest

    Re: NT Authentication within VB app


    Amy;
    You should be able to do this using NetLocalGroupGetMembers. I currently
    have posted a question reg this to the group as I had some problem converting
    Pointer to String, otherwise the complete code that I am using is listed.
    Ajith

    "Amy" <agstephens@hotmail.com> wrote:
    >
    >Can anyone tell me the API call to use to find the domain and username of
    >the currently logged on user to use to authenticate wen allowing access

    to
    >a VB app? The person before me tried to use LookupAccountName but it doesn't
    >seem to be working, it's returning the machine name instead of the domain.
    >Any ideas?



  3. #3
    Ajith Guest

    Re: NT Authentication within VB app


    Amy;
    You should be able to do this using NetLocalGroupGetMembers. I currently
    have posted a question reg this to the group as I had some problem converting
    Pointer to String, otherwise the complete code that I am using is listed.
    Ajith

    "Amy" <agstephens@hotmail.com> wrote:
    >
    >Can anyone tell me the API call to use to find the domain and username of
    >the currently logged on user to use to authenticate wen allowing access

    to
    >a VB app? The person before me tried to use LookupAccountName but it doesn't
    >seem to be working, it's returning the machine name instead of the domain.
    >Any ideas?



  4. #4
    Amy Guest

    Re: NT Authentication within VB app


    I don't think this is exactly what I'm looking for. I want to pull the domain
    and username of the current user and use that to authenticate whether or
    not they have rights to an Oracle database. If they do, the application
    opens, if they don't the application errors out.

    The way I understand NetLocalGroupGetMembers, it appears to return all group
    members within a given domain\local group right?

    "Ajith" <siponjava@hotmail.com> wrote:
    >
    >Amy;
    >You should be able to do this using NetLocalGroupGetMembers. I currently
    >have posted a question reg this to the group as I had some problem converting
    >Pointer to String, otherwise the complete code that I am using is listed.
    >Ajith
    >
    >"Amy" <agstephens@hotmail.com> wrote:
    >>
    >>Can anyone tell me the API call to use to find the domain and username

    of
    >>the currently logged on user to use to authenticate wen allowing access

    >to
    >>a VB app? The person before me tried to use LookupAccountName but it doesn't
    >>seem to be working, it's returning the machine name instead of the domain.
    >>Any ideas?

    >



  5. #5
    Amy Guest

    Re: NT Authentication within VB app


    I don't think this is exactly what I'm looking for. I want to pull the domain
    and username of the current user and use that to authenticate whether or
    not they have rights to an Oracle database. If they do, the application
    opens, if they don't the application errors out.

    The way I understand NetLocalGroupGetMembers, it appears to return all group
    members within a given domain\local group right?

    "Ajith" <siponjava@hotmail.com> wrote:
    >
    >Amy;
    >You should be able to do this using NetLocalGroupGetMembers. I currently
    >have posted a question reg this to the group as I had some problem converting
    >Pointer to String, otherwise the complete code that I am using is listed.
    >Ajith
    >
    >"Amy" <agstephens@hotmail.com> wrote:
    >>
    >>Can anyone tell me the API call to use to find the domain and username

    of
    >>the currently logged on user to use to authenticate wen allowing access

    >to
    >>a VB app? The person before me tried to use LookupAccountName but it doesn't
    >>seem to be working, it's returning the machine name instead of the domain.
    >>Any ideas?

    >



  6. #6
    Gman Guest

    Re: NT Authentication within VB app


    I believe this code should solve your problem. The GetUserName API call will
    return the user's name.

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

    Public Function GetUser() As String
    Dim sUserName As String, lSize As Long, lLength As Long
    sUserName = String(15, " ")
    lSize = Len(sUserName)
    lLength = GetUserName(sUserName, lSize)
    GetUser = Left(sUserName, lSize - 1)
    MsgBox GetUser
    End Function

    Gman

    "Amy" <agstephens@hotmail.com> wrote:
    >
    >I don't think this is exactly what I'm looking for. I want to pull the domain
    >and username of the current user and use that to authenticate whether or
    >not they have rights to an Oracle database. If they do, the application
    >opens, if they don't the application errors out.
    >
    >The way I understand NetLocalGroupGetMembers, it appears to return all group
    >members within a given domain\local group right?
    >
    >"Ajith" <siponjava@hotmail.com> wrote:
    >>
    >>Amy;
    >>You should be able to do this using NetLocalGroupGetMembers. I currently
    >>have posted a question reg this to the group as I had some problem converting
    >>Pointer to String, otherwise the complete code that I am using is listed.
    >>Ajith
    >>
    >>"Amy" <agstephens@hotmail.com> wrote:
    >>>
    >>>Can anyone tell me the API call to use to find the domain and username

    >of
    >>>the currently logged on user to use to authenticate wen allowing access

    >>to
    >>>a VB app? The person before me tried to use LookupAccountName but it doesn't
    >>>seem to be working, it's returning the machine name instead of the domain.
    >>>Any ideas?

    >>

    >



  7. #7
    Gman Guest

    Re: NT Authentication within VB app


    I believe this code should solve your problem. The GetUserName API call will
    return the user's name.

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

    Public Function GetUser() As String
    Dim sUserName As String, lSize As Long, lLength As Long
    sUserName = String(15, " ")
    lSize = Len(sUserName)
    lLength = GetUserName(sUserName, lSize)
    GetUser = Left(sUserName, lSize - 1)
    MsgBox GetUser
    End Function

    Gman

    "Amy" <agstephens@hotmail.com> wrote:
    >
    >I don't think this is exactly what I'm looking for. I want to pull the domain
    >and username of the current user and use that to authenticate whether or
    >not they have rights to an Oracle database. If they do, the application
    >opens, if they don't the application errors out.
    >
    >The way I understand NetLocalGroupGetMembers, it appears to return all group
    >members within a given domain\local group right?
    >
    >"Ajith" <siponjava@hotmail.com> wrote:
    >>
    >>Amy;
    >>You should be able to do this using NetLocalGroupGetMembers. I currently
    >>have posted a question reg this to the group as I had some problem converting
    >>Pointer to String, otherwise the complete code that I am using is listed.
    >>Ajith
    >>
    >>"Amy" <agstephens@hotmail.com> wrote:
    >>>
    >>>Can anyone tell me the API call to use to find the domain and username

    >of
    >>>the currently logged on user to use to authenticate wen allowing access

    >>to
    >>>a VB app? The person before me tried to use LookupAccountName but it doesn't
    >>>seem to be working, it's returning the machine name instead of the domain.
    >>>Any ideas?

    >>

    >



  8. #8
    sunil j Guest

    Re: NT Authentication within VB app


    hai amy
    i am pasting the code here as a class module named ..... to use in ur VB
    project.
    copy all the data in between the 2 starred lines into a notepad and save
    it as CNTUserWKstn.cls file to be used in ur VB project. go thru this class
    file in a object browser. u will find properties like domain, loggedOnuser
    etc

    regards
    sunilj
    <jsunilkumar@hotmail.com>
    *****************************************************************
    VERSION 1.0 CLASS
    BEGIN
    MultiUse = -1 'True
    Persistable = 0 'NotPersistable
    DataBindingBehavior = 0 'vbNone
    DataSourceBehavior = 0 'vbNone
    MTSTransactionMode = 0 'NotAnMTSObject
    END
    Attribute VB_Name = "CNTUserWKstn"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    ' *********************************************************
    ' Copyright (C)2000 for modifying , J. Sunil Kumar Email <jsunilkumar@hotmail.com>
    ' with than and regards to microsoft team
    ' *********************************************************
    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 NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As
    Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved
    As Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer
    As Long) As Long
    Private Declare Function NetLocalGroupGetMembers Lib "netapi32" (lpServer
    As Any, lpLocalGroup As Any, ByVal Level As Long, lpBuffer As Long, ByVal
    MaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long, vResume As
    Any) As Long

    '
    ' Data handling APIs
    '
    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 WKSTA_INFO_102
    wki102_platform_id As Long
    wki102_computername As Long
    wki102_langroup As Long
    wki102_ver_major As Long
    wki102_ver_minor As Long
    wki102_lanroot As Long
    wki102_logged_on_users As Long
    End Type

    Private Type WkstaInfo102
    PlatformId As Long
    ComputerName As String
    LanGroup As String
    VerMajor As Long
    VerMinor As Long
    LanRoot As String
    LoggedOnUsers As Long
    End Type

    Private Type WKSTA_USER_INFO_1
    wkui1_username As Long
    wkui1_logon_domain As Long
    wkui1_oth_domains As Long
    wkui1_logon_server As Long
    End Type

    Private Type WkstaUserInfo1
    UserName As String
    LogonDomain As String
    OtherDomains As String
    LogonServer As String
    End Type

    Private Type GroupMemberInfo
    UserName As String
    Attribute As Long
    End Type

    Private Type ListOfMemberGroup
    Init As Boolean
    LastErr As Long
    List() As GroupMemberInfo
    End Type

    Private Type LOCALGROUP_MEMBERS_INFO_API
    Sid As Long
    Attribute As Long
    UserName As Long
    End Type

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

    '
    ' Member variables
    '
    Private m_Wks As WkstaInfo102
    Private m_User As WkstaUserInfo1
    Private m_IsWinNT As Boolean

    ' *********************************************************
    ' Initialization
    ' *********************************************************
    Private Sub Class_Initialize()
    Dim os As OSVERSIONINFO
    '
    ' Check to make sure we're running NT!
    '
    os.dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    m_IsWinNT = True
    Me.Refresh
    End If
    End Sub

    ' *********************************************************
    ' Public Properties (Workstation)
    ' *********************************************************
    Public Property Get ComputerName() As String
    ComputerName = m_Wks.ComputerName
    End Property

    Public Property Get Domain() As String
    Domain = m_Wks.LanGroup
    End Property

    Public Property Get LanRoot() As String
    LanRoot = m_Wks.LanRoot
    End Property

    Public Property Get LoggedOnUsers() As Long
    LoggedOnUsers = m_Wks.LoggedOnUsers
    End Property

    Public Property Get PlatformId() As Long
    PlatformId = m_Wks.PlatformId
    End Property

    Public Property Get VerMajor() As Long
    VerMajor = m_Wks.VerMajor
    End Property

    Public Property Get VerMinor() As Long
    VerMinor = m_Wks.VerMinor
    End Property

    ' *********************************************************
    ' Public Properties (Workstation User)
    ' *********************************************************
    Public Property Get LogonDomain() As String
    LogonDomain = m_User.LogonDomain
    End Property

    Public Property Get LogonServer() As String
    LogonServer = m_User.LogonServer
    End Property

    Public Property Get OtherDomains() As String
    OtherDomains = m_User.OtherDomains
    End Property

    Public Property Get UserName() As String
    UserName = m_User.UserName
    End Property

    ' *********************************************************
    ' Public Methods
    ' *********************************************************
    Public Sub Refresh()
    Dim lpBuffer As Long
    Dim nRet As Long
    Dim wki As WKSTA_INFO_102
    Dim wkui As WKSTA_USER_INFO_1
    '
    ' These functions only exist in Windows NT!!!
    '
    If Not m_IsWinNT Then Exit Sub
    '
    ' Obtain workstation information
    '
    nRet = NetWkstaGetInfo(ByVal 0&, 102&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wki, ByVal lpBuffer, Len(wki)
    m_Wks.PlatformId = wki.wki102_platform_id
    m_Wks.ComputerName = PointerToStringW(wki.wki102_computername)
    m_Wks.LanGroup = PointerToStringW(wki.wki102_langroup)
    m_Wks.VerMajor = wki.wki102_ver_major
    m_Wks.VerMinor = wki.wki102_ver_minor
    m_Wks.LanRoot = PointerToStringW(wki.wki102_lanroot)
    m_Wks.LoggedOnUsers = wki.wki102_logged_on_users
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    '
    ' Obtain user information for this workstation
    '
    nRet = NetWkstaUserGetInfo(0&, 1&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wkui, ByVal lpBuffer, Len(wkui)
    m_User.UserName = PointerToStringW(wkui.wkui1_username)
    m_User.LogonDomain = PointerToStringW(wkui.wkui1_logon_domain)
    m_User.OtherDomains = PointerToStringW(wkui.wkui1_oth_domains)
    m_User.LogonServer = PointerToStringW(wkui.wkui1_logon_server)
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    End Sub

    ' *********************************************************
    ' Private Methods
    ' *********************************************************
    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

    'Ritorna un elenco dei membri di un gruppo locale
    'Uses the win api functions to retrieve list of local groups a user belongs
    Private Function LocalGroupsGetMember(Server As String, Group As String)
    As ListOfMemberGroup
    Dim yServer() As Byte
    Dim yGroup() As Byte
    Dim lRetCode As Long
    Dim nRead As Long, nTotal As Long
    Dim nRet As Long, nResume As Long
    Dim PrefMaxLen As Long
    Dim i As Long, x As Long
    Dim tGroupInfo As LOCALGROUP_MEMBERS_INFO_API
    Dim lGroupInfo As Long
    Dim lGroupInfoPtr As Long
    Dim GroupInfo As GroupMemberInfo
    Dim GrpList As ListOfMemberGroup

    yServer = MakeServerName(ByVal Server)
    yGroup = Group & vbNullChar
    PrefMaxLen = 65536

    nRet = NERR_MoreData
    Do While (nRet = NERR_MoreData)

    nRet = NetLocalGroupGetMembers(yServer(0), yGroup(0), 1, lGroupInfo,
    PrefMaxLen, nRead, nTotal, nResume)

    If (nRet <> NERR_Success And _
    nRet <> NERR_MoreData) Then
    GrpList.Init = False
    GrpList.LastErr = nRet
    Exit Do
    End If

    lGroupInfoPtr = lGroupInfo

    x = 1
    Do While x <= nRead

    CopyMem tGroupInfo, ByVal lGroupInfoPtr, Len(tGroupInfo)

    GroupInfo.UserName = PointerToStringW(tGroupInfo.UserName)
    'If GroupInfo.UserName = "sunil" Then MsgBox GroupInfo.UserName
    GroupInfo.Attribute = tGroupInfo.Attribute
    i = i + 1
    ReDim Preserve GrpList.List(1 To i) As GroupMemberInfo
    GrpList.List(i) = GroupInfo
    x = x + 1

    lGroupInfoPtr = lGroupInfoPtr + Len(tGroupInfo)

    Loop

    lRetCode = NetApiBufferFree(lGroupInfo)
    GrpList.Init = (x > 1)

    Loop

    LocalGroupsGetMember = GrpList

    End Function

    'Used by the private function LocalGroupsGetMember
    Private Function MakeServerName(ByVal ServerName As String)
    Dim yServer() As Byte

    If ServerName <> "" Then
    If InStr(1, ServerName, "\\") = 0 Then
    ServerName = "\\" & ServerName
    End If
    End If

    yServer = ServerName & vbNullChar
    MakeServerName = yServer

    End Function


    ' *********************************************************
    ' Public Methods
    ' Pass the name of group as input string
    ' returns True if current user is in the group specified as in parameter
    ' else returns False
    ' *********************************************************

    Public Function CheckCurrentUserInGroup(GrpItem As String) As Boolean

    Dim GrpList As ListOfMemberGroup
    Dim i As Integer

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpItem)

    'if the grplist is not initilised ie., no corresponding entries then exit
    If GrpList.Init = False Then

    CheckCurrentUserInGroup = False

    Else

    For i = 1 To UBound(GrpList.List)
    'if user and group match then return true and exit
    If UserName = GrpList.List(i).UserName Then
    CheckCurrentUserInGroup = True
    Exit Function
    Else
    CheckCurrentUserInGroup = False
    End If
    Next

    End If

    End Function

    ' *********************************************************
    ' Public Methods
    ' returns a string array of groups to which the user belongs
    ' *********************************************************

    Public Function UsersInGroup(ByVal GrpName As String) As String()
    Dim GrpList As ListOfMemberGroup
    Dim i As Integer, aUser() As String

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpName)

    'if the grplist is not initilised ie., no corresponding entries.
    If GrpList.Init = False Then
    UsersInGroup = aUser()
    Else
    ReDim aUser(1 To UBound(GrpList.List))
    For i = 1 To UBound(GrpList.List)
    aUser(i) = GrpList.List(i).UserName
    Next
    UsersInGroup = aUser()
    End If

    End Function


    *****************************************************************


    "Amy" <agstephens@hotmail.com> wrote:
    >
    >Can anyone tell me the API call to use to find the domain and username of
    >the currently logged on user to use to authenticate wen allowing access

    to
    >a VB app? The person before me tried to use LookupAccountName but it doesn't
    >seem to be working, it's returning the machine name instead of the domain.
    >Any ideas?



  9. #9
    sunil j Guest

    Re: NT Authentication within VB app


    hai amy
    i am pasting the code here as a class module named ..... to use in ur VB
    project.
    copy all the data in between the 2 starred lines into a notepad and save
    it as CNTUserWKstn.cls file to be used in ur VB project. go thru this class
    file in a object browser. u will find properties like domain, loggedOnuser
    etc

    regards
    sunilj
    <jsunilkumar@hotmail.com>
    *****************************************************************
    VERSION 1.0 CLASS
    BEGIN
    MultiUse = -1 'True
    Persistable = 0 'NotPersistable
    DataBindingBehavior = 0 'vbNone
    DataSourceBehavior = 0 'vbNone
    MTSTransactionMode = 0 'NotAnMTSObject
    END
    Attribute VB_Name = "CNTUserWKstn"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    ' *********************************************************
    ' Copyright (C)2000 for modifying , J. Sunil Kumar Email <jsunilkumar@hotmail.com>
    ' with than and regards to microsoft team
    ' *********************************************************
    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 NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As
    Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved
    As Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer
    As Long) As Long
    Private Declare Function NetLocalGroupGetMembers Lib "netapi32" (lpServer
    As Any, lpLocalGroup As Any, ByVal Level As Long, lpBuffer As Long, ByVal
    MaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long, vResume As
    Any) As Long

    '
    ' Data handling APIs
    '
    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 WKSTA_INFO_102
    wki102_platform_id As Long
    wki102_computername As Long
    wki102_langroup As Long
    wki102_ver_major As Long
    wki102_ver_minor As Long
    wki102_lanroot As Long
    wki102_logged_on_users As Long
    End Type

    Private Type WkstaInfo102
    PlatformId As Long
    ComputerName As String
    LanGroup As String
    VerMajor As Long
    VerMinor As Long
    LanRoot As String
    LoggedOnUsers As Long
    End Type

    Private Type WKSTA_USER_INFO_1
    wkui1_username As Long
    wkui1_logon_domain As Long
    wkui1_oth_domains As Long
    wkui1_logon_server As Long
    End Type

    Private Type WkstaUserInfo1
    UserName As String
    LogonDomain As String
    OtherDomains As String
    LogonServer As String
    End Type

    Private Type GroupMemberInfo
    UserName As String
    Attribute As Long
    End Type

    Private Type ListOfMemberGroup
    Init As Boolean
    LastErr As Long
    List() As GroupMemberInfo
    End Type

    Private Type LOCALGROUP_MEMBERS_INFO_API
    Sid As Long
    Attribute As Long
    UserName As Long
    End Type

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

    '
    ' Member variables
    '
    Private m_Wks As WkstaInfo102
    Private m_User As WkstaUserInfo1
    Private m_IsWinNT As Boolean

    ' *********************************************************
    ' Initialization
    ' *********************************************************
    Private Sub Class_Initialize()
    Dim os As OSVERSIONINFO
    '
    ' Check to make sure we're running NT!
    '
    os.dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    m_IsWinNT = True
    Me.Refresh
    End If
    End Sub

    ' *********************************************************
    ' Public Properties (Workstation)
    ' *********************************************************
    Public Property Get ComputerName() As String
    ComputerName = m_Wks.ComputerName
    End Property

    Public Property Get Domain() As String
    Domain = m_Wks.LanGroup
    End Property

    Public Property Get LanRoot() As String
    LanRoot = m_Wks.LanRoot
    End Property

    Public Property Get LoggedOnUsers() As Long
    LoggedOnUsers = m_Wks.LoggedOnUsers
    End Property

    Public Property Get PlatformId() As Long
    PlatformId = m_Wks.PlatformId
    End Property

    Public Property Get VerMajor() As Long
    VerMajor = m_Wks.VerMajor
    End Property

    Public Property Get VerMinor() As Long
    VerMinor = m_Wks.VerMinor
    End Property

    ' *********************************************************
    ' Public Properties (Workstation User)
    ' *********************************************************
    Public Property Get LogonDomain() As String
    LogonDomain = m_User.LogonDomain
    End Property

    Public Property Get LogonServer() As String
    LogonServer = m_User.LogonServer
    End Property

    Public Property Get OtherDomains() As String
    OtherDomains = m_User.OtherDomains
    End Property

    Public Property Get UserName() As String
    UserName = m_User.UserName
    End Property

    ' *********************************************************
    ' Public Methods
    ' *********************************************************
    Public Sub Refresh()
    Dim lpBuffer As Long
    Dim nRet As Long
    Dim wki As WKSTA_INFO_102
    Dim wkui As WKSTA_USER_INFO_1
    '
    ' These functions only exist in Windows NT!!!
    '
    If Not m_IsWinNT Then Exit Sub
    '
    ' Obtain workstation information
    '
    nRet = NetWkstaGetInfo(ByVal 0&, 102&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wki, ByVal lpBuffer, Len(wki)
    m_Wks.PlatformId = wki.wki102_platform_id
    m_Wks.ComputerName = PointerToStringW(wki.wki102_computername)
    m_Wks.LanGroup = PointerToStringW(wki.wki102_langroup)
    m_Wks.VerMajor = wki.wki102_ver_major
    m_Wks.VerMinor = wki.wki102_ver_minor
    m_Wks.LanRoot = PointerToStringW(wki.wki102_lanroot)
    m_Wks.LoggedOnUsers = wki.wki102_logged_on_users
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    '
    ' Obtain user information for this workstation
    '
    nRet = NetWkstaUserGetInfo(0&, 1&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wkui, ByVal lpBuffer, Len(wkui)
    m_User.UserName = PointerToStringW(wkui.wkui1_username)
    m_User.LogonDomain = PointerToStringW(wkui.wkui1_logon_domain)
    m_User.OtherDomains = PointerToStringW(wkui.wkui1_oth_domains)
    m_User.LogonServer = PointerToStringW(wkui.wkui1_logon_server)
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    End Sub

    ' *********************************************************
    ' Private Methods
    ' *********************************************************
    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

    'Ritorna un elenco dei membri di un gruppo locale
    'Uses the win api functions to retrieve list of local groups a user belongs
    Private Function LocalGroupsGetMember(Server As String, Group As String)
    As ListOfMemberGroup
    Dim yServer() As Byte
    Dim yGroup() As Byte
    Dim lRetCode As Long
    Dim nRead As Long, nTotal As Long
    Dim nRet As Long, nResume As Long
    Dim PrefMaxLen As Long
    Dim i As Long, x As Long
    Dim tGroupInfo As LOCALGROUP_MEMBERS_INFO_API
    Dim lGroupInfo As Long
    Dim lGroupInfoPtr As Long
    Dim GroupInfo As GroupMemberInfo
    Dim GrpList As ListOfMemberGroup

    yServer = MakeServerName(ByVal Server)
    yGroup = Group & vbNullChar
    PrefMaxLen = 65536

    nRet = NERR_MoreData
    Do While (nRet = NERR_MoreData)

    nRet = NetLocalGroupGetMembers(yServer(0), yGroup(0), 1, lGroupInfo,
    PrefMaxLen, nRead, nTotal, nResume)

    If (nRet <> NERR_Success And _
    nRet <> NERR_MoreData) Then
    GrpList.Init = False
    GrpList.LastErr = nRet
    Exit Do
    End If

    lGroupInfoPtr = lGroupInfo

    x = 1
    Do While x <= nRead

    CopyMem tGroupInfo, ByVal lGroupInfoPtr, Len(tGroupInfo)

    GroupInfo.UserName = PointerToStringW(tGroupInfo.UserName)
    'If GroupInfo.UserName = "sunil" Then MsgBox GroupInfo.UserName
    GroupInfo.Attribute = tGroupInfo.Attribute
    i = i + 1
    ReDim Preserve GrpList.List(1 To i) As GroupMemberInfo
    GrpList.List(i) = GroupInfo
    x = x + 1

    lGroupInfoPtr = lGroupInfoPtr + Len(tGroupInfo)

    Loop

    lRetCode = NetApiBufferFree(lGroupInfo)
    GrpList.Init = (x > 1)

    Loop

    LocalGroupsGetMember = GrpList

    End Function

    'Used by the private function LocalGroupsGetMember
    Private Function MakeServerName(ByVal ServerName As String)
    Dim yServer() As Byte

    If ServerName <> "" Then
    If InStr(1, ServerName, "\\") = 0 Then
    ServerName = "\\" & ServerName
    End If
    End If

    yServer = ServerName & vbNullChar
    MakeServerName = yServer

    End Function


    ' *********************************************************
    ' Public Methods
    ' Pass the name of group as input string
    ' returns True if current user is in the group specified as in parameter
    ' else returns False
    ' *********************************************************

    Public Function CheckCurrentUserInGroup(GrpItem As String) As Boolean

    Dim GrpList As ListOfMemberGroup
    Dim i As Integer

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpItem)

    'if the grplist is not initilised ie., no corresponding entries then exit
    If GrpList.Init = False Then

    CheckCurrentUserInGroup = False

    Else

    For i = 1 To UBound(GrpList.List)
    'if user and group match then return true and exit
    If UserName = GrpList.List(i).UserName Then
    CheckCurrentUserInGroup = True
    Exit Function
    Else
    CheckCurrentUserInGroup = False
    End If
    Next

    End If

    End Function

    ' *********************************************************
    ' Public Methods
    ' returns a string array of groups to which the user belongs
    ' *********************************************************

    Public Function UsersInGroup(ByVal GrpName As String) As String()
    Dim GrpList As ListOfMemberGroup
    Dim i As Integer, aUser() As String

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpName)

    'if the grplist is not initilised ie., no corresponding entries.
    If GrpList.Init = False Then
    UsersInGroup = aUser()
    Else
    ReDim aUser(1 To UBound(GrpList.List))
    For i = 1 To UBound(GrpList.List)
    aUser(i) = GrpList.List(i).UserName
    Next
    UsersInGroup = aUser()
    End If

    End Function


    *****************************************************************


    "Amy" <agstephens@hotmail.com> wrote:
    >
    >Can anyone tell me the API call to use to find the domain and username of
    >the currently logged on user to use to authenticate wen allowing access

    to
    >a VB app? The person before me tried to use LookupAccountName but it doesn't
    >seem to be working, it's returning the machine name instead of the domain.
    >Any ideas?



  10. #10
    sunil j Guest

    Re: NT Authentication within VB app


    hai amy <agstephens@hotmail.com>
    i am pasting the code here as a class module named ..... to use in ur VB
    project.
    copy all the data in between the 2 starred lines into a notepad and save
    it as CNTUserWKstn.cls file to be used in ur VB project. go thru this class
    file in a object browser. u will find properties like domain, loggedOnuser
    etc

    regards
    sunilj
    <jsunilkumar@hotmail.com>
    *****************************************************************
    VERSION 1.0 CLASS
    BEGIN
    MultiUse = -1 'True
    Persistable = 0 'NotPersistable
    DataBindingBehavior = 0 'vbNone
    DataSourceBehavior = 0 'vbNone
    MTSTransactionMode = 0 'NotAnMTSObject
    END
    Attribute VB_Name = "CNTUserWKstn"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    ' *********************************************************
    ' Copyright (C)2000 for modifying , J. Sunil Kumar Email <jsunilkumar@hotmail.com>
    ' with than and regards to microsoft team
    ' *********************************************************
    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 NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As
    Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved
    As Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer
    As Long) As Long
    Private Declare Function NetLocalGroupGetMembers Lib "netapi32" (lpServer
    As Any, lpLocalGroup As Any, ByVal Level As Long, lpBuffer As Long, ByVal
    MaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long, vResume As
    Any) As Long

    '
    ' Data handling APIs
    '
    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 WKSTA_INFO_102
    wki102_platform_id As Long
    wki102_computername As Long
    wki102_langroup As Long
    wki102_ver_major As Long
    wki102_ver_minor As Long
    wki102_lanroot As Long
    wki102_logged_on_users As Long
    End Type

    Private Type WkstaInfo102
    PlatformId As Long
    ComputerName As String
    LanGroup As String
    VerMajor As Long
    VerMinor As Long
    LanRoot As String
    LoggedOnUsers As Long
    End Type

    Private Type WKSTA_USER_INFO_1
    wkui1_username As Long
    wkui1_logon_domain As Long
    wkui1_oth_domains As Long
    wkui1_logon_server As Long
    End Type

    Private Type WkstaUserInfo1
    UserName As String
    LogonDomain As String
    OtherDomains As String
    LogonServer As String
    End Type

    Private Type GroupMemberInfo
    UserName As String
    Attribute As Long
    End Type

    Private Type ListOfMemberGroup
    Init As Boolean
    LastErr As Long
    List() As GroupMemberInfo
    End Type

    Private Type LOCALGROUP_MEMBERS_INFO_API
    Sid As Long
    Attribute As Long
    UserName As Long
    End Type

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

    '
    ' Member variables
    '
    Private m_Wks As WkstaInfo102
    Private m_User As WkstaUserInfo1
    Private m_IsWinNT As Boolean

    ' *********************************************************
    ' Initialization
    ' *********************************************************
    Private Sub Class_Initialize()
    Dim os As OSVERSIONINFO
    '
    ' Check to make sure we're running NT!
    '
    os.dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    m_IsWinNT = True
    Me.Refresh
    End If
    End Sub

    ' *********************************************************
    ' Public Properties (Workstation)
    ' *********************************************************
    Public Property Get ComputerName() As String
    ComputerName = m_Wks.ComputerName
    End Property

    Public Property Get Domain() As String
    Domain = m_Wks.LanGroup
    End Property

    Public Property Get LanRoot() As String
    LanRoot = m_Wks.LanRoot
    End Property

    Public Property Get LoggedOnUsers() As Long
    LoggedOnUsers = m_Wks.LoggedOnUsers
    End Property

    Public Property Get PlatformId() As Long
    PlatformId = m_Wks.PlatformId
    End Property

    Public Property Get VerMajor() As Long
    VerMajor = m_Wks.VerMajor
    End Property

    Public Property Get VerMinor() As Long
    VerMinor = m_Wks.VerMinor
    End Property

    ' *********************************************************
    ' Public Properties (Workstation User)
    ' *********************************************************
    Public Property Get LogonDomain() As String
    LogonDomain = m_User.LogonDomain
    End Property

    Public Property Get LogonServer() As String
    LogonServer = m_User.LogonServer
    End Property

    Public Property Get OtherDomains() As String
    OtherDomains = m_User.OtherDomains
    End Property

    Public Property Get UserName() As String
    UserName = m_User.UserName
    End Property

    ' *********************************************************
    ' Public Methods
    ' *********************************************************
    Public Sub Refresh()
    Dim lpBuffer As Long
    Dim nRet As Long
    Dim wki As WKSTA_INFO_102
    Dim wkui As WKSTA_USER_INFO_1
    '
    ' These functions only exist in Windows NT!!!
    '
    If Not m_IsWinNT Then Exit Sub
    '
    ' Obtain workstation information
    '
    nRet = NetWkstaGetInfo(ByVal 0&, 102&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wki, ByVal lpBuffer, Len(wki)
    m_Wks.PlatformId = wki.wki102_platform_id
    m_Wks.ComputerName = PointerToStringW(wki.wki102_computername)
    m_Wks.LanGroup = PointerToStringW(wki.wki102_langroup)
    m_Wks.VerMajor = wki.wki102_ver_major
    m_Wks.VerMinor = wki.wki102_ver_minor
    m_Wks.LanRoot = PointerToStringW(wki.wki102_lanroot)
    m_Wks.LoggedOnUsers = wki.wki102_logged_on_users
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    '
    ' Obtain user information for this workstation
    '
    nRet = NetWkstaUserGetInfo(0&, 1&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wkui, ByVal lpBuffer, Len(wkui)
    m_User.UserName = PointerToStringW(wkui.wkui1_username)
    m_User.LogonDomain = PointerToStringW(wkui.wkui1_logon_domain)
    m_User.OtherDomains = PointerToStringW(wkui.wkui1_oth_domains)
    m_User.LogonServer = PointerToStringW(wkui.wkui1_logon_server)
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    End Sub

    ' *********************************************************
    ' Private Methods
    ' *********************************************************
    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

    'Ritorna un elenco dei membri di un gruppo locale
    'Uses the win api functions to retrieve list of local groups a user belongs
    Private Function LocalGroupsGetMember(Server As String, Group As String)
    As ListOfMemberGroup
    Dim yServer() As Byte
    Dim yGroup() As Byte
    Dim lRetCode As Long
    Dim nRead As Long, nTotal As Long
    Dim nRet As Long, nResume As Long
    Dim PrefMaxLen As Long
    Dim i As Long, x As Long
    Dim tGroupInfo As LOCALGROUP_MEMBERS_INFO_API
    Dim lGroupInfo As Long
    Dim lGroupInfoPtr As Long
    Dim GroupInfo As GroupMemberInfo
    Dim GrpList As ListOfMemberGroup

    yServer = MakeServerName(ByVal Server)
    yGroup = Group & vbNullChar
    PrefMaxLen = 65536

    nRet = NERR_MoreData
    Do While (nRet = NERR_MoreData)

    nRet = NetLocalGroupGetMembers(yServer(0), yGroup(0), 1, lGroupInfo,
    PrefMaxLen, nRead, nTotal, nResume)

    If (nRet <> NERR_Success And _
    nRet <> NERR_MoreData) Then
    GrpList.Init = False
    GrpList.LastErr = nRet
    Exit Do
    End If

    lGroupInfoPtr = lGroupInfo

    x = 1
    Do While x <= nRead

    CopyMem tGroupInfo, ByVal lGroupInfoPtr, Len(tGroupInfo)

    GroupInfo.UserName = PointerToStringW(tGroupInfo.UserName)
    'If GroupInfo.UserName = "sunil" Then MsgBox GroupInfo.UserName
    GroupInfo.Attribute = tGroupInfo.Attribute
    i = i + 1
    ReDim Preserve GrpList.List(1 To i) As GroupMemberInfo
    GrpList.List(i) = GroupInfo
    x = x + 1

    lGroupInfoPtr = lGroupInfoPtr + Len(tGroupInfo)

    Loop

    lRetCode = NetApiBufferFree(lGroupInfo)
    GrpList.Init = (x > 1)

    Loop

    LocalGroupsGetMember = GrpList

    End Function

    'Used by the private function LocalGroupsGetMember
    Private Function MakeServerName(ByVal ServerName As String)
    Dim yServer() As Byte

    If ServerName <> "" Then
    If InStr(1, ServerName, "\\") = 0 Then
    ServerName = "\\" & ServerName
    End If
    End If

    yServer = ServerName & vbNullChar
    MakeServerName = yServer

    End Function


    ' *********************************************************
    ' Public Methods
    ' Pass the name of group as input string
    ' returns True if current user is in the group specified as in parameter
    ' else returns False
    ' *********************************************************

    Public Function CheckCurrentUserInGroup(GrpItem As String) As Boolean

    Dim GrpList As ListOfMemberGroup
    Dim i As Integer

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpItem)

    'if the grplist is not initilised ie., no corresponding entries then exit
    If GrpList.Init = False Then

    CheckCurrentUserInGroup = False

    Else

    For i = 1 To UBound(GrpList.List)
    'if user and group match then return true and exit
    If UserName = GrpList.List(i).UserName Then
    CheckCurrentUserInGroup = True
    Exit Function
    Else
    CheckCurrentUserInGroup = False
    End If
    Next

    End If

    End Function

    ' *********************************************************
    ' Public Methods
    ' returns a string array of groups to which the user belongs
    ' *********************************************************

    Public Function UsersInGroup(ByVal GrpName As String) As String()
    Dim GrpList As ListOfMemberGroup
    Dim i As Integer, aUser() As String

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpName)

    'if the grplist is not initilised ie., no corresponding entries.
    If GrpList.Init = False Then
    UsersInGroup = aUser()
    Else
    ReDim aUser(1 To UBound(GrpList.List))
    For i = 1 To UBound(GrpList.List)
    aUser(i) = GrpList.List(i).UserName
    Next
    UsersInGroup = aUser()
    End If

    End Function


    *****************************************************************


    "Amy" <agstephens@hotmail.com> wrote:
    >
    >Can anyone tell me the API call to use to find the domain and username of
    >the currently logged on user to use to authenticate wen allowing access

    to
    >a VB app? The person before me tried to use LookupAccountName but it doesn't
    >seem to be working, it's returning the machine name instead of the domain.
    >Any ideas?



  11. #11
    sunil j Guest

    Re: NT Authentication within VB app


    hai amy <agstephens@hotmail.com>
    i am pasting the code here as a class module named ..... to use in ur VB
    project.
    copy all the data in between the 2 starred lines into a notepad and save
    it as CNTUserWKstn.cls file to be used in ur VB project. go thru this class
    file in a object browser. u will find properties like domain, loggedOnuser
    etc

    regards
    sunilj
    <jsunilkumar@hotmail.com>
    *****************************************************************
    VERSION 1.0 CLASS
    BEGIN
    MultiUse = -1 'True
    Persistable = 0 'NotPersistable
    DataBindingBehavior = 0 'vbNone
    DataSourceBehavior = 0 'vbNone
    MTSTransactionMode = 0 'NotAnMTSObject
    END
    Attribute VB_Name = "CNTUserWKstn"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = True
    Attribute VB_PredeclaredId = False
    Attribute VB_Exposed = False
    ' *********************************************************
    ' Copyright (C)2000 for modifying , J. Sunil Kumar Email <jsunilkumar@hotmail.com>
    ' with than and regards to microsoft team
    ' *********************************************************
    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 NetWkstaGetInfo Lib "Netapi32.dll" (lpServer As
    Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetWkstaUserGetInfo Lib "Netapi32.dll" (ByVal reserved
    As Any, ByVal Level As Long, lpBuffer As Any) As Long
    Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer
    As Long) As Long
    Private Declare Function NetLocalGroupGetMembers Lib "netapi32" (lpServer
    As Any, lpLocalGroup As Any, ByVal Level As Long, lpBuffer As Long, ByVal
    MaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long, vResume As
    Any) As Long

    '
    ' Data handling APIs
    '
    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 WKSTA_INFO_102
    wki102_platform_id As Long
    wki102_computername As Long
    wki102_langroup As Long
    wki102_ver_major As Long
    wki102_ver_minor As Long
    wki102_lanroot As Long
    wki102_logged_on_users As Long
    End Type

    Private Type WkstaInfo102
    PlatformId As Long
    ComputerName As String
    LanGroup As String
    VerMajor As Long
    VerMinor As Long
    LanRoot As String
    LoggedOnUsers As Long
    End Type

    Private Type WKSTA_USER_INFO_1
    wkui1_username As Long
    wkui1_logon_domain As Long
    wkui1_oth_domains As Long
    wkui1_logon_server As Long
    End Type

    Private Type WkstaUserInfo1
    UserName As String
    LogonDomain As String
    OtherDomains As String
    LogonServer As String
    End Type

    Private Type GroupMemberInfo
    UserName As String
    Attribute As Long
    End Type

    Private Type ListOfMemberGroup
    Init As Boolean
    LastErr As Long
    List() As GroupMemberInfo
    End Type

    Private Type LOCALGROUP_MEMBERS_INFO_API
    Sid As Long
    Attribute As Long
    UserName As Long
    End Type

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

    '
    ' Member variables
    '
    Private m_Wks As WkstaInfo102
    Private m_User As WkstaUserInfo1
    Private m_IsWinNT As Boolean

    ' *********************************************************
    ' Initialization
    ' *********************************************************
    Private Sub Class_Initialize()
    Dim os As OSVERSIONINFO
    '
    ' Check to make sure we're running NT!
    '
    os.dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
    If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    m_IsWinNT = True
    Me.Refresh
    End If
    End Sub

    ' *********************************************************
    ' Public Properties (Workstation)
    ' *********************************************************
    Public Property Get ComputerName() As String
    ComputerName = m_Wks.ComputerName
    End Property

    Public Property Get Domain() As String
    Domain = m_Wks.LanGroup
    End Property

    Public Property Get LanRoot() As String
    LanRoot = m_Wks.LanRoot
    End Property

    Public Property Get LoggedOnUsers() As Long
    LoggedOnUsers = m_Wks.LoggedOnUsers
    End Property

    Public Property Get PlatformId() As Long
    PlatformId = m_Wks.PlatformId
    End Property

    Public Property Get VerMajor() As Long
    VerMajor = m_Wks.VerMajor
    End Property

    Public Property Get VerMinor() As Long
    VerMinor = m_Wks.VerMinor
    End Property

    ' *********************************************************
    ' Public Properties (Workstation User)
    ' *********************************************************
    Public Property Get LogonDomain() As String
    LogonDomain = m_User.LogonDomain
    End Property

    Public Property Get LogonServer() As String
    LogonServer = m_User.LogonServer
    End Property

    Public Property Get OtherDomains() As String
    OtherDomains = m_User.OtherDomains
    End Property

    Public Property Get UserName() As String
    UserName = m_User.UserName
    End Property

    ' *********************************************************
    ' Public Methods
    ' *********************************************************
    Public Sub Refresh()
    Dim lpBuffer As Long
    Dim nRet As Long
    Dim wki As WKSTA_INFO_102
    Dim wkui As WKSTA_USER_INFO_1
    '
    ' These functions only exist in Windows NT!!!
    '
    If Not m_IsWinNT Then Exit Sub
    '
    ' Obtain workstation information
    '
    nRet = NetWkstaGetInfo(ByVal 0&, 102&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wki, ByVal lpBuffer, Len(wki)
    m_Wks.PlatformId = wki.wki102_platform_id
    m_Wks.ComputerName = PointerToStringW(wki.wki102_computername)
    m_Wks.LanGroup = PointerToStringW(wki.wki102_langroup)
    m_Wks.VerMajor = wki.wki102_ver_major
    m_Wks.VerMinor = wki.wki102_ver_minor
    m_Wks.LanRoot = PointerToStringW(wki.wki102_lanroot)
    m_Wks.LoggedOnUsers = wki.wki102_logged_on_users
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    '
    ' Obtain user information for this workstation
    '
    nRet = NetWkstaUserGetInfo(0&, 1&, lpBuffer)
    If nRet = NERR_Success Then
    '
    ' Transfer data to VB-friendly structure
    '
    CopyMem wkui, ByVal lpBuffer, Len(wkui)
    m_User.UserName = PointerToStringW(wkui.wkui1_username)
    m_User.LogonDomain = PointerToStringW(wkui.wkui1_logon_domain)
    m_User.OtherDomains = PointerToStringW(wkui.wkui1_oth_domains)
    m_User.LogonServer = PointerToStringW(wkui.wkui1_logon_server)
    '
    ' Clean up
    '
    If lpBuffer Then
    Call NetApiBufferFree(lpBuffer)
    End If
    End If
    End Sub

    ' *********************************************************
    ' Private Methods
    ' *********************************************************
    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

    'Ritorna un elenco dei membri di un gruppo locale
    'Uses the win api functions to retrieve list of local groups a user belongs
    Private Function LocalGroupsGetMember(Server As String, Group As String)
    As ListOfMemberGroup
    Dim yServer() As Byte
    Dim yGroup() As Byte
    Dim lRetCode As Long
    Dim nRead As Long, nTotal As Long
    Dim nRet As Long, nResume As Long
    Dim PrefMaxLen As Long
    Dim i As Long, x As Long
    Dim tGroupInfo As LOCALGROUP_MEMBERS_INFO_API
    Dim lGroupInfo As Long
    Dim lGroupInfoPtr As Long
    Dim GroupInfo As GroupMemberInfo
    Dim GrpList As ListOfMemberGroup

    yServer = MakeServerName(ByVal Server)
    yGroup = Group & vbNullChar
    PrefMaxLen = 65536

    nRet = NERR_MoreData
    Do While (nRet = NERR_MoreData)

    nRet = NetLocalGroupGetMembers(yServer(0), yGroup(0), 1, lGroupInfo,
    PrefMaxLen, nRead, nTotal, nResume)

    If (nRet <> NERR_Success And _
    nRet <> NERR_MoreData) Then
    GrpList.Init = False
    GrpList.LastErr = nRet
    Exit Do
    End If

    lGroupInfoPtr = lGroupInfo

    x = 1
    Do While x <= nRead

    CopyMem tGroupInfo, ByVal lGroupInfoPtr, Len(tGroupInfo)

    GroupInfo.UserName = PointerToStringW(tGroupInfo.UserName)
    'If GroupInfo.UserName = "sunil" Then MsgBox GroupInfo.UserName
    GroupInfo.Attribute = tGroupInfo.Attribute
    i = i + 1
    ReDim Preserve GrpList.List(1 To i) As GroupMemberInfo
    GrpList.List(i) = GroupInfo
    x = x + 1

    lGroupInfoPtr = lGroupInfoPtr + Len(tGroupInfo)

    Loop

    lRetCode = NetApiBufferFree(lGroupInfo)
    GrpList.Init = (x > 1)

    Loop

    LocalGroupsGetMember = GrpList

    End Function

    'Used by the private function LocalGroupsGetMember
    Private Function MakeServerName(ByVal ServerName As String)
    Dim yServer() As Byte

    If ServerName <> "" Then
    If InStr(1, ServerName, "\\") = 0 Then
    ServerName = "\\" & ServerName
    End If
    End If

    yServer = ServerName & vbNullChar
    MakeServerName = yServer

    End Function


    ' *********************************************************
    ' Public Methods
    ' Pass the name of group as input string
    ' returns True if current user is in the group specified as in parameter
    ' else returns False
    ' *********************************************************

    Public Function CheckCurrentUserInGroup(GrpItem As String) As Boolean

    Dim GrpList As ListOfMemberGroup
    Dim i As Integer

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpItem)

    'if the grplist is not initilised ie., no corresponding entries then exit
    If GrpList.Init = False Then

    CheckCurrentUserInGroup = False

    Else

    For i = 1 To UBound(GrpList.List)
    'if user and group match then return true and exit
    If UserName = GrpList.List(i).UserName Then
    CheckCurrentUserInGroup = True
    Exit Function
    Else
    CheckCurrentUserInGroup = False
    End If
    Next

    End If

    End Function

    ' *********************************************************
    ' Public Methods
    ' returns a string array of groups to which the user belongs
    ' *********************************************************

    Public Function UsersInGroup(ByVal GrpName As String) As String()
    Dim GrpList As ListOfMemberGroup
    Dim i As Integer, aUser() As String

    'Local Group
    GrpList = LocalGroupsGetMember(ComputerName, GrpName)

    'if the grplist is not initilised ie., no corresponding entries.
    If GrpList.Init = False Then
    UsersInGroup = aUser()
    Else
    ReDim aUser(1 To UBound(GrpList.List))
    For i = 1 To UBound(GrpList.List)
    aUser(i) = GrpList.List(i).UserName
    Next
    UsersInGroup = aUser()
    End If

    End Function


    *****************************************************************


    "Amy" <agstephens@hotmail.com> wrote:
    >
    >Can anyone tell me the API call to use to find the domain and username of
    >the currently logged on user to use to authenticate wen allowing access

    to
    >a VB app? The person before me tried to use LookupAccountName but it doesn't
    >seem to be working, it's returning the machine name instead of the domain.
    >Any ideas?



Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center