?
Solved

Convert C++ routine to VB6

Posted on 2005-03-04
4
Medium Priority
?
990 Views
Last Modified: 2009-12-16

I need help convert this routine to VB6:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/secmgmt/security/managing_account_permissions.asp

void AddPrivileges(PSID AccountSID, LSA_HANDLE PolicyHandle)
{
  LSA_UNICODE_STRING lucPrivilege;
  NTSTATUS ntsResult;

  // Create an LSA_UNICODE_STRING for the privilege name(s).
  if (!InitLsaString(&lucPrivilege, L"SeServiceLogonRight"))
  {
         wprintf(L"Failed InitLsaString\n");
         return;
  }

  ntsResult = LsaAddAccountRights(
    PolicyHandle,  // An open policy handle.
    AccountSID,    // The target SID.
    &lucPrivilege, // The privilege(s).
    1              // Number of privileges.
  );                
  if (ntsResult == STATUS_SUCCESS)
  {
    wprintf(L"Privilege added.\n");
  }
  else
  {
    wprintf(L"Privilege was not added - %lu \n",
      LsaNtStatusToWinError(ntsResult));
  }
}

0
Comment
Question by:vbdev04
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 7

Expert Comment

by:Smallint
ID: 13459523
Give it a shot.

Cheers


Option Explicit

Private Type LSA_UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As String
End Type


Private Type LSA_OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As LSA_UNICODE_STRING
    Attributes As Long
    SecurityDescriptor As Long ' Points to type SECURITY_DESCRIPTOR
    SecurityQualityOfService As Long ' Points to type
                                     ' SECURITY_QUALITY_OF_SERVICE
End Type

Private Type PSID
    sidData(228) As Byte
End Type

Private Declare Function LsaAddAccountRights Lib "Advapi32.dll" _
   (ByVal PolicyHandle As Long, AccountSid As PSID, userRights As _
   LSA_UNICODE_STRING, ByVal CountOfRights As Long) As Long

Private Declare Function LsaNtStatusToWinError Lib "Advapi32.dll" _
        (ByVal Status As Long) As Long
       
Private Const STATUS_SUCCESS = 0
       
 Private Declare Function StrLenA Lib "Kernel32" _
        Alias "lstrlenA" _
        (ByVal lpString As String) As Long
       

Private Sub InitLsaString(LsaString As LSA_UNICODE_STRING, strString As String)
 
     With LsaString
         If strString = "" Then
             .Length = 0
             .MaximumLength = 0
             .Buffer = ""
         Else
             .Length = StrLenA(strString)
             .MaximumLength = StrLenA(strString) + 1
             .Buffer = strString
         End If
     End With
 End Sub


Private Sub AddPrivileges(AccountSid As PSID, PolicyHandle As Long)

  Dim lucPrivilege As LSA_UNICODE_STRING
  Dim ntsResult As Long

  'Create an LSA_UNICODE_STRING for the privilege name(s).
  Call InitLsaString(lucPrivilege, "SeServiceLogonRight")

  ntsResult = LsaAddAccountRights(PolicyHandle, AccountSid, lucPrivilege, 1)
 
  If (ntsResult = STATUS_SUCCESS) Then
    Debug.Print "Privilege added."
  Else
    Debug.Print "Privilege was not added - " & CStr(LsaNtStatusToWinError(ntsResult))
  End If


End Sub



Private Sub Form_Load()
    Dim AccountSid As PSID
    Dim PolicyHandle As Long
   
    Call AddPrivileges(AccountSid, PolicyHandle)
End Sub
0
 

Author Comment

by:vbdev04
ID: 13459636

Thanks. Looks like it will work and I will award those points to you.

However, I am looking for a code that will set the policy given a username. That probably involve getting the AccountSid and Policyhandle using:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/secmgmt/security/opening_a_policy_object_handle.asp 

and
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/secmgmt/security/translating_between_names_and_sids.asp
0
 
LVL 7

Accepted Solution

by:
Smallint earned 1500 total points
ID: 13461091
Hi, this is what i've done.

GetSIDInformation is still not working, i don't know why.

Anyway this is far beyond scope of your question.

Take a look at ....

http://www.xephon.com/cgi-bin/xephon3/licence/getcode.cgi?pubfile=November.1999&datafile=W030A02


Cheers


Option Explicit

Private Type LSA_UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As String
End Type


Private Type LSA_OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As LSA_UNICODE_STRING
    Attributes As Long
    SecurityDescriptor As Long ' Points to type SECURITY_DESCRIPTOR
    SecurityQualityOfService As Long ' Points to type
                                     ' SECURITY_QUALITY_OF_SERVICE
End Type

Private Type PSID
    sidData(228) As Byte
End Type

Private Type LSA_TRUST_INFORMATION
  Name As LSA_UNICODE_STRING
  Sid As PSID
End Type
Private Type LSA_REFERENCED_DOMAIN_LIST
  Entries As Long
  Domains As Long
End Type

Public Enum SID_NAME_USE
    SidTypeUser = 1
    SidTypeGroup = 2
    SidTypeDomain = 3
    SidTypeAlias = 4
    SidTypeWellKnownGroup = 5
    SidTypeDeletedAccount = 6
    SidTypeInvalid = 7
    SidTypeUnknown = 8
End Enum


Private Type LSA_TRANSLATED_SID
  Use As SID_NAME_USE
  RelativeId As Long
  DomainIndex As Long
End Type


Private Declare Function LsaAddAccountRights Lib "advapi32.dll" _
   (ByVal PolicyHandle As Long, AccountSid As PSID, userRights As _
   LSA_UNICODE_STRING, ByVal CountOfRights As Long) As Long

Private Declare Function LsaNtStatusToWinError Lib "advapi32.dll" _
        (ByVal Status As Long) As Long
       
Private Declare Function LsaOpenPolicy Lib "advapi32.dll" _
   (SystemName As LSA_UNICODE_STRING, ObjectAttributes As _
   LSA_OBJECT_ATTRIBUTES, ByVal DesiredAccess As Long, _
   PolicyHandle As Long) As Long
   
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal _
   CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As _
   String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, _
   ByVal cchWideChar As Long) As Long
   
Private Declare Function LsaClose Lib "advapi32.dll" _
   (ByVal PolicyHandle As Long) As Long
       

   
Private Declare Function LsaFreeMemory Lib "advapi32.dll" (ByVal _
   lpBuffer As Long) As Long
       
Private Declare Function StrLenA Lib "kernel32" _
        Alias "lstrlenA" _
        (ByVal lpString As String) As Long
       
Private Declare Function LsaLookupNames Lib "advapi32.dll" ( _
            ByRef PolicyHandle As Long, _
            ByVal count As Long, _
            Names As LSA_UNICODE_STRING, _
            ByRef ReferencedDomains As Long, _
            ByRef Sids As Long) As Long
       
Private Const STATUS_SUCCESS = 0
Private Const CP_ACP = 0
       
Private Const POLICY_VIEW_LOCAL_INFORMATION = 1
Private Const POLICY_VIEW_AUDIT_INFORMATION = 2
Private Const POLICY_GET_PRIVATE_INFORMATION = 4
Private Const POLICY_TRUST_ADMIN = 8
Private Const POLICY_CREATE_ACCOUNT = 10
Private Const POLICY_CREATE_SECRET = 20
Private Const POLICY_CREATE_PRIVILEGE = 40
Private Const POLICY_SET_DEFAULT_QUOTA_LIMITS = 80
Private Const POLICY_SET_AUDIT_REQUIREMENTS = 100
Private Const POLICY_AUDIT_LOG_ADMIN = 200
Private Const POLICY_SERVER_ADMIN = 400
Private Const POLICY_LOOKUP_NAMES = 800
Private Const POLICY_ALL_ACCESS = POLICY_VIEW_LOCAL_INFORMATION

Private Sub InitLsaString(LsaString As LSA_UNICODE_STRING, strString As String)
 
     With LsaString
         If strString = "" Then
             .Length = 0
             .MaximumLength = 0
             .Buffer = ""
         Else
             .Length = StrLenA(strString)
             .MaximumLength = StrLenA(strString) + 1
             .Buffer = strString
         End If
     End With
 End Sub


