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

 

 


Tema destacado: AIO elhacker.NET 2021 Compilación herramientas análisis y desinfección malware


  Mostrar Mensajes
Páginas: 1 2 3 4 [5] 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ... 128
41  Foros Generales / Sugerencias y dudas sobre el Foro / Cambiar nombre al foro de Programación Visual Basic en: 12 Enero 2013, 13:13 pm
Propongo esto pues cada dos por tres entra gente despistada poniendo dudas y códigos de vb.net, el cual ya tiene foro específico. :-\
Creo que si se cambiara el nombre a Programación Visual Basic 6 ahorraría trabajo a los moderadores, que están moviendo temas constantemente y contribuiría a la limpieza del foro. :)

¿Qué os parece? :huh:

DoEvents! :P
42  Programación / Programación Visual Basic / Re: [RETO] Ruta más oculta en: 12 Enero 2013, 10:42 am
ATENCIÓN: He añadido un detalle en la explicación del reto.



La forma que se me había ocurrido es similar a la de seba123neo... Pero estoy convencido de que se puede hacer sin guardar todas las carpetas, se ahorraría muchísimo tiempo. Sigo pensando. :rolleyes:


Cometi el error de copypastear tu codigo en una CMD.

CUIDADO CON EL PESO DEL TXT!


 :laugh:

DoEvents! :P
43  Programación / Programación Visual Basic / Re: [RETO] Ruta más oculta en: 11 Enero 2013, 18:30 pm
Claro, hay que sacar la ruta más profunda. ;)

DoEvents! :P
44  Programación / Programación Visual Basic / [RETO] Ruta más oculta en: 11 Enero 2013, 12:14 pm
Pues eso, consiste en encontrar la manera más rápida de obtener la última carpeta accesible a partir de una ruta, los formatos válidos son estos:
Código
  1. Public Function getLastFolder(Byval sStartPath As String) As String()
  2. Public Function getLastFolder(Byval sStartPath As String) As Collection

Ejemplo:
Código
  1. Debug.Print getLastFolder("C:\Users\casa-pc\Desktop\")
  2.  
Código:
C:\Users\casa-pc\Desktop\Música\Sonido\Programas\Video\VLC\data\res

Consiste en encontrar la carpeta más profunda, en caso de haber más de una la función devolverá el resultado en una collection o en un array.

¡Suerte! :)
45  Programación / Programación Visual Basic / Re: [Reto] UrlEncode y UrlDecode en: 22 Diciembre 2012, 21:15 pm
Ok, se me escapó. :silbar: Gracias, ya lo he corregido.
Ahora tan sólo queda hacer los test con CTiming. :)

DoEvents! :P
46  Programación / Programación Visual Basic / Re: Obtener tabla de página web en: 22 Diciembre 2012, 20:04 pm
Las expresiones regulares pueden facilitarte mucho las cosas. ;)

DoEvents! :P
47  Programación / Programación Visual Basic / Re: [Reto] UrlEncode y UrlDecode en: 22 Diciembre 2012, 02:10 am
Bueno, aquí dejo mi forma de hacerlo. :)
Lo he planteado de una manera un poco diferente y es bastante rápido. Aún así, quizás se podría agilizar aún más con algo de magia negra, pero como la cadena de la url va a ser relativamente corta supongo que no habrá una diferencia muy notable. :silbar:
Si veis cosas a añadir o a mejorar decirlo, aunque creo que se adapta a lo que pide LeandroA en el primer post. ;)



