Home  |   French  |   About  |   Search  | mvps.org  

What's New
Table Of Contents
Credits
Netiquette
10 Commandments 
Bugs
Tables
Queries
Forms
Reports
Modules
APIs
Strings
Date/Time
General
Downloads
Resources
Search
Feedback
mvps.org

In Memoriam

Terms of Use


VB Petition

API: Retrieve Current User's NT Domain

Author(s)
Dev Ashish

    To retrieve the current time from a NT server, we can use the NetWkStaUserGetInfo  API function.

Note: NetWkStaUserGetInfo, as with a whole bunch of other API functions, exist only under Windows NT environment. So this code will NOT work in Windows 95 or 98.

'************ Code Start *************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Type WKSTA_USER_INFO_1
   wkui1_username As Long     'name of the user _
                              currently logged on _
                              to the workstation.
   wkui1_logon_domain As Long 'the domain name of _
                              the user account of the _
                              user currently logged on
   wkui1_oth_domains As Long  'list of other LAN _
                              Manager domains browsed _
                              by the workstation.
   wkui1_logon_server As Long 'name of the computer _
                              that authenticated the _
                              server
End Type

Private Declare Function apiWkStationUser Lib "Netapi32" _
  Alias "NetWkstaUserGetInfo" _
  (ByVal reserved As Long, _
  ByVal Level As Long, _
  bufptr As Long) _
  As Long
  
Private Declare Function apiStrLenFromPtr Lib "kernel32" _
  Alias "lstrlenW" _
  (ByVal lpString As Long) _
  As Long

Private Declare Sub sapiCopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" _
  (hpvDest As Any, _
  hpvSource As Any, _
  ByVal cbCopy As Long)


Public Function fUserNTDomain() As String
'*******************************************
'Name:          fUserNTDomain  [NT ONLY] (Function)
'Purpose:       Find NT Domain name of current user
'Author:        Dev Ashish
'Date:          Thursday, January 14, 1999
'Called by:     Any
'Calls:         NetWkstaUserGetInfo, RTLMoveMemory
'Inputs:        None
'Returns:       NT Domain Name of Current User
'*******************************************
On Error GoTo ErrHandler
  Dim lngRet As Long
  Dim lngPtr As Long
  Dim tNTInfo As WKSTA_USER_INFO_1
  
  lngRet = apiWkStationUser(0&, 1&, lngPtr)
  If lngRet = 0 Then
    Call sapiCopyMemory(tNTInfo, ByVal lngPtr, LenB(tNTInfo))
    If Not lngPtr = 0 Then
      With tNTInfo
        fUserNTDomain = fStringFromPtr(.wkui1_logon_domain)
      End With
    End If
  End If

ExitHere:
  Exit Function
ErrHandler:
  fUserNTDomain = vbNullString
  Resume ExitHere
End Function

Private Function fStringFromPtr(lngPtr As Long) As String
Dim lngLen As Long
Dim abytStr() As Byte
  lngLen = apiStrLenFromPtr(lngPtr) * 2
  If lngLen > 0 Then
    ReDim abytStr(0 To lngLen - 1)
    Call sapiCopyMemory(abytStr(0), ByVal lngPtr, lngLen)
    fStringFromPtr = abytStr()
  End If
End Function
'************ Code End *************

© 1998-2010, Dev Ashish & Arvin Meyer, All rights reserved. Optimized for Microsoft Internet Explorer