elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Como proteger una cartera - billetera de Bitcoin


  Mostrar Mensajes
Páginas: [1] 2 3 4 5 6
1  Programación / Programación Visual Basic / Encontrar una cadena en una lista de cadenas con 3 opciones en: 21 Marzo 2020, 18:33 pm
Hola a todos:

Ya se que pensareis que es una pregunta muy documentada pero...
Tengo un montón de ejemplos de código para, en teoría, hacer esto, pero ninguno funciona.

Explico lo que se necesita.

Tengo por ejemplo, estos nombres de archivos en un ListBox:
Sonia
SoniA - Co(2)
sOnIa - copia
sonia
Dario_Sonia_1
PepeSoNia_2(a)
OscarMariSoniA
Imagen_1
JorjePepe_2

Y el nombre a buscar en el ListBox es "Sonia"

Y hay 3 posibilidades de coincidencias, dependiendo de el estado de 2 CheckBox

1 - nombre exacto en nº de caracteres y case sensitive en cada una de las letras
solo devolvería"Sonia"

2 - nombre que contiene mismo nº de caracteres y case sensitive en cada una de las letras
devolvería "Sonia"
devolvería "Dario_Sonia_1"

3 - nombre que contiene mismo nº de caracteres y No case sensitive en cada una de las letras
devolvería "Sonia"
devolvería "SoniA - Co(2)"
devolvería "sOnIa - copia"
devolvería "sonia"
devolvería "Dario_Sonia_1"
devolvería "PepeSoNia_2(a)"
devolvería "OscarMariSoniA"

Yo he escrito un código que funciona al 100%, pero lo publico aquí por si alguien me sugiere si hay una forma mas fácil, o más "profesional" de hacerlo.
Y no comprendo como no he sido capaz de encontrar un código que haga esto en ningún sitio, supongo que no seré el único que necesita este tipo de código.

Esto es lo que tengo:


Código
  1.  
  2. Private sub Buscar(s1 as string,busca as string)
  3.         If Form1.CheckExacto.Value = 1 Then  'Exacto
  4.             If s1 = busca Then
  5.                 'lo ha conseguido
  6.                 Exit Sub
  7.             Else
  8.                 Exit Sub
  9.             End If
  10.         End If
  11.         If Form1.CheckCase.Value = 0 Then   'No Case sensitive
  12.                 Test = Igual(s1, busca, False)
  13.                 If Test Then
  14.                     'lo ha conseguido
  15.                 Else:
  16.                     Exit Sub
  17.                 End If
  18.                 Exit Sub
  19.         Else    'Case sensitive
  20.                 Test = Igual(s1, busca, True)
  21.                 If Test Then
  22.                     'lo ha conseguido
  23.                 Else:
  24.                     Exit Sub
  25.                 End If
  26.                 Exit Sub
  27.         End If
  28.  
  29. Public Function Igual(st As String, buscar As String, Sen As Boolean) As Boolean
  30.     Dim i As Integer, s As String, L As Integer, s1 As String, c As Byte, letra As Byte
  31.     s = Trim(st)
  32.     L = Len(buscar)
  33.     letra = Asc(Left(buscar, 1))
  34.     Igual = False
  35.     For i = 1 To Len(s)
  36.         c = Asc(Mid(s, i, 1))
  37.         s1 = Mid(s, i, L)
  38.         If Compara(s1, buscar, Sen) Then
  39.             Igual = True
  40.             Exit For
  41.         End If
  42.     Next
  43. End Function
  44.  
  45. Public Function Compara(dato As String, Busca As String, Sen As Boolean) As Boolean
  46.     Dim i As Integer, c As Byte, n As Integer, b As Byte
  47.     n = 0
  48.     For i = 1 To Len(Busca)
  49.         c = Asc(Mid(dato, i, 1))
  50.         b = Asc(Mid(Busca, i, 1))
  51.         If Sen Then
  52.             If c = b Then
  53.                 n = n + 1
  54.             End If
  55.         Else
  56.             If (c Or &H20) = b Or c = b Or (c Xor &H20) = b Then
  57.                 n = n + 1
  58.             End If
  59.         End If
  60.     Next
  61.     If n = Len(Busca) Then
  62.         Compara = True
  63.     End If
  64. End Function
  65.  
  66.  