Módulo:
Código
  1. Option Explicit
  2. '============================================================================
  3. ' º Module     : mFastUrlEncode.bas
  4. ' º Author     : Psyke1
  5. ' º Mail       : psyke1@elhacker.net
  6. ' º Date       : 22/12/2012
  7. ' º Recommended Websites :
  8. '       http://foro.h-sec.org
  9. '       http://infrangelux.sytes.net
  10. '============================================================================
  11.  
  12. '// msvbvm60.dll
  13. Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Ptr As Long, ByVal Value As Long)
  14.  
  15. '// oleaut32.dll
  16. Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" (ByVal Ptr As Long, ByVal Length As Long) As Long
  17.  
  18. '// kernel32.dll
  19. Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
  20. Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
  21.  
  22. Private Const CP_UTF8                           As Long = &HFDE9&
  23. Private Const STR_VALID_CHARS                   As String = "QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm1234567890-_.:~%&="
  24.  
  25. Public Static Function URLEncode(ByVal sUrl As String, _
  26.                                 Optional ByVal bSpacePlus As Boolean, _
  27.                                 Optional ByVal bUTF8 As Boolean = True) As String
  28.  
  29. Dim Q                                           As Long
  30. Dim sHex                                        As String
  31. Dim sChr                                        As String * &H1
  32. Dim lRet                                        As Long
  33. Dim lLen                                        As Long
  34. Dim lStart                                      As Long
  35. Dim sBuffer                                     As String
  36.  
  37.    lLen = LenB(sUrl)
  38.    If lLen Then
  39.        lStart = InStrB(&H1, sUrl, "=", vbBinaryCompare) - &H1
  40.  
  41.        If lStart > -&H1 Then
  42.            lRet = lLen - lStart
  43.            URLEncode = RightB$(sUrl, lRet)
  44.  
  45.            If bUTF8 Then
  46.                PutMem4 VarPtr(sBuffer), SysAllocStringByteLen(&H0, (lRet + lRet))
  47.  
  48.                lRet = WideCharToMultiByte(CP_UTF8, &H0, _
  49.                                           StrPtr(URLEncode), (lRet \ &H2), _
  50.                                           StrPtr(sBuffer), lRet, _
  51.                                           vbNullString, &H0)
  52.  
  53.                URLEncode = LeftB$(StrConv(sBuffer, vbUnicode), (lRet + lRet))
  54.            End If
  55.  
  56.            Q = &H3
  57.  
  58.            Do While Q < lLen
  59.                sChr = MidB$(URLEncode, Q, &H2)
  60.  
  61.                If sChr = "%" Then
  62.                    Q = Q + &H6
  63.                ElseIf InStrB(&H1, STR_VALID_CHARS, sChr, vbBinaryCompare) = &H0 Then
  64.                    sHex = Hex$(AscW(sChr))
  65.                    If LenB(sHex) < &H4 Then sHex = "0" & sHex
  66.  
  67.                    URLEncode = Replace$(URLEncode, sChr, ("%" & sHex), , , vbBinaryCompare)
  68.  
  69.                    lLen = LenB(URLEncode)
  70.                    Q = Q + &H6
  71.                Else
  72.                    Q = Q + &H2
  73.                End If
  74.            Loop
  75.  
  76.            If bSpacePlus Then
  77.                URLEncode = Replace$(URLEncode, "%20", "+", , , vbBinaryCompare)
  78.            End If
  79.  
  80.            URLEncode = (LeftB$(sUrl, lStart) & URLEncode)
  81.        Else
  82.            URLEncode = sUrl
  83.        End If
  84.    End If
  85. End Function
  86.  
  87. Public Static Function URLDecode(ByVal sUrl As String, _
  88.                                 Optional ByVal bSpacePlus As Boolean, _
  89.                                 Optional ByVal bUTF8 As Boolean = True) As String
  90.  
  91. Dim sHex                                        As String
  92. Dim lPos                                        As Long
  93. Dim lLen                                        As Long
  94. Dim lStart                                      As Long
  95. Dim sBuffer                                     As String
  96.  
  97.    If LenB(sUrl) Then
  98.        lStart = InStrB(&H1, sUrl, "=", vbBinaryCompare) + &H2
  99.        URLDecode = sUrl
  100.  
  101.        If lStart > &H2 Then
  102.            lPos = InStrB(lStart, URLDecode, "%", vbBinaryCompare)
  103.  
  104.            Do While lPos
  105.                lPos = lPos + &H2
  106.                sHex = MidB$(URLDecode, lPos, &H4)
  107.                If LenB(sHex) = &H0 Then Exit Do
  108.  
  109.                URLDecode = Replace$(URLDecode, ("%" & sHex), ChrW$("&H" & sHex), , , vbBinaryCompare)
  110.                lPos = InStrB(lPos, URLDecode, "%", vbBinaryCompare)
  111.            Loop
  112.  
  113.            If bSpacePlus Then
  114.                URLDecode = Replace$(URLDecode, "+", " ", , , vbBinaryCompare)
  115.            End If
  116.  
  117.            If bUTF8 Then
  118.                lLen = LenB(URLDecode) \ &H2
  119.                PutMem4 VarPtr(sBuffer), SysAllocStringByteLen(&H0, lLen + lLen)
  120.  
  121.                lLen = MultiByteToWideChar(CP_UTF8, &H0, _
  122.                       StrPtr(StrConv(URLDecode, vbFromUnicode)), lLen, _
  123.                       StrPtr(sBuffer), lLen)
  124.  
  125.                URLDecode = LeftB$(sBuffer, (lLen + lLen))
  126.            End If
  127.        End If
  128.    End If
  129. End Function
  130.  



