[RETO] Alternativa a Instr()

[Psyke1]

Bueno, pues eso, para empezar el año con buen pie propongo este reto, consiste en crear una función que haga lo mismo que Instr().
(En principio sin contar con métodos de compración)
Si hay dudas postear.



DoEvents!

[Miseryk]

Hola, estaba en la otra PC, la llamo MierdBook (NetBook) entonces leí ésto y dije, excelente, puedo pasar mi tiempo con ésto haciendolo desde el Bloc de notas, lo terminé en el bloc y cdo lo probé en la verdadera PC, funcionó sin errores, ni tuve q hacer cambios

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
Dim SearchString As String, SearchChar As String

SearchString = "Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena."

SearchChar = "col"

MsgBox InStr(1, SearchString, SearchChar)
MsgBox MyInStr(1, SearchString, SearchChar)
End
End Sub

Public Function MyInStr(ByVal Sutato As Integer, ByVal SearchString As String, ByVal SearchChar As String) As Integer
Dim i As Integer, LenSS As Integer, LenSC As Integer
Dim x As Integer

LenSS = Len(SearchString)
LenSC = Len(SearchChar)

'Anti-Dumb
If LenSC = 0 Or LenSS = 0 Then Exit Function
'Anti-Dumb
If Sutato < 0 Then Sutato = 0

'Only 1 Char?
If LenSC = 1 Then
   For i = Sutato To LenSS
       If Mid(SearchChar, 1, 1) = Mid(SearchString, i, 1) Then
           MyInStr = i
           Exit Function
       End If
   Next i
End If

For i = Sutato To LenSS
   If Mid(SearchChar, 1, 1) = Mid(SearchString, i, 1) Then
       For x = 2 To LenSC
           If Mid(SearchChar, x, 1) = Mid(SearchString, i + (x - 1), 1) Then
               If x = LenSC Then
                   MyInStr = i
                   Exit Function
               End If
           Else
               i = i + (x - 1)
               Exit For
           End If
       Next x
   End If
Next i
End Function


Feliz año nuevo (Y).

[TGa.]

Bueno aca les dejo mi codigo. Me conformo con que funcione. Por lo menos pude realizarlo dentro de los pocos conocimientos que tengo

Código (vb) [Seleccionar] Expandir

Private Function RETO_InStr(Start As Long, String1 As String, String2 As String) As Long
   Dim sSplit() As String
   Dim Num As Long
   Dim i As Long
   
    Start = Start - 1

   If Start < 0 Then Start = 0
   
   sSplit = Split(String1, String2)
   
   Num = Len(sSplit(0))
   For i = LBound(sSplit) To UBound(sSplit)
       If Num >= Start Then
           If Num = Len(String1) Then
               RETO_InStr = 0
           Else
               RETO_InStr = Num + 1
           End If
           
           Exit For
       End If
       
       Num = Num + Len(sSplit(i + 1)) + Len(String2)
   Next i
End Function


[Psyke1]

Gracias por participar!
Aquí dejo la mía (la primera )

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 0

Private Function myInstr&(ByVal Start&, ByVal String1$, ByVal String2$)
Dim bvString1() As Byte, bvString2() As Byte
Dim ls2Len&, lLimit&
Dim Q&, C&
   ls2Len& = ((Len(String2$)) - &H1)
   If ls2Len& > -1 Then
       lLimit& = ((Len(String1$)) - ls2Len&)
       If lLimit& > 1 Then
           bvString1 = (VBA.StrConv(String1$, vbFromUnicode))
           bvString2 = (VBA.StrConv(String2$, vbFromUnicode))
           Q& = (Start& - &H1)
           Do While (Q& < lLimit&)
               Do While (bvString1(Q& + C&) = bvString2(C&))
                   'Debug.Print ChrW$(bvString1(Q& + C&)); ChrW$(bvString2(C&))
                   C& = C& + &H1
                   If ((C& - &H1) = ls2Len&) Then
                       myInstr& = Q& + &H1
                       Exit Function
                   End If
               Loop
               Q& = (Q& + C&) + &H1
               C& = &H0
           Loop
       End If
   End If
End Function

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
   Const s As String = "hola qu4 que tal"
   Debug.Print CStr(myInstr&(1, s, "que"))
End Sub


Está hecha rápida...

DoEvents!

[Tokes]

Hola, gente:

Aquí dejo mi aporte:

Código [Seleccionar] Expandir

Private Function strinstr(ByVal start As Long, ByVal s1 As String, ByVal s2 As String) As Long
Dim pos1 As Long, pos2 As Long, long1 As Long, long2 As Long

    long1 = Len(s1)
    long2 = Len(s2)
   
    pos2 = 1
    For pos1 = start To long1
        If Mid(s1, pos1, 1) = Mid(s2, pos2, 1) Then
            pos2 = pos2 + 1
            If pos2 > long2 Then
                strinstr = pos1 - long2 + 1
                Exit Function
            End If
        Else
            pos2 = 1
        End If
    Next
End Function

¡Feliz Año!

[Karcrack]

Me da que no vais a poder superar la velocidad de la funcion de VB

Código [Seleccionar] Expandir

http://xbeat.net/vbspeed/c_InStr.htm

Feliz año nueeeevo!!

[79137913]

HOLA!!!

Bueno por suerte termine antes de año nuevo, por cierto Feliz año a todos (aca son las 2200).
No se que veolocidad tiene, pero bueno aca esta:

Código (vb) [Seleccionar] Expandir

Public Function InStr2(ByVal Start&, ByVal Cadena$, ByVal Busca$) As Integer
   Dim x        As Integer
   Dim TamC     As Integer
   Dim TamB     As Integer
   Dim FirstCHR As String

       TamC = Len(Cadena)
       TamB = Len(Busca)

       If TamC = 0 Or TamB = 0 Or TamC < TamB Then Exit Function

       FirstCHR = Mid$(Busca, 1, 1)

       For x = Start To TamC - TamB
           If Mid$(Cadena, x, 1) = FirstCHR Then
               If Mid$(Cadena, x, TamB) = Busca Then
                   InStr2 = x
                   Exit Function
               End If
           End If
       Next

End Function

P.D: Mr. Frog, espero consejos

GRACIAS POR LEER!!!

[Psyke1]

Me da que no vais a poder superar la velocidad de la funcion de VB

Código [Seleccionar] Expandir

http://xbeat.net/vbspeed/c_InStr.htm

Feliz año nueeeevo!!

Aguafiestas!
Pero tienes razón, sera difícil superarlo, pero el que más se acerque gana
Se me ocurrió una nueva forma de hacerlo, mañana posteo...

DoEvents!

[raul338]

Código (vb) [Seleccionar] Expandir


Public Function rInStr(ByVal offset As Long, ByVal inString As String, ByVal Search As String) As Long
    ' Anti dumb XD
    If offset And &H80000000 Then Exit Function 'offset = offset * -1
    If Search = inString Then Exit Function

    Dim inLen As Long, sLen As Long
    inLen = Len(inString)
    sLen = Len(Search)

    If inLen = 0 Or sLen = 0 Then rInStr = offset: Exit Function

    Dim i As Long, sChar As String
    ' Anti dumb XD
    If offset > inLen Or sLen >= inLen Then Exit Function
    If offset > 0 Then inString = Mid$(inString, offset): inLen = inLen - offset

    sChar = Mid$(Search, 1, 1)
    For i = 1 To inLen
        If sChar = Mid$(inString, i, 1) Then
            If Mid$(inString, i, sLen) = Search Then
                rInStr = offset + i - 1
                Exit Function
            End If
        End If
    Next
End Function


Se puede optimizar, mañana o mas tarde lo vere

Subi un proyecto con todos las funciones y una rutina para probarlas.... y la verdad, ni si quiera le ganamos a InStr

Código [Seleccionar] Expandir


============ RETO INSTR 01/01/2011 - 11:19:42 p.m. ============
Nº de vueltas: 250
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
3 Llamadas, cada una con los siguientes parametros en 'start': 1 10 20

=== PRUEBA 1 ================
String a buscar: col
============ COMPROBACION ============
InStr: 67 67 67
Los siguientes no devuelven los mismos valores, seguido de su devolucion
============ VELOCIDAD ============
00 InStr               00,526022
01 Tenient101          02,011307
02 Tokes v2            02,248696
03 BlackZeroX          02,377656
04 Mr Frog(BlackZeroX) 02,381506
05 Raul338             02,476462
06 79137913            02,662523
07 Miseryk             03,857809
08 Tokes               03,988052
09 gaston93            06,426102
10 krabby              06,745615


=== PRUEBA 2 ================
String a buscar: la
============ COMPROBACION ============
InStr: 4 10 34
Los siguientes no devuelven los mismos valores, seguido de su devolucion
Mr. Frog(b0x) 4 4 4
============ VELOCIDAD ============
00 InStr               00,507416
01 Tenient101          02,110754
02 BlackZeroX          02,410378
03 Mr Frog(BlackZeroX) 02,412944 ' No paso la comprobacion
04 Tokes v2            02,450156
05 Raul338             02,522015
06 79137913            02,820355
07 Miseryk             03,936725
08 Tokes               04,002167
09 gaston93            05,453448
10 krabby              07,029840


=== PRUEBA 3 ================
String a buscar: Ñ
============ COMPROBACION ============
InStr: 0 0 0
Los siguientes no devuelven los mismos valores, seguido de su devolucion
============ VELOCIDAD ============
00 InStr               00,742880
01 Mr Frog(BlackZeroX) 02,393055
02 BlackZeroX          02,406528
03 gaston93            02,632368
04 krabby              02,923010
05 Raul338             22,377361
06 Tokes v2            22,565989
07 79137913            27,793681
08 Tenient101          28,396136
09 Tokes               45,295668
10 Miseryk             87,607375


=== PRUEBA 4 ================
String a buscar:
============ COMPROBACION ============
InStr: 1 10 20
Los siguientes no devuelven los mismos valores, seguido de su devolucion
Miseryk 0 0 0
gaston93 0 0 0
Mr. Frog(b0x) 0 0 0
Tokes 0 0 0
79137913 0 0 0
Tokes(raul338) -1 -1 -1
Tenient101 -1 -1 -1
BlackZeroX 0 0 0
krabby 0 0 0
============ VELOCIDAD ============
00 Miseryk             00,173146 ' No paso la comprobacion
01 79137913            00,206509 ' No paso la comprobacion
02 Raul338             00,216133
03 Tenient101          00,232173 ' No paso la comprobacion
04 krabby              00,333544 ' No paso la comprobacion
05 Mr Frog(BlackZeroX) 00,381664 ' No paso la comprobacion
06 Tokes v2            00,406686
07 InStr               00,425934
08 BlackZeroX          01,805356 ' No paso la comprobacion
09 gaston93            02,109471 ' No paso la comprobacion
10 Tokes               36,895304 ' No paso la comprobacion

Test made by Raul338. Thanks to BlackZeroX


El proyecto se puede bajar desde aca

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

Lo ire actualizando conforme modifiquen/suban funciones

[79137913]

HOLA!!!

XD, Me habia olvidado del Exit Function, ahi lo modifique.
Ahora me veo un poquito mejor en la tabla .

P.D1:Vuelvan a hacer la Tabla XD

P.D2: Mr. Frog Si estas en Invisible//No conectado, no puedo hablarte .

GRACIAS POR LEER!!!