Mensajes

[La Funcion de la RANA Explota cuando se busca una String VACIA]

Aqui dejo el proyecto modificado para que solo lo ejecuten y les salte el notepad con la informacion y el RANKING de las 3 pruebas, ya que en el anterior no vi que eran 3 strings a buscar...

Update Reto.rar

Código (vb) [Seleccionar] Expandir



============ RETO INSTR 01/01/2011 - 03:12:25 p.m. ============
String a buscar: col
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 67 67 67

============ VELOCIDAD ============
0 InStr 0.5725008
1 BlackZeroX 2.1983408
2 Mr Frog 3.7716608
3 gaston93 4.0096208
4 krabby 5.6024608
5 Raul338 15.4459808
6 Miseryk 24.8291408
7 Tokes v2 10.7238208
8 Tenient101 13.9761008
9 79137913 16.4519408
10 Tokes 26.5471408



============ RETO INSTR 01/01/2011 - 03:12:25 p.m. ============
String a buscar: la
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 4 10 34

============ VELOCIDAD ============
0 InStr 0.477224
1 Raul338 1.764424
2 Tokes v2 1.775824
3 Tenient101 1.779824
4 BlackZeroX 2.195464
5 Miseryk 3.082744
6 79137913 2.465384
7 Tokes 3.249304
8 Mr Frog 3.814264
9 gaston93 4.428424
10 krabby 7.093384



============ RETO INSTR 01/01/2011 - 03:12:25 p.m. ============
String a buscar: Ñ
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 0 0 0

============ VELOCIDAD ============
0 Mr Frog 0.2846228
1 BlackZeroX 1.7433028
2 gaston93 1.7897028
3 krabby 1.9981428
4 InStr 3.2337828
5 Raul338 16.1140228
6 Tokes v2 16.0697828
7 79137913 20.9785428
8 Tenient101 24.8553428
9 Tokes 38.0149428
10 Miseryk 84.9994228



Mi funcion actualizada

Código (Vb) [Seleccionar] Expandir



Public Function RetInstr(ByVal Start As Long, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long
Dim lng_ST1  As Long
    lng_ST1 = Len(String1)
    If Not Start > lng_ST1 Then
        If Start = 1 Then
            RetInstr = (Start + Len(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0))) + 1
        Else
            RetInstr = (Start + Len(Split(Right$(String1, lng_ST1 - Start + 1), String2, 2, Compare)(0)))
        End If
        If RetInstr > lng_ST1 Then RetInstr = 0
    End If
End Function



La Funcion de la RANA Explota cuando se busca una String VACIA

Código (Vb) [Seleccionar] Expandir



============ RETO INSTR 01/01/2011 - 03:17:23 p.m. ============
String a buscar:
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 1 10 20
Raul338 no devuelve los mismos valores 0 0 0
Miseryk no devuelve los mismos valores 0 0 0
gaston93 no devuelve los mismos valores 0 0 0
Tokes no devuelve los mismos valores 0 0 0
79137913 no devuelve los mismos valores 0 0 0
Tokes(raul338) no devuelve los mismos valores -1 -1 -1
Tenient101 no devuelve los mismos valores -1 -1 -1
BlackZeroX no devuelve los mismos valores 0 0 0
krabby no devuelve los mismos valores 0 0 0

============ VELOCIDAD ============
0 InStr 0.7140104
1 Miseryk 0.7450104
2 Mr Frog 0.7569704   <---- Exploto No se considera...
3 Tenient101 0.7956504
4 Raul338 0.8776904
5 krabby 0.8335704
6 gaston93 7.0439704
7 Tokes v2 0.9286504
8 79137913 1.4048904
9 BlackZeroX 5.6635304
10 Tokes 73.4917704



Temibles Lunas!¡.

[InStr()]

...