Un saludo.
2  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 15 Febrero 2020, 12:47 pm
Perfecto...

Se queda así:

Código:
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.
3  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 14 Febrero 2020, 22:36 pm
Yo no utilizo DrawMenuBar, quiero que desaparezcan
4  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 14 Febrero 2020, 22:33 pm
Si tienen que ser no accesibles, pero operativos para el programa
5  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 14 Febrero 2020, 19:53 pm
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:
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.
 
6  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 13 Febrero 2020, 19:19 pm
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:
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.
7  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 6 Febrero 2020, 19:46 pm
Gracias tengo un código de lupa que usaba con el Picture, pero este me gusta, creo que es el mismo que me ha pasado FJDA
8  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 6 Febrero 2020, 19:43 pm



Hola NEBIRE:

Pues yo da daba por supuesto que el código que me pasaste, solucionaba el asunto de los nombres raros, pero como yo parece que tengo archivos jpg con nombres que nadie tiene, pues las pruebas hasta ahora me reconocía todos, pues recorriendo las carpetas escaneadas por el programa, me encuentro una que no tiene archivos jpg, pero si los tiene, solo que el programa al encontrarlos (son 3) no los añade a la lista dcha azul, por que los nombres no son válidos, tu código devuelve "" vacío.
Pero estos 3 jpg se visualizan perfectamente en el visor de Win clicados en su carpeta.

Mira las imágenes del programa y de la ruta de los 3 archivos.
Estos nombre son estos:
Výstřižek1.JPG
Výstřižek3.JPG
Výstřižek4l.JPG

Y nombres chinos si los acepta, no lo entiendo.
Posiblemente me encuentre otros, es muy dificil chequearlso todos, tengo mas de 65000 imágenes jpg a procesar.
9  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 6 Febrero 2020, 10:44 am
Cita de: FJDA en  5 Febrero 2020, 19:22 pm
a ver, esto lo que hace es inhabilitar la ventana Photos_PhotoCanvas que contiene la imagen. De este modo no se puede usar el ratón (solo en Photos_PhotoCanvas)

Pues lo siento pero inutiliza poder hacer zoom y mover la imagen, es lógico, pero esto no me sirve.

Gracias.
10  Programación / Programación Visual Basic / Re: Alguien sabe como conseguir esto en: 6 Febrero 2020, 10:42 am
Citar
Te pongo un código de ejemplo que soluciona el caso, mediante una simple API...
Y luego una imagen... nota que la imagen es una captura de tu mensaje, pero el nombre de la imagen es el mismo que tu tienes ahí arriba y nota como la imagen se carga perfectamente con este modo...

Otros problemas que tengas con los picturebox, se pueden ir viendo, si describes el problema en cuestión.

Hola NEBIRE:

Gracias por tu ayuda.
Efectivamente este código soluciona el problema.
Y esto me sugiere que podría volver a utilizar un PictureBox como visor...
Pero necesito un código para poder hacer zoom con la rueda del ratón, y poder mover la imagen con zoom pulsando el botón Iqdo del ratón y mover.

Tengo código para mover imagen pero con scroll H-V, y esto no me gusta nada, es muy limitado e incómodo.
Y tengo código de Lupa pero en una ventana externa, no ampliando imagen en el Picture.

Puedes ayudarme en esto, sería perfecto.

Por que con esta solución solucionaría el problema de que el usuario pueda pulsar botón dcho y acceder a los menues que permiten hacer lo mismo que yo inhabilito.

Por que la solución que me dio FJDA  de inhabilitar la ventana de la imagen
Código:
Call EnableWindow(hPhotos_PhotoCanvas, vbFalse)

Funciona, pero inutiliza poder hacer zoom y mover la imagen, es lógico, pero esto no me sirve.
Páginas: [1] 2 3 4 5 6
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines