IS Administrator

IS Administrator

Question:
Can I check if the user running the application has either local machine or domain administrative privileges? I have a piece of code which does this in C++ , but I require it for VB 5.0.

Answer:
The following code should work for you:

In a form, create Command1, and an array of 2 labels named Label1:

Private Sub Command1_Click()      If Module1.CheckLocalAdmin() = True Then      Me.Label1(0).Caption = " Is Local Admin"   Else      Me.Label1(0).Caption = " Is *NOT* Local Admin"   End If   If Module1.CheckPDCAdmin() = True Then      Me.Label1(1).Caption = " Is PDC Admin"   Else      Me.Label1(1).Caption = " Is *NOT* PDC Admin"   End IfEnd Sub

In a BAS file, insert the following code:

Option Explicit' Used for error trappingPrivate m_lngErrNum                    As LongPrivate m_strErrDesc                   As StringPrivate m_strErrSource                 As String' Win32 NetAPIs.Private Declare Function NetUserGetGroups _   Lib "netapi32.dll" _   (Servername As Byte, _    username As Byte, _    ByVal level As Long, _    Buffer As Long, _    ByVal prefmaxlen As Long, _    entriesread As Long, _    totalentries As Long) As LongPrivate Declare Function NetUserGetLocalGroups _   Lib "netapi32.dll" _   (Servername As Byte, _    username As Byte, _    ByVal level As Long, _    ByVal flags As Long, _    Buffer As Long, _    ByVal prefmaxlen As Long, _    entriesread As Long, _    totalentries As Long) As LongPrivate Declare Function NetApiBufferFree _   Lib "netapi32" _   (ByVal pBuffer As Long) As LongPrivate Declare Function GetComputerNameW _   Lib "kernel32" _   (lpBuffer As Any, _    nSize As Long) As LongPrivate Declare Function NetGetDCName _   Lib "netapi32.dll" _   (Servername As Byte, _    DomainName As Byte, _    Buffer As Long) As LongPrivate 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 LongPrivate Declare Function lstrcpyW _   Lib "kernel32" _   (lpString1 As Byte, _    ByVal lpString2 As Long) As LongPrivate Declare Function GetUserName _   Lib "advapi32.dll" Alias "GetUserNameA" _   (ByVal lpBuffer As String, _    nSize As Long) As Long  ' Specific known errors for API calls used'     by this classPrivate Const ERROR_ACCESS_DENIED      As Long = 5&Private Const ERROR_INVALID_NAME       As Long = 123&Private Const ERROR_MORE_DATA          As Long = 234&Private Const NERR_BASE                As Long = 2100&Private Const NERR_Success             As Long = 0&Private Const NERR_GroupNotFound       As Long = NERR_BASE + 120&Private Const NERR_UserNotFound        As Long = NERR_BASE + 121&Private Const NERR_InvalidComputer     As Long = NERR_BASE + 251&Private Const NERR_DCNotFound          As Long = NERR_BASE + 353&Private Const LG_INCLUDE_INDIRECT      As Long = 1&Private Const UNLEN                    As Long = 256&' Private constants for this classPrivate Const constComputerNameLen     As Long = 15&     ' Maximum computer name lengthPrivate Const wbcErrNoGroupsFound      As Long = 9000 + vbObjectErrorPrivate Const wbcErrCouldNotFindPDC    As Long = 9001 + vbObjectError' Private member variablesPrivate m_strUserID                    As StringPublic Enum enumSecurityGroupLevel   NoSecurity = 0   UserSecurity = 1   AdminSecurity = 2   SuperAdminSecurity = 3End Enum' This is the error source for this modulePrivate Const m_constErrSource         As String = "MyProject" & ".clsNetGroups"' *******************************************************' Inputs       : N/A' Outputs      : Boolean: TRUE if a Local Admin, FALSE otherwise' Description  : Determine if current user is a local admininstrator' *******************************************************Public Function CheckLocalAdmin() As Boolean   Dim p_strPDCName     As String   Dim p_strUserID      As String   Dim p_vntRtn         As Variant   Dim p_lngNumItems    As Long   Dim p_lngLoop        As Long      ' Default to not admin (ie, FALSE)   CheckLocalAdmin = False      ' Get the current user   p_strUserID = GetCurrentUserID()      ' Get the groups this user belongs to   p_vntRtn = GetNTUserLocalGroups(p_strUserID)      ' Get the upper bounds of the group variant array   On Error Resume Next   p_lngNumItems = UBound(p_vntRtn)   If Err.Number <> 0 Then      Exit Function   End If   On Error GoTo 0      ' Check for Administrator rights   For p_lngLoop = 0 To p_lngNumItems      If UCase$(Trim$(p_vntRtn(p_lngLoop))) = "ADMINISTRATORS" Then         CheckLocalAdmin = True      End If   Next p_lngLoop   End Function' *******************************************************' Inputs       : N/A' Outputs      : Boolean: TRUE if a Domain Admin, FALSE otherwise' Description  : Determine if current user is a domain admin' *******************************************************Public Function CheckPDCAdmin() As Boolean   Dim p_strPDCName     As String   Dim p_strUserID      As String   Dim p_vntRtn         As Variant   Dim p_lngNumItems    As Long   Dim p_lngLoop        As Long      ' Default to not admin (ie, FALSE)   CheckPDCAdmin = False      ' Get the PDC name   p_strPDCName = GetPDC("", "")      ' Get the current user   p_strUserID = GetCurrentUserID()      ' Get the groups this user belongs to   p_vntRtn = GetNTUserGlobalGroups(p_strUserID, p_strPDCName)      ' Get the upper bounds of the group variant array   On Error Resume Next   p_lngNumItems = UBound(p_vntRtn)   If Err.Number <> 0 Then      Exit Function   End If   On Error GoTo 0      ' Check for Administrator rights   For p_lngLoop = 0 To p_lngNumItems      If UCase$(Trim$(p_vntRtn(p_lngLoop))) = "DOMAIN ADMINS" Then         CheckPDCAdmin = True      End If   Next p_lngLoop   End Function' *******************************************************' Inputs       : N/A' Outputs      : String: The UserID of the current logged-on user' Description  : Return the UserID of the current user'              :     that has logged onto NT' *******************************************************Private Function GetCurrentUserID() As StringOn Error Resume Next                   ' Don't accept errors here   Const p_constProcName               As String = "GetNTUserLocalGroups"   Dim p_strName                       As String   Dim p_lngNameLen                    As Long      ' Assume failure   GetCurrentUserID = ""   p_lngNameLen = UNLEN + 1   p_strName = String$(p_lngNameLen, Chr$(0))   If GetUserName(p_strName, p_lngNameLen) <> 0 Then      GetCurrentUserID = Mid$(p_strName, 1, p_lngNameLen - 1)   End IfOn Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_strUserID:String   - UserID of current user' Outputs      : Variant: Array of NT group names' Description  : Pass in a userID and PDC, return a variant array'              :     of groups that this user belongs to' *******************************************************Private Function GetNTUserLocalGroups(ByVal xi_strUserID As String) As VariantOn Error Resume Next                   ' Don't accept errors here   Const p_constProcName               As String = "GetNTUserLocalGroups"   Dim p_bytUserName()                 As Byte   Dim p_bytServerName()               As Byte   Dim p_astrGroups()                  As String   Dim p_alngGroups()                  As Long   Dim p_strTmp                        As String   Dim p_lngRtn                        As Long   Dim p_lngBuffer                     As Long   Dim p_lngEntriesRead                As Long   Dim p_lngEntriesTotal               As Long   Dim p_lngLevel                      As Long   Dim p_lngBufferPtr                  As Long   Dim p_lngLoop                       As Long   Dim p_lngFlags                      As Long      ' Convert the user name to a byte array   p_bytUserName = xi_strUserID & vbNullChar      ' Convert the PDC name to a byte array   p_bytServerName = vbNullChar & vbNullChar      ' Get the groups   p_lngLevel = 0&   p_lngBufferPtr = 4096   p_lngFlags = LG_INCLUDE_INDIRECT   p_lngRtn = NetUserGetLocalGroups(p_bytServerName(0), _                                    p_bytUserName(0), _                                    p_lngLevel, _                                    p_lngFlags, _                                    p_lngBuffer, _                                    p_lngBufferPtr, _                                    p_lngEntriesRead, _                                    p_lngEntriesTotal)         ' Check for errors   If p_lngRtn = NERR_Success Then      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4      For p_lngLoop = 0 To p_lngEntriesRead - 1         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))      Next p_lngLoop   Else      ' Do your own error handling here      m_lngErrNum = wbcErrNoGroupsFound            Select Case p_lngRtn         Case ERROR_ACCESS_DENIED            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."         Case NERR_UserNotFound            p_strTmp = "User not found: " & xi_strUserID         Case Else            p_strTmp = "Unknown error: " & CStr(p_lngRtn)      End Select   End If      ' ------------------------------------------   ' Free the buffer   ' ------------------------------------------   If p_lngBuffer Then      NetApiBufferFree p_lngBuffer   End If      ' ------------------------------------------   ' Set the return value   ' ------------------------------------------   GetNTUserLocalGroups = p_astrGroups   On Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_strUserID:String   - UserID of current user'              : ByVal xi_strPDCName:String  - PDC of domain (can be blank)' Outputs      : Variant: Array of NT group names' Description  : Pass in a userID and PDC, return a variant array'              :     of groups that this user belongs to' *******************************************************Private Function GetNTUserGlobalGroups(ByVal xi_strUserID As String, _                                       ByVal xi_strPDCName As String) As VariantOn Error Resume Next                   ' Don't accept errors here   Const p_constProcName               As String = "GetNTUserGlobalGroups"   Dim p_bytUserName()                 As Byte   Dim p_bytServerName()               As Byte   Dim p_astrGroups()                  As String   Dim p_alngGroups()                  As Long   Dim p_strTmp                        As String   Dim p_lngRtn                        As Long   Dim p_lngBuffer                     As Long   Dim p_lngEntriesRead                As Long   Dim p_lngEntriesTotal               As Long   Dim p_lngLevel                      As Long   Dim p_lngBufferPtr                  As Long   Dim p_lngLoop                       As Long      ' Convert the user name to a byte array   p_bytUserName = xi_strUserID & vbNullChar      ' Convert the PDC name to a byte array   If Len(Trim$(xi_strPDCName)) = 0 Then      p_bytServerName = vbNullChar   Else      If InStr(xi_strPDCName, "\") = 1 Then         p_bytServerName = xi_strPDCName & vbNullChar      Else         p_bytServerName = "\" & xi_strPDCName & vbNullChar      End If   End If      ' Get the groups   p_lngLevel = 0&   p_lngBufferPtr = 4096   p_lngRtn = NetUserGetGroups(p_bytServerName(0), _                               p_bytUserName(0), _                               p_lngLevel, _                               p_lngBuffer, _                               p_lngBufferPtr, _                               p_lngEntriesRead, _                               p_lngEntriesTotal)         ' Check for errors   If p_lngRtn = NERR_Success Then      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4      For p_lngLoop = 0 To p_lngEntriesRead - 1         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))      Next p_lngLoop   Else      ' Do your own error handling here      m_lngErrNum = wbcErrNoGroupsFound            Select Case p_lngRtn         Case ERROR_ACCESS_DENIED            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."         Case NERR_InvalidComputer            p_strTmp = "Invalid computer name for PDC: " & xi_strPDCName         Case NERR_UserNotFound            p_strTmp = "User not found: " & xi_strUserID         Case Else            p_strTmp = "Unknown error: " & CStr(p_lngRtn)      End Select   End If      ' Free the buffer   If p_lngBuffer Then      NetApiBufferFree p_lngBuffer   End If      ' Set the return value   GetNTUserGlobalGroups = p_astrGroups   On Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_strServer:String   -- Name of server'              : ByVal xi_strDomain:String   -- Name of the domain'              : ByRef xo_strPDC_Name:String -- output, name of PDC' Outputs      : Long: Zero if successful, non-zero otherwise' Description  : Get the PDC of the current machine' *******************************************************Private Function GetPDC(ByVal xi_strServer As String, _                        ByVal xi_strDomain As String) As StringOn Error Resume Next                   ' Don't accept error here   Const p_constProcName               As String = "GetPDC"   Dim p_strTmp                        As String   Dim p_lngRtn                        As Long   Dim p_lngBufferPtr                  As Long   Dim p_astrTmp(100)                  As Byte   Dim p_abytServerName()              As Byte   Dim p_abytDomainName()              As Byte       ' Move to byte array   p_abytServerName = xi_strServer & vbNullChar   p_abytDomainName = xi_strDomain & vbNullChar               ' Get the name of the PDC   p_lngRtn = NetGetDCName(p_abytServerName(0), _                           p_abytDomainName(0), _                           p_lngBufferPtr)      ' Set the return value (zero is success)   If p_lngRtn = 0 Then      GetPDC = True   Else      GetPDC = False         ' Do your own error handling here      m_lngErrNum = wbcErrCouldNotFindPDC      Select Case p_lngRtn         Case NERR_DCNotFound            p_strTmp = "Could not find the domain controller for the current domain."         Case ERROR_INVALID_NAME            p_strTmp = "Invalid name for PDC -- the name could not be found."         Case Else            p_strTmp = "Unknown error: " & CStr(p_lngRtn)      End Select      m_strErrDesc = p_strTmp      m_strErrSource = m_constErrSource & "." & p_constProcName            On Error GoTo 0      Err.Raise m_lngErrNum, m_strErrSource, m_strErrDesc   End If        ' Translate the name   If p_lngRtn = 0 Then      GetPDC = PointerToStringW(p_lngBufferPtr)   Else      GetPDC = ""   End If      ' Free the buffer   NetApiBufferFree p_lngBufferPtrOn Error GoTo 0End Function' *******************************************************' Inputs       : ByVal xi_lngStrPtr:Long  -- Pointer to a string' Outputs      : String: Translated string' Description  : When passed a pointer to a string,'              :     return that string' *******************************************************Private Function PointerToStringW(ByVal xi_lngStrPtr As Long) As StringOn Error Resume Next                   ' Don't accept error here   Dim p_abytBuffer()                  As Byte   Dim p_lngLength                     As Long      If xi_lngStrPtr Then            p_lngLength = lstrlenW(xi_lngStrPtr) * 2            If p_lngLength Then         ReDim p_abytBuffer(0 To (p_lngLength - 1)) As Byte         CopyMem p_abytBuffer(0), ByVal xi_lngStrPtr, p_lngLength         PointerToStringW = p_abytBuffer      End If      End If   On Error GoTo 0End Function
devx-admin

devx-admin

Share the Post:
USA Companies

Top Software Development Companies in USA

Navigating the tech landscape to find the right partner is crucial yet challenging. This article offers a comparative glimpse into the top software development companies

Software Development

Top Software Development Companies

Looking for the best in software development? Our list of Top Software Development Companies is your gateway to finding the right tech partner. Dive in

India Web Development

Top Web Development Companies in India

In the digital race, the right web development partner is your winning edge. Dive into our curated list of top web development companies in India,

USA Web Development

Top Web Development Companies in USA

Looking for the best web development companies in the USA? We’ve got you covered! Check out our top 10 picks to find the right partner

Clean Energy Adoption

Inside Michigan’s Clean Energy Revolution

Democratic state legislators in Michigan continue to discuss and debate clean energy legislation in the hopes of establishing a comprehensive clean energy strategy for the

Chips Act Revolution

European Chips Act: What is it?

In response to the intensifying worldwide technology competition, Europe has unveiled the long-awaited European Chips Act. This daring legislative proposal aims to fortify Europe’s semiconductor

USA Companies

Top Software Development Companies in USA

Navigating the tech landscape to find the right partner is crucial yet challenging. This article offers a comparative glimpse into the top software development companies in the USA. Through a

Software Development

Top Software Development Companies

Looking for the best in software development? Our list of Top Software Development Companies is your gateway to finding the right tech partner. Dive in and explore the leaders in

India Web Development

Top Web Development Companies in India

In the digital race, the right web development partner is your winning edge. Dive into our curated list of top web development companies in India, and kickstart your journey to

USA Web Development

Top Web Development Companies in USA

Looking for the best web development companies in the USA? We’ve got you covered! Check out our top 10 picks to find the right partner for your online project. Your

Clean Energy Adoption

Inside Michigan’s Clean Energy Revolution

Democratic state legislators in Michigan continue to discuss and debate clean energy legislation in the hopes of establishing a comprehensive clean energy strategy for the state. A Senate committee meeting

Chips Act Revolution

European Chips Act: What is it?

In response to the intensifying worldwide technology competition, Europe has unveiled the long-awaited European Chips Act. This daring legislative proposal aims to fortify Europe’s semiconductor supply chain and enhance its

Revolutionized Low-Code

You Should Use Low-Code Platforms for Apps

As the demand for rapid software development increases, low-code platforms have emerged as a popular choice among developers for their ability to build applications with minimal coding. These platforms not

Cybersecurity Strategy

Five Powerful Strategies to Bolster Your Cybersecurity

In today’s increasingly digital landscape, businesses of all sizes must prioritize cyber security measures to defend against potential dangers. Cyber security professionals suggest five simple technological strategies to help companies

Global Layoffs

Tech Layoffs Are Getting Worse Globally

Since the start of 2023, the global technology sector has experienced a significant rise in layoffs, with over 236,000 workers being let go by 1,019 tech firms, as per data

Huawei Electric Dazzle

Huawei Dazzles with Electric Vehicles and Wireless Earbuds

During a prominent unveiling event, Huawei, the Chinese telecommunications powerhouse, kept quiet about its enigmatic new 5G phone and alleged cutting-edge chip development. Instead, Huawei astounded the audience by presenting

Cybersecurity Banking Revolution

Digital Banking Needs Cybersecurity

The banking, financial, and insurance (BFSI) sectors are pioneers in digital transformation, using web applications and application programming interfaces (APIs) to provide seamless services to customers around the world. Rising

FinTech Leadership

Terry Clune’s Fintech Empire

Over the past 30 years, Terry Clune has built a remarkable business empire, with CluneTech at the helm. The CEO and Founder has successfully created eight fintech firms, attracting renowned

The Role Of AI Within A Web Design Agency?

In the digital age, the role of Artificial Intelligence (AI) in web design is rapidly evolving, transitioning from a futuristic concept to practical tools used in design, coding, content writing

Generative AI Revolution

Is Generative AI the Next Internet?

The increasing demand for Generative AI models has led to a surge in its adoption across diverse sectors, with healthcare, automotive, and financial services being among the top beneficiaries. These

Microsoft Laptop

The New Surface Laptop Studio 2 Is Nuts

The Surface Laptop Studio 2 is a dynamic and robust all-in-one laptop designed for creators and professionals alike. It features a 14.4″ touchscreen and a cutting-edge design that is over

5G Innovations

GPU-Accelerated 5G in Japan

NTT DOCOMO, a global telecommunications giant, is set to break new ground in the industry as it prepares to launch a GPU-accelerated 5G network in Japan. This innovative approach will

AI Ethics

AI Journalism: Balancing Integrity and Innovation

An op-ed, produced using Microsoft’s Bing Chat AI software, recently appeared in the St. Louis Post-Dispatch, discussing the potential concerns surrounding the employment of artificial intelligence (AI) in journalism. These

Savings Extravaganza

Big Deal Days Extravaganza

The highly awaited Big Deal Days event for October 2023 is nearly here, scheduled for the 10th and 11th. Similar to the previous year, this autumn sale has already created

Cisco Splunk Deal

Cisco Splunk Deal Sparks Tech Acquisition Frenzy

Cisco’s recent massive purchase of Splunk, an AI-powered cybersecurity firm, for $28 billion signals a potential boost in tech deals after a year of subdued mergers and acquisitions in the

Iran Drone Expansion

Iran’s Jet-Propelled Drone Reshapes Power Balance

Iran has recently unveiled a jet-propelled variant of its Shahed series drone, marking a significant advancement in the nation’s drone technology. The new drone is poised to reshape the regional

Solar Geoengineering

Did the Overshoot Commission Shoot Down Geoengineering?

The Overshoot Commission has recently released a comprehensive report that discusses the controversial topic of Solar Geoengineering, also known as Solar Radiation Modification (SRM). The Commission’s primary objective is to

Remote Learning

Revolutionizing Remote Learning for Success

School districts are preparing to reveal a substantial technological upgrade designed to significantly improve remote learning experiences for both educators and students amid the ongoing pandemic. This major investment, which

Revolutionary SABERS Transforming

SABERS Batteries Transforming Industries

Scientists John Connell and Yi Lin from NASA’s Solid-state Architecture Batteries for Enhanced Rechargeability and Safety (SABERS) project are working on experimental solid-state battery packs that could dramatically change the

Build a Website

How Much Does It Cost to Build a Website?

Are you wondering how much it costs to build a website? The approximated cost is based on several factors, including which add-ons and platforms you choose. For example, a self-hosted