Ninguno de ustedes a compilado el proyecto de comprobacion, esos resultados son invalidos ( me acabe de bajar el proyecto y todo esta en el Debug... ¬¬# )...

Miren cual es el mas rapido... inclusive le gano a InStr(), por hay un aguafiestas dijo que no podria...

Edito No habia visto que eran 3 prubas aqui las dejo...

Código (Vb) [Seleccionar] Expandir



============ RETO INSTR 01/01/2011 - 02:42:29 p.m. ============
String a buscar: Ñ
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 0 0 0

============ VELOCIDAD ============
0 Mr Frog 0.2237288
1 InStr 0.4316488
2 gaston93 2.2926488
3 krabby 2.5124888
4 BlackZeroX 3.2794088
5 Tokes v2 16.1948888
6 79137913 21.6315688
7 Tenient101 23.6759288
8 Tokes 45.0908488
9 Raul338 49.8016088
10 Miseryk 159.0136088


============ RETO INSTR 01/01/2011 - 02:43:11 p.m. ============
String a buscar: la
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 4 10 34

============ VELOCIDAD ============
0 InStr 0.470288
1 79137913 2.211208
2 Raul338 3.088048
3 Tokes v2 3.368368
4 BlackZeroX 3.379128
5 Miseryk 4.264168
6 Mr Frog 4.569008
7 Tokes 5.908088
8 Tenient101 6.049528
9 krabby 6.238808
10 gaston93 6.480928


============ RETO INSTR 01/01/2011 - 02:44:06 p.m. ============
String a buscar: col
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
Nº de vueltas: 250
3 Offsets: 1 10 20
============ COMPROBACION ============
Valores de InStr: 67 67 67

============ VELOCIDAD ============
0 InStr 1.6597832
1 gaston93 2.4199032
2 BlackZeroX 3.6896232
3 Mr Frog 4.1875432
4 krabby 5.9086232
5 Raul338 13.7212632
6 Tokes v2 11.0735032
7 Tenient101 12.4469832
8 79137913 14.7459032
9 Tokes 26.1060232
10 Miseryk 26.8289832



Descargar Proyecto de Pruebas

Temibles Lunas!¡.

[Split()]

.
Bueno aquí mas corto... ojala nos dejara VB6 usar apuntadores tan facil como en C... asi seria otra historia.

Como no quiero gastar mucho el Do Loop o el For Nest por que se gastan ( jaja ) use las Split().

Código (Vb) [Seleccionar] Expandir



Public Function RetInstr(ByVal Start As String, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long
Dim lng_ST1  As Long
    lng_ST1 = Len(String1)
    If Not Start > lng_ST1 Then
        RetInstr = Start + Len(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0)) + 1
        If RetInstr > lng_ST1 Then RetInstr = 0
    End If
End Function



Dulces Lunas!¡.
.

.
mmmm No se que tan rapida sea mi funcion pero cumple su cometido xP

Código (vb) [Seleccionar] Expandir



Public Function RetInstr(ByVal Start As String, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long
Dim Var_Arr  As Variant
Dim lng_ST1  As Long
Dim lng_UST  As Long
    lng_ST1 = Len(String1)
    If Not Start > lng_ST1 Then
        Var_Arr = Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)
        lng_UST = UBound(Var_Arr)
        If lng_UST > 0 Then
            RetInstr = Start + Len(Var_Arr(0)) + 1
        End If
    End If
End Function



Dulces Lunas!¡.
.

.
Unos ejemplos...

Transpasar un Icono de una coleccion a otra

Código (Vb) [Seleccionar] Expandir



Option Explicit
Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "Angeles"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "AngelesMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long

    Set a = New Cls_ImageList
    With a
        If Not .ImageListCreate(Str_BMP, 128, 128) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
            lng_Index = .ImageList_ADDLoadFromFile(Str_BMP, App.Path & "\img\a1.bmp", IMAGE_BITMAP)
            If Not .ImageListCreate(Str_BMP2, 32, 32) = 0 Then
                lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP2, .ImageListGetHIcon(Str_BMP, lng_Index), IMAGE_ICON)
                .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
                .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
            End If
        End If
    End With
    Set a = Nothing
   
Refresh
End Sub



Agregas Iconos desde Instancias de colecciones ajenas...

Código (Vb) [Seleccionar] Expandir



