ShellAndContinue "icacls.exe " & Chr(34) & path_FullAccess & Chr(34) & _
       " /grant " & UsersGroupName & ":(OI)(CI)F /T", vbHide

Private Const SECURITY_BUILTIN_DOMAIN_RID As Long = &H20
Private Const DOMAIN_ALIAS_RID_ADMINS As Long = &H220

Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" (pIdentifierAuthority As Any, _
 ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, _
 ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, _
 ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, _
 lpPSid As Long) As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid As Long)
Private Declare Function CheckTokenMembership Lib "advapi32.dll" (ByVal hToken As Long, _
 ByVal pSidToCheck As Long, pbIsMember As Long) As Long

Private Type SID_IDENTIFIER_AUTHORITY
  Value(0 To 5) As Byte
End Type

Public Function IsAdministrator() As Boolean
  Dim NtAuthority As SID_IDENTIFIER_AUTHORITY
  Dim pAdministratorGroup As Long
  Dim lResult As Long

  NtAuthority.Value(5) = 5

  If AllocateAndInitializeSid(NtAuthority, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, _
   0, 0, 0, 0, pAdministratorGroup) <> 0 Then
    If CheckTokenMembership(0, pAdministratorGroup, lResult) <> 0 Then
      IsAdministrator = (lResult <> 0)

      Exit Function
    End If

    Call FreeSid(pAdministratorGroup)
  End If

  IsAdministrator = False
End Function

    Dim FilePath As String
    FilePath = App.Path & "\" & App.EXEName & ".exe"
    ExecuteProcess(FilePath, 0, SW_NORMAL, "[параметры командной строки]", True)
===
'--- for WaitForXxx
Private Const INFINITE As Long = &HFFFFFFFF
'--- for ShellExecuteEx
Private Const SEE_MASK_NOCLOSEPROCESS As Long = &H40
Private Const SEE_MASK_DEFAULT = &H0

Private Type SHELLEXECUTEINFO
  cbSize As Long
  fMask As Long
  hwnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type

Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" _
 (pExecInfo As SHELLEXECUTEINFO) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
 (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long

Public Enum ExecuteStatus
  res_OK
  res_FAILED
  res_CANCEL
End Enum

Public Function ExecuteProcess(ByVal FilePath As String, ByVal hwnd As Long, _
 ByVal nShow As Long, Optional lpParameters As String = "", _
 Optional LaunchElevated As Boolean = False) As ExecuteStatus 'ByVal nShow As ShowConstants
 
  Dim ExecInfo As SHELLEXECUTEINFO
  Dim lExitCode As Long

  On Error GoTo Hell

  With ExecInfo
    ' Set up the structure.
    .cbSize = Len(ExecInfo)
    .fMask = SEE_MASK_NOCLOSEPROCESS ' SEE_MASK_DEFAULT
    .lpFile = FilePath
    .nShow = nShow
    .lpDirectory = ExtractDirectoryFromPath(FilePath)
    .lpParameters = lpParameters
    .hwnd = hwnd

    ' On Microsoft Windows Vista and later, one can use runas instead of Open, in order to execute the
    ' process as an elevated process. In that case, the user will be asked whether he or she wants to
    ' run the process as an administrator.
    If LaunchElevated = True Then
      .lpVerb = "runas"
    Else
      .lpVerb = "Open"
    End If
  End With

  If ShellExecuteEx(ExecInfo) Then
    Call WaitForSingleObject(ExecInfo.hProcess, INFINITE)
    If GetExitCodeProcess(ExecInfo.hProcess, lExitCode) <> 0 Then
      If lExitCode = 0 Then
        ExecuteProcess = res_OK
      Else
        ExecuteProcess = res_FAILED
      End If
    Else
      ExecuteProcess = res_FAILED
    End If
    Call CloseHandle(ExecInfo.hProcess)
  Else
    ExecuteProcess = res_CANCEL
  End If

  Exit Function

Hell:
  ExecuteProcess = False
End Function

Private Function ExtractDirectoryFromPath(Path As String) As String
  On Error Resume Next

  Dim Position As Long

  ' Find the right-most slash.
  Position = InStrRev(Path, "\")

  ' Extract everything on the left.
  ExtractDirectoryFromPath = Left$(Path, Position - 1)
End Function

Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)

ExitProcess 1 'код возврата, отличный от нуля, напр. означает ошибку

On Error GoTo Hell

.fMask = SEE_MASK_DEFAULT
...
ShellExecuteEx ExecInfo

и сделать из ф-ции Sub()

' ==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

Public Function ExecuteProcess(ByVal FilePath As String, ByVal hwnd As Long, _
 ByVal nShow As Long, Optional lpParameters As String = "", _
 Optional LaunchElevated As Boolean = False, _
 Optional useDoEvent As Boolean = False) As ExecuteStatus 'nShow - напр.SW_SHOWNORMAL
 
  'useDoEvent -использует цикл с DoEvent вместо WaitForSingleObject
 
  Dim ExecInfo As SHELLEXECUTEINFO
  Dim lExitCode As Long

  With ExecInfo
    ' Set up the structure.
    .cbSize = Len(ExecInfo)
    .fMask = SEE_MASK_NOCLOSEPROCESS ' SEE_MASK_DEFAULT
    .lpFile = FilePath
    .nShow = nShow
    .lpDirectory = ExtractDirectoryFromPath(FilePath)
    .lpParameters = lpParameters
    .hwnd = hwnd

    ' On Microsoft Windows Vista and later, one can use runas instead of Open, in order to execute the
    ' process as an elevated process. In that case, the user will be asked whether he or she wants to
    ' run the process as an administrator.
    If LaunchElevated = True Then
      .lpVerb = "runas"
    Else
      .lpVerb = "Open"
    End If
  End With

  If ShellExecuteEx(ExecInfo) Then
    If useDoEvent Then
      Do
        'Get the status of the process
        GetExitCodeProcess ExecInfo.hProcess, lExitCode
        DoEvents
        'Loop while the process is active
      Loop While lExitCode = STILL_ACTIVE
    Else
      Call WaitForSingleObject(ExecInfo.hProcess, INFINITE)
    End If
    If GetExitCodeProcess(ExecInfo.hProcess, lExitCode) <> 0 Then
      If lExitCode = 0 Then
        ExecuteProcess = res_OK
      Else
        ExecuteProcess = res_FAILED
      End If
    Else
      ExecuteProcess = res_FAILED
    End If
    Call CloseHandle(ExecInfo.hProcess)
  Else
    ExecuteProcess = res_CANCEL
  End If
End Function

Sub Main()
  If IsAdministrator Then
    FormMain.Show
  Else
    'запускаем себя же из-под администратора и выходим
    Dim FilePath As String
    FilePath = App.Path & "\" & App.EXEName & ".exe"
    ExecuteProcessAndExit FilePath, 0, SW_SHOWNORMAL, , True
  End If
End Sub


Public Function ExecuteProcessAndExit(ByVal FilePath As String, ByVal hwnd As Long, _
 ByVal nShow As Long, Optional lpParameters As String = "", _
 Optional LaunchElevated As Boolean = False) As ExecuteStatus 'nShow - напр.SW_SHOWNORMAL
 
  Dim ExecInfo As SHELLEXECUTEINFO
  Dim lExitCode As Long

  With ExecInfo
    ' Set up the structure.
    .cbSize = Len(ExecInfo)
    .fMask = SEE_MASK_DEFAULT 'вызывающий процесс не ждет кода завершения от вызываемого
    .lpFile = FilePath
    .nShow = nShow
    .lpDirectory = ExtractDirectoryFromPath(FilePath)
    .lpParameters = lpParameters
    .hwnd = hwnd

    ' On Microsoft Windows Vista and later, one can use runas instead of Open, in order to execute the
    ' process as an elevated process. In that case, the user will be asked whether he or she wants to
    ' run the process as an administrator.
    If LaunchElevated = True Then
      .lpVerb = "runas"
    Else
      .lpVerb = "Open"
    End If
  End With

  If ShellExecuteEx(ExecInfo) Then
    ExecuteProcessAndExit = res_OK
  Else
    ExecuteProcessAndExit = res_CANCEL
  End If
End Function