Alguien sabe como conseguir esto

[Fran1946]

He tardado un poco en responder por que he  estado estudiando y probando el código que me habéis suministrado.

Ante todo muchísimas gracias, por vuestra ayuda.

NEBIRE:
El código nuevo (ampliado) tampoco funciona con los malditos nombres raros, pero el anterior si funciona para nombres chinos y alguno mas, así que utilizo este, y en los casos de archivos que no los pueda reconocer, pues simplemente no los añade a la lista, en mi caso solo tengo esos 3 archivos que son checos.

FJDA:
La opción que sugieres de renombrar archivos es inviable, tienen que conservar sus nombres originales, por que algunas imágenes jpg se utilizan en alguna aplicación y si cambian el nombre las consecuencias pueden ser desastrosas.

Ya tengo todo resuelto excepto este código que pongo aquí (Solo hay una línea de código que no consigo que funcione), y es la que tiene este comentario:

'Aquí necesito obtener Hwnd de los MenuID, para añadirlos a List1

El código:

Código [Seleccionar] Expandir

Private Sub Command1_Click()
    Dim Handle As Long
    Dim hWnd As Long
    Dim hMainMenu As Long
    Dim hMenu As Long
    Dim MenuID As Long
    Dim szbuf As String * 128
    Dim szBufM As String * 128
    Dim I, Z, X
    List1.Clear
    List2.Clear
    List3.Clear
    List4.Clear
    Z = 2 'Posición del menú
    I = 0 'Posición del submenú
    For I = 0 To 30
        hWnd = FindWindow("SDPaintApp", vbNullString)   'handle Ventana aplicación
        If hWnd = 0 Then Exit Sub
        hMainMenu = GetMenu(hWnd)
        hMenu = GetSubMenu(hMainMenu, Z)
        MenuID = GetMenuItemID(hMenu, I)
        Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)
        If MenuID > 0 Then
            List1.AddItem hMainMenu
            List2.AddItem hMenu
            List3.AddItem MenuID
            List4.AddItem szbuf 'Nombre del menú
            'X = SendMessage(hWnd, WM_COMMAND, MenuID, 0&)  esto ejecuta el MenuID
            'Aquí necesito obtener Hwnd de cada MenuID, para añadirlos a un ListBox
        End If
    Next
End Sub


Espero que esto sea muy fácil para vosotros.
Gracias.

[FJDA]

           'Aquí necesito obtener Hwnd de cada MenuID, para añadirlos a un ListBox

No  te lo puedo asegurar pero los submenus si es a lo que te refieres no tiene handle. Para diregirte a ellos usa MenuID tal como has hecho.

Este código rastrea todos los menús y submenus, es similar al tuyo. Pero tal como muestro la información te quedará más claro.En un nuevo proyecto, crea 4 listbox tal como lo pusistes y un botón y pega este código.

Código (vb) [Seleccionar] Expandir


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos 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 GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" _
(ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, _
ByVal nMaxCount As Long, ByVal wFlag As Long) As Long

Const WM_COMMAND = &H111
Const WM_SYSCOMMAND = &H112
Const MF_BYPOSITION = &H400&
Const MF_POPUP = &H10&
Const SW_NORMAL = 1
Const SW_HIDE = 0

Private Sub Command1_Click()
   Dim n As Variant
   Dim hMainMenu As Long
   Dim hMenu As Long
   Dim MenuID As Long
   Dim MenuCount As Long
   Dim stringmenu As String
   Dim szbuff As String * 128
   Dim cabBuff As String * 128
   Dim HwndParent As Long
   Dim nPos As Integer
   Dim nID As Integer
   HwndParent = FindWindow("Notepad", vbNullString)
   If HwndParent = 0 Then Exit Sub
   hMainMenu = GetMenu(HwndParent)    'Obtiene el handle del menú de Notepad
   MenuCount = GetMenuItemCount(hMainMenu) 'Cuenta el número de menús (no submenus)
   For nPos = 0 To MenuCount - 1 'Bucle como tantos menús tenga notepad (son 5: 0,1,2,3,4)

       '//Obtiene las cabeceras
       Call GetMenuString(hMainMenu, nPos, cabBuff, 128, MF_BYPOSITION)
       List1.AddItem nPos & ": " & cabBuff
       For nID = -1 To 1000 'Como no se cuantos submenus tiene bucleo desde -1 al 1000 (se empieza desde -1)
           hMenu = GetSubMenu(hMainMenu, nPos) 'Obtiene el handle del submenú del menú Z
           MenuID = GetMenuItemID(hMenu, nID) 'Obtiene el ID del submenú
           If MenuID > -1 And MenuID > 0 Then
               Call GetMenuString(hMenu, MenuID, szbuff, 128, MF_BYPOSITION & MF_POPUP)
                   List2.AddItem "cab:" & nPos & "-> " & hMenu   '//Handle
                   List3.AddItem "cab:" & nPos & "-> " & MenuID   '//MenuID
                   List4.AddItem "cab:" & nPos & "-> " & szbuff   '//Nombre
               End If
       Next nID
   Next nPos
'//DEMOSTRACIÓN'//
'/////////////////////////////////
'//Envía un mensaje a Notepad
'//para que ejecute el menú Ayuda
'/////////////////////////////////
AppActivate "Sin título: Bloc de notas" '//Activa el notepad
MenuID = 65& '//-<--Introduce el ID del menú en la variable
SendMessage HwndParent, WM_COMMAND, MenuID, 0&    'esto ejecuta el ID 65 (Acerca de bloc de notas)

End Sub


Private Sub Form_Load()
'Inicia notepad.exe
Dim X As Long, hw As Long
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.Shell")
WshShell.Run "cmd.exe start  /r notepad.exe", SW_HIDE, 0

End Sub



Puedes usar GetMenuItemInfo par obtener información de menús, por ejemplo si están checkeados e igualmente los nombres, por ejemplo. Pero hSubMenu siempre te devolverá 0 si no me equivoco.

Código (vb) [Seleccionar] Expandir


Private Type MENUITEMINFO
   cbSize As Long
   fMask As Long
   fType As Long
   fState As Long
   wID As Long
   hSubMenu As Long
   hbmpChecked As Long
   hbmpUnchecked As Long
   dwItemData As Long
   dwTypeData As String
   cch As Long
End Type

Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" _
(ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long


[Fran1946]

Muy bueno este código, este es para mi colección seguro que lo utilizaré.

Te he mandado un mensaje.

Lo que necesito hacer es que queden inaccesibles todos los menúes, y lo he conseguido así:

Código [Seleccionar] Expandir

Private Sub Command1_Click()
    'Dim Handle As Long
    Dim hWnd As Long
    Dim hMainMenu As Long
    Dim hMenu As Long
    Dim MenuID As Long
    Dim menuFlag As Long
    Dim szbuf As String * 128
    Dim szBufM As String * 128
    Dim i As Long, Z As Integer, x As Integer, j As Integer
1:
    List1.Clear
    List4.Clear
    Z = 0 'Posición del menú
    For i = 0 To 10
        hWnd = FindWindow("SDPaintApp", vbNullString)   'handle Ventana aplicación
        If hWnd = 0 Then Exit Sub
        hMainMenu = getmenu(hWnd)
        hMenu = GetSubMenu(hMainMenu, Z)
        MenuID = GetMenuItemID(hMenu, i)
        menuFlag = GetMenuState(hMenu, MenuID, MF_BYCOMMAND)
        Handle = Handle
        Call GetMenuString(hMenu, MenuID, szbuf, 128, MF_BYPOSITION & MF_POPUP)
        If MenuID > 0 Then
            List1.AddItem hMainMenu
            List4.AddItem szbuf 'Nombre del menú
            RemoveMenu hMainMenu, i, MF_BYPOSITION Or MF_DISABLED
            'X = SendMessage(hWnd, WM_COMMAND, MenuID, 0&)  esto ejecuta el MenuID
        End If
    Next
    x = List1.ListCount
    If x = 0 Then
        Call SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, 1 Or 2)   'encima
        Exit Sub
    Else
        GoTo 1
    End If
End Sub


Seguramente tu tienes una solución mejor, pero esta funciona perfecto.

Un saludo.
 

[FJDA]

Muy bueno este código, este es para mi colección seguro que lo utilizaré.

Te he mandado un mensaje.

Lo que necesito hacer es que queden inaccesibles todos los menúes, y lo he conseguido así:

---

¿inaccesibles pero operativos o solo inaccesibles?

Puedes usar esta función la función API RemoveMenu:

Código [Seleccionar] Expandir

Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Código (vb) [Seleccionar] Expandir

Public Function EliminarMenu(ByVal hwndAPP As Long)
   Dim HWNDMenu As Long
   Dim idpOS As Long
   Dim i As Integer
   Dim N As Long
Dim d As Long
   'hwnd del menu del programa
   HWNDMenu = GetMenu(hwndAPP)
   If HWNDMenu Then
       n_Menu = GetMenuItemCount(HWNDMenu)
       If n_Menu Then
       For i = 1 To n_Menu     'Recorre todos los menú y los elimina
       Call RemoveMenu(HWNDMenu, 0, MF_BYPOSITION)
       Next
       Call DrawMenuBar(hwndAPP)     'Repinta la barra de menú
       End If
   End If
End Function

Código (vb) [Seleccionar] Expandir


Call EliminarMenu(hwndAPP)


EJEMPLO:

Código (vb) [Seleccionar] Expandir


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Const MF_BYPOSITION = &H400&

Dim hwndAPP As Long

Private Sub Form_Load()
Shell "notepad.exe", vbNormalFocus
Do While hwndAPP = 0
hwndAPP = FindWindow("Notepad", vbNullString)
DoEvents
Loop
End Sub
'//Oculgar menú
Private Sub Command1_Click()
Call EliminarMenu(hwndAPP)
End Sub

Public Function EliminarMenu(ByVal hwndAPP As Long)
   Dim HWNDMenu As Long
   Dim idpOS As Long
   Dim i As Integer
   Dim N As Long
Dim d As Long
   'hwnd del menu del programa
   HWNDMenu = GetMenu(hwndAPP)
   If HWNDMenu Then
       n_Menu = GetMenuItemCount(HWNDMenu)
       If n_Menu Then
       For i = 1 To n_Menu     'Recorre todos los menú y los elimina
       Call RemoveMenu(HWNDMenu, 0, MF_BYPOSITION)
       Next
       Call DrawMenuBar(hwndAPP)  
       End If
   End If
End Function


[Fran1946]

Si tienen que ser no accesibles, pero operativos para el programa

[Fran1946]

Yo no utilizo DrawMenuBar, quiero que desaparezcan

[FJDA]

Si tienen que ser no accesibles, pero operativos para el programa

No te preocupes siguen estando operativos
edito:
Pero debes obtener el MenuID que quieres usar, meterlos en memoria en un array por ejemplo, porque una vez borrado no se puede obtener el ID.

Mira prueba:

Código (vb) [Seleccionar] Expandir


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd 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 Const MF_BYPOSITION = &H400&
Private Const WM_COMMAND = &H111

Dim hwndAPP As Long

Private Sub Form_Load()
Shell "notepad.exe", vbNormalFocus
Do While hwndAPP = 0
hwndAPP = FindWindow("Notepad", vbNullString)
DoEvents
Loop
Call EliminarMenu(hwndAPP)
End Sub

Private Sub Command1_Click()
Dim MenuID As Long
MenuID = 65&
AppActivate "Sin título: Bloc de notas"
SendMessage hwndAPP, WM_COMMAND, MenuID, 0&
End Sub

Public Function EliminarMenu(ByVal hwndAPP As Long)
    Dim HWNDMenu As Long
    Dim idpOS As Long
    Dim i As Integer
    Dim N As Long
Dim d As Long
    'hwnd del menu del programa
    HWNDMenu = GetMenu(hwndAPP)
    If HWNDMenu Then
        n_Menu = GetMenuItemCount(HWNDMenu)
        If n_Menu Then
        For i = 1 To n_Menu     'Recorre todos los menú y los elimina
        Call RemoveMenu(HWNDMenu, 0, MF_BYPOSITION)
        Next
        Call DrawMenuBar(hwndAPP)     'Repinta la barra de menú
        End If
    End If
End Function



[Fran1946]

Perfecto...

Se queda así:

Código [Seleccionar] Expandir

Public Function EliminarMenu(ByVal hwndAPP As Long)
    Dim HWNDMenu As Long
    Dim i As Integer, n_Menu As Long
   
    'hwnd del menu del programa
    HWNDMenu = GetMenu(hwndAPP)
    SendMessage hwndAPP, WM_COMMAND, 57642, 0&    'esto ejecuta Crt+E Seleccionar todo
    If HWNDMenu Then
        n_Menu = GetMenuItemCount(HWNDMenu)
        If n_Menu Then
            For i = 1 To n_Menu     'Recorre todos los menú y los elimina
                Call RemoveMenu(HWNDMenu, 0, MF_BYPOSITION)
            Next
            Call DrawMenuBar(hwndAPP)     'Repinta la barra de menú, actualiza la App
        End If
    End If
End Function


Se ejecuta Ctr+E para que el cursor del mouse no tenga el icono del lápiz, que podría pintar y arruinar el proceso.

Una vez mas, muchísimas gracias.

[FJDA]

Perfecto...

Se queda así:

Código [Seleccionar] Expandir

Public Function EliminarMenu(ByVal hwndAPP As Long)
   Dim HWNDMenu As Long
   Dim i As Integer, n_Menu As Long
   
   'hwnd del menu del programa
   HWNDMenu = GetMenu(hwndAPP)
   SendMessage hwndAPP, WM_COMMAND, 57642, 0&    'esto ejecuta Crt+E Seleccionar todo
   If HWNDMenu Then
       n_Menu = GetMenuItemCount(HWNDMenu)
       If n_Menu Then
           For i = 1 To n_Menu     'Recorre todos los menú y los elimina
               Call RemoveMenu(HWNDMenu, 0, MF_BYPOSITION)
           Next
           Call DrawMenuBar(hwndAPP)     'Repinta la barra de menú, actualiza la App
       End If
   End If
End Function


Se ejecuta Ctr+E para que el cursor del mouse no tenga el icono del lápiz, que podría pintar y arruinar el proceso.

Una vez mas, muchísimas gracias.

al final te sirvío  

VB todavía no está muerto, bien por el foro que permita esta sección.

Aunque la mayoría de preguntas sobre   sql y base de datos, pero casi todas alguien las responde, aunque muchas con poca gana. También mucha gente se equivoca y hace preguntas sobre VB.NET, ya hay otra sección para eso.  Ayudarte me ha servido para recordar como era esto de programar (pero venía rodado por ayudar a otro usuario antes que a tí que si no...)