Option Explicit
Private Const MAX_PATH = 260
Private Const SHGFI_DISPLAYNAME = &H200         ' get display name
Private Const SHGFI_EXETYPE = &H2000           ' return exe type
Private Const SHGFI_LARGEICON = &H0           ' get large icon
Private Const SHGFI_SHELLICONSIZE = &H4         ' get shell size icon
Private Const SHGFI_SMALLICON = &H1           ' get small icon
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SYSICONINDEX = &H4000        ' get system icondex
Private Const SHGFI_TYPENAME = &H400           ' get type name
Private Const ILD_BLEND50 = &H4
Private Const ILD_BLEND25 = &H2
Private Const ILD_TRANSPARENT = &H1
Private Const CLR_NONE = &HFFFFFFFF
Private Const CLR_DEFAULT = &HFF000000

Private Type SHFILEINFO
    hIcon As Long                       ' : icon
    iIcon As Long                       ' : icondex
    dwAttributes As Long                ' : SFGAO_ flags
    szDisplayName As String * MAX_PATH  ' : display name (or path)
    szTypeName As String * 80           ' : type name
End Type

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "System"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "SystemMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long
Dim lng_sys_himl        As Long
Dim SHINFO              As SHFILEINFO

    Set a = New Cls_ImageList
    With a
   
        If Not .ImageListCreate(Str_BMP, 128, 128) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
            lng_sys_himl = SHGetFileInfo("c:\", 0, SHINFO, LenB(SHINFO), SHGFI_ICON Or SHGFI_LARGEICON)
            If Not lng_sys_himl = 0 Then
                lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP, SHINFO.hIcon, IMAGE_ICON)
            End If
            If Not .ImageListCreate(Str_BMP2, 32, 32) = 0 Then
                lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP2, .ImageListGetHIcon(Str_BMP, lng_Index), IMAGE_ICON)
                .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
                .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
            End If
        End If
       
    End With
    Set a = Nothing

Refresh
End Sub



Temibles Lunas!¡.

[@1.2 Cls_ImageList]

.
@1.2 Cls_ImageList

* Agregue un algoritmo para buscar rapidamente la coleccion de imagenes la cual es ordenada con QSort()
* Correcion: Error en la Funcion ImageListDuplicate
* Correcion: Error en la funcion VerificImageList

1.2 Cls_ImageList

@1.3 Cls_ImageList

* Solo Impide crear Coleccion de imagenes con Keys Indenticas

1.3 Cls_ImageList

Temibles Lunas!¡.

[2.0 Cls_ImageList]

.

http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=25:20-clsimagelist&catid=15:catmoduloscls&Itemid=24


Este Modulo de Clase es solo una pequeña sustitucion al ImageList, no tiene gran cosa y no se parece en lo absoluto a los de Cobein, ya que este solo esta diseñado para que trabaje con iconos, aun que puede cargar BMP, Cursores e Iconos obviamente.

1.0 Cls_ImageList
1.2 Cls_ImageList
1.3 Cls_ImageList

2.0 Cls_ImageList

Código [Seleccionar] Expandir



'   /////////////////////////////////////////////////////////////
'   //                  ImageList.Cls   2.0                    //
'   // *    ADD Events                                         //
'   // *    ADD Convert Icons To Picture                       //
'   // *    Fix Swap                                           //
'   // *    Fix Duplicate                                      //
'   /////////////////////////////////////////////////////////////



EDITO: --> Subi Nuevamente el Archivo ya que era una version Anterior.

Edito: ---> Agrego solo un ejemplo Basico...

Código (Vb) [Seleccionar] Expandir



Private Sub Form_Load()
AutoRedraw = True
Dim a                   As Cls_ImageList
Const Str_BMP           As String = "Angeles"         '   //  Aqui guardamos imagenes Grandes
Const Str_BMP2          As String = "AngelesMinis"    '   //  Nos servira solo para Redidibujar e mini
Dim lng_Index           As Long

   Set a = New Cls_ImageList
   With a

       If Not .ImageListCreate(Str_BMP, 512, 512) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
           lng_Index = .ImageList_ADDLoadFromFile(Str_BMP, App.Path & "\img\a1.bmp", IMAGE_BITMAP)
           If .ImageListDuplicate(Str_BMP, Str_BMP2) Then
               .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
               If .ImageListSetSize(Str_BMP, 32, 32) Then
                   .ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
               End If
               .ImageListDestroy Str_BMP2 ' // Eliminamos la Coleccion de imagenes
               .ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50 ' // esta linea ya no pictara nada ya que la coleccion ya esta destruida.
           End If
       End If
       
   End With
   Set a = Nothing
   
Refresh
End Sub




Temibles Lunas!¡.
.

.
Algunos son por Hooks y aplican heuristica por medio de esto, para la internet usan Hooks quiero creer, algunos se instan como drivers y de esta manera optienen los privilegios nesesarios y por ende son mas eficientes hay mily un posas.

Quisas lo que nesesites es usar Sockets RAW... haci Snifeas el puerto 80, 8080 que son los comunes en las paginas web, otra manera seria instalando un Hook a las apis responsables de los Sockets que usa el Explorador. o algo que hace un Exelente programa que tiene un perrito como guardian en su logo es realizar un drivers y asi vigilar los datos y conexiones,

P.D.: lo del Unclose cuando compiles tu EXe sencillo lo agregas a las esepciones del AV y listo, digo tu sabes perfectamente que no tiene dicho proposito xD... o reprogramalo.

Temibles Lunas!¡.

Dulces Doevents XDD 

¬¬# predigo que moriras...

Código [Seleccionar] Expandir



Const vbBack = ""
    Miembro de VBA.Constants
    Constante del carácter de retroceso; equivale a Chr$(8)

Const vbCr = "
"
    Miembro de VBA.Constants
    Constante de retorno de carro (sin avance de línea); equivale a Chr$(13)

Const vbCrLf = "
"
    Miembro de VBA.Constants
    Constante de combinación de retorno de carro y avance de línea; equivale a Chr$(13)+Chr$(10)

Const vbFormFeed = ""
    Miembro de VBA.Constants
    Constante de avance de página (ASCII 12); equivale a Chr$(12)

Const vbLf = "
"
    Miembro de VBA.Constants
    Constante de avance de línea (sin retorno de carro); equivale a Chr$(10)

Const vbNewLine = "
"
    Miembro de VBA.Constants
    Constante de NewLine; específico de la plataforma

Const vbNullChar = ""
    Miembro de VBA.Constants
    Constante de Basic para un único carácter Null (valor ASCII 0); equivale a Chr$(0)

Const vbNullString = ""
    Miembro de VBA.Constants
    Constante que se usa al llamar a un procedimiento externo que requiere una cadena cuyo valor sea cero

Const vbObjectError = -2147221504 (&H80040000)
    Miembro de VBA.Constants
    Constante que indica el error que se devuelve desde un objeto de Visual Basic

Const vbTab = " "
    Miembro de VBA.Constants
    Constante del carácter Tab (ASCII 9); equivale a Chr$(9)

Const vbVerticalTab = ""
    Miembro de VBA.Constants
    Constante para el carácter de tabulación vertical (ASCII 11); equivale a Chr$(11)



Temibles Lunas!¡.
.

Muchas gracias por su apreciable atención y ayuda...los usuarios que adquirimos este programa estamos verdaderamente sorprendidos por la actitud del desarrollador de este programa.

Feliz Año!!!

Como es un detalle muy pobre esto ( solo cambiar el tipo de la variable en el Soft y en la BDD si se requiere ), cobraria el 50%, notando que si les realiza el software hace tiempo y ya ni veo dicho software ( en mi opinion estaria maximo en 2 dias como mucho ).

Quizas si no hay otra alternativa van a tener que contratar a otro programador... si tuvieran el codigo fuente seria otra cosa, pues ustedes mismo lo harian... o solo contratan aun programador para que toquetee dicho codigo y ya...

Temibles Lunas!¡.
.