Public Function GetCommonAppDataPath() As String
  Dim sf As New cSystemFolders
  GetCommonAppDataPath = sf.Path(CSIDL_COMMON_APPDATA)
End Function

Private Sub Class_Initialize()
  ' Make sure we have the function this class relies on!
  m_Enhanced = Exported("shfolder", "SHGetFolderPathA")
End Sub

Public Property Get Path(ByVal CSIDL As CSIDL_VALUES, _
 Optional Default As Boolean = True, Optional ForceCreation As Boolean = False) As String
  Dim buffer As String
  Dim pidl As Long
  Dim nRtn As Long
  
  ' Create buffer for return results.
  buffer = Space$(MAX_PATH)
  
  ' Branch based on what tools we have...
  If m_Enhanced Then
    ' Tell system to create, if necessary
    If ForceCreation Then
      CSIDL = CSIDL Or CSIDL_FLAG_CREATE
    End If
   
    ' Grab requested system folder.
    nRtn = SHGetFolderPath(0&, CSIDL, 0&, Abs(Default), buffer)
    Select Case nRtn
      Case S_OK
        ' Return requested system folder.
        Path = TrimNull(buffer)
      Case S_FALSE
        ' Folder either doesn't exist or isn't supported.
        Debug.Print "The CSIDL in nFolder is valid, but the folder does not exist."
      Case E_INVALIDARG
        ' OS doesn't support this folder. Unfortunately, this
        ' result isn't returned unless CSIDL_FLAG_CREATE is
        ' specified in SHGetFolderPath call.
        Debug.Print "The CSIDL in nFolder is not valid."
    End Select

  Else
    ' Use old-fashioned method to get system folder.
    nRtn = SHGetSpecialFolderLocation(0&, CSIDL, pidl)
    Select Case nRtn
      Case S_OK
        ' Retrieve actual path, given the pidl.
        If SHGetPathFromIDList(pidl, buffer) Then
          Path = TrimNull(buffer)
        End If
        Call CoTaskMemFree(pidl)
      Case E_INVALIDARG
        ' OS doesn't support this folder.
        Debug.Print "The CSIDL in nFolder is not valid."
      Case Else
        ' Some sort of OLE-defined error code
        Debug.Print "OLE error: &h" & Hex$(nRtn)
    End Select
  End If
End Property

#include <Shlobj.h>
...
  TCHAR szPath[MAX_PATH];
  SHGetFolderPath(NULL, CSIDL_COMMON_APPDATA, NULL, SHGFP_TYPE_DEFAULT, szPath);
  this->SetConfigurationPath(PString(szPath) + "\\Proga\\settings.ini");
  cout << "GetConfigurationFile=" << this->GetConfigurationFile() << '\n';

  If InstallTyp = Install Then
    If sys_WinVista Then 'процедура для Vista/2008/Win7/Win8
      'устанавливаем права на папку программы для группы "Пользователи" в Виста
      AddLog "-------------------------" & Now & "-------------------------"
      AddLog "Starting folder permissions definition."
      AddLog "Folder: " & CorrectDir(path_AppData)
      UsersGroupName = ConstructUniversalAndNTWellKnownSids("Users")
      If Len(UsersGroupName) > 0 Then
        AddLog "UsersGroupName: " & UsersGroupName & " ...OK"
        '  Running: D:\Users\Dima>icacls "d:\test" /grant Пользователи:(OI)(CI)F /T
        AddLog "  Running: icacls.exe " & Chr(34) & path_AppData & Chr(34) & _
         " /grant " & UsersGroupName & ":(OI)(CI)F /T"
        On Error GoTo errOp
        ShellAndContinue "icacls.exe " & Chr(34) & path_AppData & Chr(34) & _
         " /grant " & UsersGroupName & ":(OI)(CI)F /T", vbHide
        AddLog "  Running... Done."
        AddLog "Folder permissions definition completed."
        GoTo noErrOp
errOp:
        AddLog "  Running: icacls.exe... Failed. Error code: " & Err.Description & "(" & Err.NUMBER & ")"
        AddLog "Folder permissions definition... Failed"
noErrOp:
      Else
        AddLog "UsersGroupName:  ... Failed"
        AddLog "Folder permissions definition... Failed"
      End If
    End If
  End If

cacls.exe "C:\Documents and Settings\All Users\Application Data\Proga" /E /T /G Пользователи:F   //XP
icacls.exe "C:\Documents and Settings\All Users\Application Data\Proga" /grant Пользователи:(OI)(CI)F /T //>=Vista

Public Function ConstructUniversalAndNTWellKnownSids(GroupName As String) As String
  'возвращает имя стандартной группы пользователей на языке OS (рус,английский)
  Dim result As Long
  Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
  Dim lSid As Long
   
  Select Case GroupName
...
    Case "Users":
      ' Construct SID for Users "Well-known group"
      siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
      result = AllocateAndInitializeSid(siaNtAuthority, 2, _
       SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS, _
       0, 0, 0, 0, 0, 0, lSid)
      If result <> 0 Then
        AddLog "  Calling AllocateAndInitializeSid... Done."
      Else
        AddLog "  Calling AllocateAndInitializeSid... Failed. Error code: " & RaiseAPIError
      End If
   
      ' Use the constructed SID in the application
      ConstructUniversalAndNTWellKnownSids = DisplayNameOfSid(lSid)
   
      ' Free the memory allocated for the SID using FreeSid() API
      FreeSid lSid
    Case Else
      ConstructUniversalAndNTWellKnownSids = ""
  End Select
End Function
'
' Helper function to lookup a SID and display the name as a test
'
Public Function DisplayNameOfSid(ByVal lSid As Long) As String

   Dim result As Long
   Dim userName As String
   Dim cbUserName As Long
   Dim domainName As String
   Dim cbDomainName As Long
   Dim peUse As Integer
   
   ' Lookup the constructed SID to get the name
   userName = Space(255)
   domainName = Space(255)
   cbUserName = 255
   cbDomainName = 255
   result = LookupAccountSid(vbNullString, lSid, userName, cbUserName, _
         domainName, cbDomainName, peUse)
   If result <> 0 Then
      AddLog "  Calling LookupAccountSid... Done."
      DisplayNameOfSid = Left(userName, InStr(userName, Chr(0)) - 1)
   Else
      AddLog "  Calling LookupAccountSid... Failed. Error code: " & RaiseAPIError
      DisplayNameOfSid = ""
   End If

End Function

icacls.exe "C:\Documents and Settings\All Users\Application Data\Proga" /grant Пользователи:(OI)(CI)F /T

-------------------------10.10.2012 2:01:16-------------------------
Starting file or folder permissions definition.
Folder G:\Documents and Settings\All Users\Application Data\Venta\VentaFax & Voice\
  Calling CreateFile... Done.
  Calling AllocateAndInitializeSid... Done.
    Calling GetSecurityInfo... Done.
    Calling SetEntriesInAcl... Done.
    Calling SetSecurityInfo... Done.
  Calling AddAceToObjectsSecurityDescriptor... Done.
  Calling AllocateAndInitializeSid... Done.
  Calling AllocateAndInitializeSid... Done.
    Calling GetSecurityInfo... Done.
    Calling SetEntriesInAcl... Done.
    Calling SetSecurityInfo... Done.
  Calling AddAceToObjectsSecurityDescriptor... Done.
Folder permissions definition completed.

' ==icacls.exe "C:\Documents and Settings\All Users\Application Data\Proga" /grant Пользователи:(OI)(CI)F /T
' DoFullAccessFileFolder("C:\Documents and Settings\All Users\Application Data\Proga")
Public Function DoFullAccessFileFolder(FileFolderPath As String) As Long
  DoFullAccessFileFolder = AddAceToObjectsSecurityDescriptor(FileFolderPath, _
   SE_FILE_OBJECT, _
   ConstructUniversalAndNTWellKnownSids("Users"), _
   GENERIC_ALL, _
   GRANT_ACCESS, _
   CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE)
End Function

' DoFullAccessRegistryEntry("MACHINE\SOFTWARE\MyProga")
' MACHINE -для HKLM
Public Function DoFullAccessRegistryEntry(RegistryPath As String) As Long
  DoFullAccessRegistryEntry = AddAceToObjectsSecurityDescriptor(RegistryPath, _
   SE_REGISTRY_KEY, _
   ConstructUniversalAndNTWellKnownSids("Users"), _
   GENERIC_ALL, _
   GRANT_ACCESS, _
   CONTAINER_INHERIT_ACE Or OBJECT_INHERIT_ACE)
End Function

Public Function AddAceToObjectsSecurityDescriptor(pszObjName As String, _
 ObjectType As SE_OBJECT_TYPE, pszTrustee As String, _
 dwAccessRights As Long, AccessMode As ACCESS_MODE, dwInheritance As Long) As Long
 
  Dim dwRes As Long
  Dim pOldDACL As Long, pNewDACL As Long
  Dim pSD As Long
  Dim ea As EXPLICIT_ACCESS
 
  If (pszObjName = "") Then
    AddAceToObjectsSecurityDescriptor = ERROR_INVALID_PARAMETER
    Exit Function
  End If
  
  'Get a pointer to the existing DACL.
  dwRes = GetNamedSecurityInfo(pszObjName, ObjectType, _
   DACL_SECURITY_INFORMATION, _
   0&, 0&, pOldDACL, 0&, pSD)
  If dwRes <> ERROR_SUCCESS Then
    MsgBox "GetNamedSecurityInfo Error " & CStr(dwRes)
    GoTo Cleanup
  End If
  
  'Initialize an EXPLICIT_ACCESS structure for the new ACE.
  BuildExplicitAccessWithName ea, pszTrustee, dwAccessRights, AccessMode, dwInheritance
  
  ' Create a new ACL that merges the new ACE into the existing DACL.
  dwRes = SetEntriesInAcl(1, ea, pOldDACL, pNewDACL)
  If dwRes <> ERROR_SUCCESS Then
    MsgBox "SetEntriesInAcl Error " & CStr(dwRes)
    GoTo Cleanup
  End If

  'Attach the new ACL as the object's DACL.
  dwRes = SetNamedSecurityInfo(pszObjName, ObjectType, _
   DACL_SECURITY_INFORMATION, _
   0&, 0&, pNewDACL, 0&)
  If dwRes <> ERROR_SUCCESS Then
    MsgBox "SetNamedSecurityInfo Error " & CStr(dwRes)
    GoTo Cleanup
  End If

Cleanup:
  If pSD <> 0 Then LocalFree pSD
  If pNewDACL <> 0 Then LocalFree pNewDACL
  
  AddAceToObjectsSecurityDescriptor = dwRes
End Function

Private Sub CommandGoService_Click()
  'дал бы GENERIC_ALL но удалять сервис под пользователем как-то не правильно
  DoAccessNTService "MyService", GENERIC_READ Or GENERIC_EXECUTE
End Sub

Public Function DoAccessNTService(ServiceName As String, dwAccessRights As Long) As Long
  DoAccessNTService = AddAceToObjectsSecurityDescriptor(ServiceName, _
   SE_SERVICE, _
   ConstructUniversalAndNTWellKnownSids("Users"), _
   dwAccessRights, _
   GRANT_ACCESS, _
   NO_INHERITANCE)
End Function

Public Function GetSecurityPermissions(ByVal pszObjName As String, _
 ByVal ObjectType As SE_OBJECT_TYPE, ByVal pszTrustee As String, _
 ByRef dwAccessRights As Long) As Long
 
  Dim dwRes As Long
  Dim pCurDACL As Long
  Dim pSD As Long
  Dim tr As TRUSTEE
 
  If (pszObjName = "") Then
    GetSecurityPermissions = ERROR_INVALID_PARAMETER
    MsgBox "ERROR_INVALID_PARAMETER"
    Exit Function
  End If
  
  'Get a pointer to the existing DACL.
  dwRes = GetNamedSecurityInfo(pszObjName, ObjectType, _
   DACL_SECURITY_INFORMATION, _
   0&, 0&, pCurDACL, 0&, pSD)
  If dwRes <> ERROR_SUCCESS Then
    MsgBox "GetNamedSecurityInfo Error " & CStr(dwRes)
    GoTo Cleanup
  End If
  
  'Initialize a TRUSTEE structure for the specified trustee name.
  BuildTrusteeWithName tr, pszTrustee
  
  dwRes = GetEffectiveRightsFromAcl(pCurDACL, tr, dwAccessRights)
  If dwRes <> ERROR_SUCCESS Then
    MsgBox "GetEffectiveRightsFromAcl Error " & CStr(dwRes)
    GoTo Cleanup
  End If

Cleanup:
  If pSD <> 0 Then LocalFree pSD
  
  GetSecurityPermissions = dwRes
  
End Function

Public Function NTService_QueryStopByAll(ByVal ServiceName As String, _
 ByRef AllowStop As Boolean) As Long
  'ф-ция возвращает ERROR_SUCCESS при успехе либо номер ошибки
  'ф-ция возвращает результат в AllowStop (при успехе)
  Dim AccessMask As Long
  NTService_QueryStopByAll = GetSecurityPermissions(ServiceName, _
   SE_SERVICE, _
   ConstructUniversalAndNTWellKnownSids("Users"), _
   AccessMask)
  If NTService_QueryStopByAll = ERROR_SUCCESS Then
    If AccessMask And SERVICE_STOP Then AllowStop = True
  End If
End Function

Public Function NTService_AllowStopByAll(ByVal ServiceName As String, _
 Optional ByVal AllowStop As Boolean = True) As Long
  NTService_AllowStopByAll = AddAceToObjectsSecurityDescriptor(ServiceName, _
   SE_SERVICE, _
   ConstructUniversalAndNTWellKnownSids("Users"), _
   SERVICE_STOP, _
   IIf(AllowStop, GRANT_ACCESS, DENY_ACCESS), _
   NO_INHERITANCE)
End Function
'=======
Private Sub CommandMyServiceAllowSTOP_Click()
  MsgBox NTService_AllowStopByAll("MyService", True)
End Sub

Private Sub CommandMyServiceDenySTOP_Click()
  MsgBox NTService_AllowStopByAll("MyService", False)
End Sub

Private Sub CommandMyServiceQuerySTOP_Click()
  Dim iError As Long
  Dim bSuccess As Boolean
  iError = NTService_QueryStopByAll("MyService", bSuccess)
  If iError = ERROR_SUCCESS Then
    MsgBox bSuccess
  Else
    MsgBox "Error=" & iError
  End If
End Sub