Pruebas:
Código
  1. Option Explicit
  2.  
  3. Private Sub Form_Load()
  4. Dim vURL                                    As Variant
  5. Dim vArr()                                  As Variant
  6. Dim sEncodedURL                             As String
  7.  
  8.    vArr() = Array("https://www.google.com.ar/search?q=canción del caballo", _
  9.                   "http://www.taringa.net/buscar/?q=día 12/12/12&interval=", _
  10.                   "https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1", _
  11.                   "https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch")
  12.  
  13.    Debug.Print
  14.    Debug.Print String$(15, "-"); Time$; String$(227, "-")
  15.  
  16.    For Each vURL In vArr
  17.        Debug.Print String$(250, "=")
  18.        Debug.Print "Original :", vURL
  19.  
  20.        sEncodedURL = URLEncode(vURL)
  21.        Debug.Print "Enc&Dec  :", URLDecode(sEncodedURL)
  22.        Debug.Print "Enc      :", sEncodedURL
  23.  
  24.        sEncodedURL = URLEncode(vURL, True)
  25.        Debug.Print "Enc&Dec+ :", URLDecode(sEncodedURL, True)
  26.        Debug.Print "Enc+     :", sEncodedURL
  27.    Next vURL
  28.  
  29.    Debug.Print String$(250, "=")
  30. End Sub



Resultado:
Código:
---------------01:55:53-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
==========================================================================================================================================================================================================================================================
Original :    https://www.google.com.ar/search?q=canción del caballo
Enc&Dec  :    https://www.google.com.ar/search?q=canción del caballo
Enc      :    https://www.google.com.ar/search?q=canci%C3%B3n%20del%20caballo
Enc&Dec+ :    https://www.google.com.ar/search?q=canción del caballo
Enc+     :    https://www.google.com.ar/search?q=canci%C3%B3n+del+caballo
==========================================================================================================================================================================================================================================================
Original :    http://www.taringa.net/buscar/?q=día 12/12/12&interval=
Enc&Dec  :    http://www.taringa.net/buscar/?q=día 12/12/12&interval=
Enc      :    http://www.taringa.net/buscar/?q=d%C3%ADa%2012%2F12%2F12&interval=
Enc&Dec+ :    http://www.taringa.net/buscar/?q=día 12/12/12&interval=
Enc+     :    http://www.taringa.net/buscar/?q=d%C3%ADa+12%2F12%2F12&interval=
==========================================================================================================================================================================================================================================================
Original :    https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1
Enc&Dec  :    https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1
Enc      :    https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http%3A%2F%2Fmail.live.com%2Fdefault.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1
Enc&Dec+ :    https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http://mail.live.com/default.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1
Enc+     :    https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1312101221&rver=6.1.6206.0&wp=MBI&wreply=http%3A%2F%2Fmail.live.com%2Fdefault.aspx&lc=2058&id=64855&mkt=es-US&cbcxt=mai&snsc=1
==========================================================================================================================================================================================================================================================
Original :    https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch
Enc&Dec  :    https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch
Enc      :    https://www.google.com.ar/search?q=casa%20duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr%3A1%2Ccd_min%3A5%2F12%2F2012%2Ccd_max%3A18%2F12%2F2012&tbm=isch
Enc&Dec+ :    https://www.google.com.ar/search?q=casa duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr:1,cd_min:5/12/2012,cd_max:18/12/2012&tbm=isch
Enc+     :    https://www.google.com.ar/search?q=casa+duplex&num=10&hl=es&safe=off&biw=1680&bih=925&sa=X&ei=mS7RUIqvHYjW8gSA9oHABg&ved=0CBkQpwUoAw&source=lnt&tbs=cdr%3A1%2Ccd_min%3A5%2F12%2F2012%2Ccd_max%3A18%2F12%2F2012&tbm=isch
==========================================================================================================================================================================================================================================================

DoEvents! :P
48  Programación / Programación Visual Basic / Re: Me recomiendan un buen troyano con codigo abierto en VB en: 6 Diciembre 2012, 01:02 am
LeandroA hizo esto hace tiempo:
Código:
http://leandroascierto.com/blog/explorador-remoto-proyecto-en-marcha/
http://leandroascierto.com/blog/proyecto-en-marcha-parte-2/

Está completo y el código está bastante claro. :)

DoEvents! :P
49  Programación / Programación Visual Basic / Re: No consigo que mi app se ejecute al inicio en: 5 Diciembre 2012, 13:03 pm
Ok, ok... ya está solucionado. ¡Gracias a todos por vuestro tiempo! :)

Lo arreglé así:
Código
  1. Option Explicit
  2.  
  3. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  4. 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
  5. 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
  6.  
  7. Private Const HKEY_CURRENT_USER     As Long = &H80000001
  8. Private Const KEY_WRITE             As Long = &H20006
  9. Private Const REG_SZ                As Long = &H1
  10.  
  11. Public Function PutOnStartUp(ByVal sPath As String) As Boolean
  12. Dim hRegkey                         As Long
  13.  
  14.    If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_WRITE, hRegkey) = 0 Then
  15.        PutOnStartUp = RegSetValueEx(hRegkey, "HolaLeandro", 0, REG_SZ, ByVal sPath, Len(sPath)) = 0
  16.        RegCloseKey hRegkey
  17.    End If
  18. End Function
  19.  
  20. Private Sub Form_Load()
  21. Dim sPath      As String
  22. Dim sDest      As String
  23.  
  24.    sPath = App.Path & "\" & App.EXEName & ".exe"
  25.    sDest = Environ("APPDATA") & "\Test.exe"
  26.  
  27.    If sDest <> sPath Then
  28.       FileCopy sPath, sDest
  29.  
  30.       If PutOnStartUp(sDest) Then
  31.           Me.BackColor = vbGreen
  32.       Else
  33.           Me.BackColor = vbRed
  34.       End If
  35.    End If
  36.  
  37.    Me.AutoRedraw = True
  38.    Me.Print sPath
  39.    Me.Print sDest
  40. End Sub

Tiene lógica:
Sí se ejecutaba al inicio, pero como intentaba sobrescribir la entrada del registro daba error. :¬¬

DoEvents! :P
50  Programación / Programación Visual Basic / Re: No consigo que mi app se ejecute al inicio en: 4 Diciembre 2012, 20:43 pm
He cambiado lo que dices, ahora hago esto:
Código
  1. Option Explicit
  2.  
  3. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  4. 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
  5. 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
  6.  
  7. Private Const HKEY_CURRENT_USER     As Long = &H80000001
  8. Private Const KEY_WRITE             As Long = &H20006
  9. Private Const REG_SZ                As Long = &H1
  10.  
  11. Public Function PutOnStartUp(ByVal sPath As String) As Boolean
  12. Dim hRegkey                         As Long
  13.  
  14.    If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_WRITE, hRegkey) = 0 Then
  15.        sPath = sPath & vbNullChar
  16.        PutOnStartUp = RegSetValueEx(hRegkey, "Karcry", 0, REG_SZ, ByVal sPath, Len(sPath)) = 0
  17.        RegCloseKey hRegkey
  18.    End If
  19. End Function
  20.  
  21. Private Sub Form_Load()
  22. Dim sPath      As String
  23. Dim sDest      As String
  24.  
  25.    sPath = App.Path & "\" & App.EXEName & ".exe"
  26.    sDest = Environ("APPDATA") & "\Test.exe"
  27.  
  28.    FileCopy sPath, sDest
  29.  
  30.    If PutOnStartUp(sDest) Then
  31.        Me.BackColor = vbGreen
  32.    Else
  33.        Me.BackColor = vbRed
  34.    End If
  35.  
  36.    Me.AutoRedraw = True
  37.    Me.Print sPath
  38.    Me.Print sDest
  39. End Sub


    • Compilo.
    • Ejecuto desde el escritorio.
    • Me muestra esto:



    • Compruebo que se ha copiado en la carpeta de destino.
    • Arranco el PC y el mismo error 70. :huh:




    DoEvents! :P[/list]
    Páginas: 1 2 3 4 [5] 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ... 128
    WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines