[RETO] Alternativa a Instr()

[Tokes]

Saludos:

Aquí les dejo una mejora (creo) del código de raul338. La he llamado Ratok338InStr:

Código [Seleccionar] Expandir

Private Function RaTok338InStr(ByVal Start As Long, ByVal s1 As String, ByVal s2 As String) As Long
Dim pos1 As Long, long1 As Long, long2 As Long, lim As Long, c As String

    If Start And &H80000000 Then Start = -Start
   
    long1 = Len(s1)
    long2 = Len(s2)
   
    If long1 = 0 Or long2 = 0 Or Start > long1 Or Start = 0 Or long2 > long1 Then
        RaTok338InStr = -1
        Exit Function
    End If
    lim = long1 - long2 + 1
    c = Mid(s2, 1, 1)
    For pos1 = Start To lim
        If Mid(s1, pos1, 1) = c Then
            If Mid(s1, pos1, long2) = s2 Then
                RaTok338InStr = pos1
                Exit Function
            End If
        End If
    Next
End Function

Hasta la próxima.

[Sanlegas]

aca el mio 

Código [Seleccionar] Expandir

Public Function InstrNew(ByVal Start As Integer, ByVal Str1 As String, ByVal Str2 As String) As Integer
If Start = 0 Or Str1 = "" Or Str2 = "" Then
    InstrNew = -1
    Exit Function
End If
Do While Start <= Len(Str1)
    If Mid(Str1, Start, Len(Str2)) = Str2 Then
        InstrNew = Start
        Exit Function
    End If
    Start = Start + 1
Loop
End Function

una pregunta... como lo pongo con colores  ?

[BlackZeroX]

.
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!¡.
.

[BlackZeroX]

.
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!¡.
.

[TGa.]

Listo ya modifique mi funcion tenia un pequeño error, creo que ya no da resultados erroneos.

[Psyke1]

Ya corregi el código (creo), ahora no tengo mucho tiempo.
Pensé que iría más rápido si trabajaba con Bytes...
Ya haré más versiones. 

DoEvents!

[krabby]

hola super bien el reto que has propuesto Mr Frog., aki mi code, esta comentado, lo probe y no tiene fallas.
si le encuentran una falla me dicen y me lanzo del 5to piso.
usa la misma sintaxis que el instr()

Código [Seleccionar] Expandir

Option Explicit

Public Function Rapidash(Posicion As Long, CadenaDondeBuscar As String, MiCadenaBuscar As String) As Long
   Dim Cadena As String, CadenaBuscar As String
   Cadena = CadenaDondeBuscar
   CadenaBuscar = MiCadenaBuscar
   'si cadena es menor q cadenabuscar, entonces cadenabuscar no esta
   'contenida dentro de cadena
   If Len(Cadena) < Len(CadenaBuscar) Then Exit Function
   'si posicion es mayor a texto, entonces no hay donde buscar
   'porque posicion excede el tamaño de la cadena
   If Posicion > Len(Cadena) Then Exit Function
   'posicion debe ser igual o mayor a1
   If Posicion < 1 Then Exit Function
   'si no hay cadenabuscar salimos
   If Len(CadenaBuscar) = 0 Then Exit Function
   'la cadena serà partida en 2 desde posicion
   'en caso de que posicion sea mayor a 1
   'es para simplificar el trabajo de busqueda
   'extra almacena el tamaño de la primera
   'parte del string partido
   
   Dim Extra As Long
   If Posicion > 1 Then
       'coge la porcion de cadena indicada por Posicion
       'para simplificar la busqueda
       Cadena = Mid(Cadena, Posicion)
       Extra = Posicion - 1
   End If

   Dim arrCad() As String, TamCadenaBuscar As Long, Resul As Long
   TamCadenaBuscar = Len(CadenaBuscar)
   'comprueba si la cadena se encuentra al inicio y le suma
   'lo Extra en caso de que se haya partido la cadena en 2 y sale
   If Left(Cadena, TamCadenaBuscar) = CadenaBuscar Then
       Resul = 1 + Extra
   Else
       'comprueba si la CadenaBuscar existe dentro
       'de cadena
       Dim tmp As String
       tmp = Replace(Cadena, CadenaBuscar, "")
       'si no varia el tamaño kiere decir
       ' q "NO" se encontro CadenaBuscar y sale
       'esto es para no caer en el split
       'y se produzca un error al sumar
       'el len(arrCad(0)), ya q si split falla
       'no habrà el inidce cero "0"
       If Len(tmp) = Len(Cadena) Then
           Exit Function
       End If
       'si llega aki entonces se encontro la CadenaBuscar
       arrCad = Split(Cadena, CadenaBuscar)
       'suma el extra y el tamaño
       'arrCad(0) simpre va contener el string
       'anterior a cadenabuscar, por eso la suma de abajo
       Resul = Len(arrCad(0)) + 1 + Extra
   End If
   
   Rapidash = Resul
End Function


Código [Seleccionar] Expandir

Private Sub Form_Load()
   Dim Pos As Long
   Dim UnaCadena As String
   Dim CadenaBuscar As String
   UnaCadena = "hola que tal viejo, me llamo pepe"
   CadenaBuscar = "viejo"
   Pos = Rapidash(1, UnaCadena, CadenaBuscar)
   MsgBox "Resultado Rapidash: " & Pos
   Pos = InStr(1, UnaCadena, CadenaBuscar)
   MsgBox "Resultado InStr: " & Pos
End Sub

salu2

[krabby]

el proyecto que subieron para probar las funciones tiene errores, lo descargue, y algunos resultados no son correctos.
debajo de main donde dice 'raul388 , pasas los parametros incorrectos:

Código [Seleccionar] Expandir

    '' ================ COMPROBACION ===========================
    Debug.Print "============ COMPROBACION ============"
        cFirst = InStr(firstPos, SearchString, SearchChar)
        cSecond = InStr(secondPos, SearchString, SearchChar)
        cThird = InStr(thirdPos, SearchString, SearchChar)
    Debug.Print "Valores de InStr: ", , cFirst, cSecond, cThird
   
    ' Raul338
    tFirst = rInStr(firstPos, SearchChar, SearchString)
    tSecond = rInStr(secondPos, SearchChar, SearchString)
    tThird = rInStr(thirdPos, SearchChar, SearchString)
    If tFirst <> cFirst Or tSecond <> cSecond Or tThird <> cThird Then
        Debug.Print "Raul338 no devuelve los mismos valores", tFirst, tSecond, tThird
    End If
   
    ' Miseryk
    tFirst = myInstr(firstPos, SearchString, SearchChar)
    tSecond = myInstr(secondPos, SearchString, SearchChar)
    tThird = myInstr(thirdPos, SearchString, SearchChar)
    If tFirst <> cFirst Or tSecond <> cSecond Or tThird <> cThird Then
        Debug.Print "Miseryk no devuelve los mismos valores", tFirst, tSecond, tThird
    End If

el orden de parametros de instr y myInstr(de Miseryc) son iguales (firstPos, SearchString, SearchChar),  pero en el de raul338 esta al reves (firstPos, SearchChar, SearchString).

[raul338]

jeje si, año nuevo, cabeza nueva, pense que toda la vida lo usaba asi y lo puse asi ya cambio la firma

Hay actualizo mi funcion

Benchmark actualizados

1

Código [Seleccionar] Expandir


============ RETO INSTR 31/12/10 ============
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 ============
InStr          0,864775284178946
Raul338        18,3623837347693
Miseryk        30,7958742805302
gaston93       3,87963529112102
Mr Frog        7,84405750497397
Tokes          30,0233925932865
79137913       20,6618641060995
Tokes v2       17,7496594728775
Tenient101     19,7694039508204
BlackZeroX     5,31231935060211
krabby         7,9775094908101


2

Código [Seleccionar] Expandir


============ RETO INSTR 31/12/10 ============
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
BlackZeroX no devuelve los mismos valores  4             16            34

============ VELOCIDAD ============
InStr          0,599789684803091
Raul338        3,56973796574262
Miseryk        4,66494248411889
gaston93       6,10917527314349
Mr Frog        4,43525108542018
Tokes          4,75540753220973
79137913       3,40099819519021
Tokes v2       3,20082021643602
Tenient101     2,88387175007523
BlackZeroX     4,6777744058339
krabby         7,79785617083907


3

Código [Seleccionar] Expandir



============ RETO INSTR 31/12/10 ============
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 ============
InStr          0,706294635037691
Raul338        26,3284343194879
Miseryk        95,6028468901517
gaston93       3,07185940320015
Mr Frog        0,653042159920391
Tokes          48,7631246499291
79137913       31,470826946779
Tokes v2       27,1888146704795
Tenient101     35,9883049865489
BlackZeroX     3,53637496928359
krabby         3,62555682520292


y el proyecto con las funciones actualizadas

http://www.mediafire.com/?bbr7r0s90xmgtp6

PD: EL codigo exclusivamente de vb se pone asi [code=vb]Dim s as string[/code]

Quedando

Código (vb) [Seleccionar] Expandir

Dim s as string

[krabby]

supongo que dices por lo del color, no sabia lo de poner el code =vb, igual no es muy conveniente cuando kieres copiar / pegar un codigo que tiene esas etiquetas, porque en vez de salir los saltos de linea salen unos espacios y hay que editar el codigo poniendo lo saltos correspondientes.
voi a bajar y provar como va ahora tu tester de funciones corregido.
un saludo