Private Sub AddPrivileges(AccountSid As PSID, PolicyHandle As Long)

  Dim lucPrivilege As LSA_UNICODE_STRING
  Dim ntsResult As Long

  'Create an LSA_UNICODE_STRING for the privilege name(s).
  Call InitLsaString(lucPrivilege, "SeServiceLogonRight")

  ntsResult = LsaAddAccountRights(PolicyHandle, AccountSid, lucPrivilege, 1)
 
  If (ntsResult = STATUS_SUCCESS) Then
    Debug.Print "Privilege added."
  Else
    Debug.Print "Privilege was not added - " & CStr(LsaNtStatusToWinError(ntsResult))
  End If


End Sub

Private Sub CreateUnicodeString(ByVal lpMultiByteStr As String, _
   UnicodeBuffer As LSA_UNICODE_STRING)
    Dim cchMultiByte As Long
    Dim cchWideChar As Long
    cchMultiByte = Len(lpMultiByteStr)
    UnicodeBuffer.Length = cchMultiByte * 2
    UnicodeBuffer.MaximumLength = UnicodeBuffer.Length + 2
    UnicodeBuffer.Buffer = String(UnicodeBuffer.MaximumLength, " ")
    cchWideChar = UnicodeBuffer.Length
    Dim lRetVal As Long
    lRetVal = MultiByteToWideChar(CP_ACP, 0, lpMultiByteStr, _
       cchMultiByte, UnicodeBuffer.Buffer, cchWideChar)
End Sub



Private Function GetPolicyHandle(SystemName As String, lngAccess As Long) As Long

  Dim ObjectAttributes As LSA_OBJECT_ATTRIBUTES
  Dim SystemNameLength As Long
  Dim lusSystemName As LSA_UNICODE_STRING
  Dim ntsResult As Long
  Dim lsahPolicyHandle As Long


  'Initialize an LSA_UNICODE_STRING to the server name.
  Call CreateUnicodeString(SystemName, lusSystemName)
 
  'Get a handle to the Policy object.
  ntsResult = LsaOpenPolicy(lusSystemName, ObjectAttributes, ByVal lngAccess, lsahPolicyHandle)
   
  If (ntsResult <> STATUS_SUCCESS) Then
    Debug.Print "OpenPolicy returned - " & CStr(LsaNtStatusToWinError(ntsResult))
    GetPolicyHandle = 0
    Exit Function
  End If

  GetPolicyHandle = lsahPolicyHandle
End Function


Private Function GetSIDInformation(strAccountName As String, PolicyHandle As Long) As PSID

  Dim lucName As LSA_UNICODE_STRING
  Dim ltsTranslatedSID As Long
  Dim lrdlDomainList As Long
  Dim ntsResult As Long
 
 
  Call InitLsaString(lucName, strAccountName)
 
  ntsResult = LsaLookupNames(PolicyHandle, 1, lucName, VarPtr(lrdlDomainList), VarPtr(ltsTranslatedSID))

  If (ntsResult <> STATUS_SUCCESS) Then
    Debug.Print "Failed LsaLookupNames - " & CStr(LsaNtStatusToWinError(ntsResult))
    Exit Function
  End If
 

  '// Display the relative Id.
  'wprintf(L"Relative Id is %lu in domain %ws.\n",
  '  ltsTranslatedSID->RelativeId,
  '  DomainString);

  LsaFreeMemory ltsTranslatedSID
  LsaFreeMemory lrdlDomainList


End Function


Private Sub Form_Load()
    Dim AccountSid As PSID
    Dim PolicyHandle As Long
    Dim strSystemName As String
    Dim strAccountName As String
   
    strSystemName = "pc-comedor"
    strAccountName = "Prese"
   
    PolicyHandle = GetPolicyHandle(strSystemName, POLICY_ALL_ACCESS)
   
    If PolicyHandle <> 0 Then
        AccountSid = GetSIDInformation(strAccountName, PolicyHandle)
    End If
   
    Call AddPrivileges(AccountSid, PolicyHandle)
   
    If PolicyHandle <> 0 Then
        LsaClose PolicyHandle
    End If
   
End Sub
0
 

Author Comment

by:vbdev04
ID: 13463196

Thanks for your efforts.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month11 days, 18 hours left to enroll

752 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