[RETO] Alternativa a Instr()

[Psyke1]

Yo el único que lo hice un poco diferente...


DoEvents!

[BlackZeroX]

.
@raul338

Se usaba instr() si no mal recuerdo

Código (Vb) [Seleccionar] Expandir



Public Function RetInstr3(Optional Start, Optional String1, Optional String2, Optional Compare As VbCompareMethod = vbBinaryCompare)
    RetInstr3 = InStr(Start, String1, String2, Compare)
End Function

Dulces Lunas!¡.

[cobein]

Simplemente para confirmar lo de Karcrack, los string en VB son BSTR y son algo asi

Size/string/terminator
4 bytes/null & char/null & null

Si miran el codigo siguiente van a ver que da como resultado 8, 0p0a0p0a

Código [Seleccionar] Expandir

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Sub Form_Load()
    Dim s As String
    s = "papa"
    Dim lSize As Long
    CopyMemory lSize, ByVal StrPtr(s) - 4, 4
    Debug.Print lSize
End Sub


[Psyke1]

Quizá ya un poco tarde...

Aqui dejo mi 2ª forma, a diferencia de todas las demas sin depender de Mid(), Split()...

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 0

Private Declare Function ArrayPtr Lib "msvbvm60" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Private Function MrFrogInstrII(ByVal lngStart As Long, ByRef strString1 As String, ByRef strString2 As String) As Long
Dim lngLenS2 As Long, lngLenS1 As Long, lngLimit As Long
Dim lngAscHeader1(5) As Long, lngAscHeader2(5) As Long
Dim intAscS1() As Integer, intAscS2() As Integer
Dim Q As Long, C As Long

   If lngStart > 0 Then
       lngLenS2 = LenB(strString2) \ 2
       If lngLenS2 > 0 Then
           lngLenS1 = LenB(strString1) \ 2
           lngLimit = lngLenS1 - lngLenS2 - 1
           If lngLimit > 1 Then
               lngAscHeader1(0) = &H1
               lngAscHeader1(1) = &H2
               lngAscHeader1(3) = StrPtr(strString1)
               lngAscHeader1(4) = lngLenS1
               PutMem4 ArrayPtr(intAscS1), VarPtr(lngAscHeader1(0))
               
               lngAscHeader2(0) = &H1
               lngAscHeader2(1) = &H2
               lngAscHeader2(3) = StrPtr(strString2)
               lngAscHeader2(4) = lngLenS2 + 1
               PutMem4 ArrayPtr(intAscS2), VarPtr(lngAscHeader2(0))
               
               Q = lngStart - 1
               Do While Q < lngLimit
                   Do While intAscS1(Q + C) = intAscS2(C)
                       C = C + 1
                       If C = lngLenS2 Then
                           MrFrogInstrII = Q + 1
                           GoTo NullifyArr
                       End If
                   Loop
                   Q = Q + C + 1
                   C = 0
               Loop
NullifyArr:
               PutMem4 ArrayPtr(intAscS1), &H0
               PutMem4 ArrayPtr(intAscS2), &H0
           End If
       End If
   End If
End Function

Recordar quitar comprobación en los límites de arrays al compilar!
Debería haber tambien tests con cadenas laaaargas!

DoEvents!

[BlackZeroX]

.
Actualizado:

Maravillosa funcion Rana es constante la velocidad y muy rapida!¡.

Código [Seleccionar] Expandir



============ RETO INSTR 16/01/2011 - 02:00:22 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.376743
01 MrFrogInstrII       01.372423
02 Tokes v2            01.481183
03 Tenient101          01.783343
04 79137913            02.440223
05 Raul338             02.467343
06 Tokes               02.935583
07 Mr Frog(BlackZeroX) 02.983303
08 Miseryk             03.401823
09 gaston93            04.847983
10 krabby              07.554583
11 BlackZeroX          10.427103


=== 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.372905
01 MrFrogInstrII       01.119305
02 79137913            01.813665
03 Tenient101          01.842345
04 Raul338             02.063025
05 Mr Frog(BlackZeroX) 02.113905 ' No paso la comprobacion
06 Tokes v2            02.178465
07 BlackZeroX          02.273225
08 Tokes               03.152145
09 Miseryk             04.123825
10 gaston93            04.935465
11 krabby              05.297945


=== 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.602864
01 MrFrogInstrII       01.298824
02 gaston93            01.822624
03 BlackZeroX          02.009944
04 Mr Frog(BlackZeroX) 02.298024
05 krabby              02.540744
06 Tokes v2            17.152344
07 Raul338             17.577024
08 Tenient101          29.506144
09 79137913            31.242144
10 Tokes               37.729504
11 Miseryk             76.273224


=== 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
MrFrogInstrII 0 0 0
============ VELOCIDAD ============
00 Miseryk             00.147824 ' No paso la comprobacion
01 Raul338             00.161744
02 Tokes v2            00.166224
03 79137913            00.172664 ' No paso la comprobacion
04 Tenient101          00.204504 ' No paso la comprobacion
05 Mr Frog(BlackZeroX) 00.286784 ' No paso la comprobacion
06 krabby              00.326704 ' No paso la comprobacion
07 InStr               00.355224
08 MrFrogInstrII       00.944784 ' No paso la comprobacion
09 BlackZeroX          01.629704 ' No paso la comprobacion
10 gaston93            02.140424 ' No paso la comprobacion
11 Tokes               38.439544 ' No paso la comprobacion

Test made by BlackZeroX.



Dulces Lunas!¡.

[Psyke1]

Ya corregí la función ahora devuelve lo que tiene que devolver...  

Recordar quitar comprobación en los límites de arrays al compilar!
Debería haber tambien tests con cadenas laaaargas!

DoEvents!



Ninguna función vuestra se acerca tanto

Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
Dim tmr As New CTiming
Const s1 As String = "elhacker"
Dim s As String
Dim x As Long
Dim pos As Long

   For x = 1 To 10000
       s = s & ChrW$(Rnd * 255)
   Next
   s = s & s1
   For x = 1 To 10000
       s = s & ChrW$(Rnd * 255)
   Next
   
   Me.AutoRedraw = True
   
   tmr.Reset
   pos = InStr(1, s, s1)
   Me.Print "Instr", "Ret :"; pos, tmr.sElapsed
   
   tmr.Reset
   pos = MrFrogInstrII(1, s, s1)
   Me.Print "MrFrog", "Ret :"; pos, tmr.sElapsed
End Sub



DoEvents!