• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1002
  • Last Modified:

Convert C++ routine to VB6


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
vbdev04
Asked:
vbdev04
  • 2
  • 2
1 Solution
 
SmallintCommented:
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
 
vbdev04Author Commented:

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
 
SmallintCommented:
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
 
vbdev04Author Commented:

Thanks for your efforts.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now