Autor
|
Tema: [RETO] Alternativa a Instr() (Leído 18,739 veces)
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. @raul338Se usaba instr() si no mal recuerdo Public Function RetInstr3(Optional Start, Optional String1, Optional String2, Optional Compare As VbCompareMethod = vbBinaryCompare) RetInstr3 = InStr(Start, String1, String2, Compare) End Function Dulces Lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
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 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
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Quizá ya un poco tarde... Aqui dejo mi 2ª forma, a diferencia de todas las demas sin depender de Mid(), Split()... 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!
|
|
« Última modificación: 17 Enero 2011, 12:55 pm por Mr. Frog © »
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. Actualizado: Maravillosa funcion Rana es constante la velocidad y muy rapida!¡. ============ 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!¡.
|
|
« Última modificación: 16 Enero 2011, 21:02 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
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 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!
|
|
« Última modificación: 16 Enero 2011, 22:28 pm por Mr. Frog © »
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
[AYUDA] Usar INSTR 2 veces
Programación Visual Basic
|
Rudy21
|
5
|
2,897
|
9 Julio 2008, 04:01 am
por cassiani
|
|
|
como cargar 100 KBs en una variable; problema con InStr
Programación Visual Basic
|
drakolive
|
5
|
3,047
|
31 Diciembre 2008, 15:20 pm
por Dessa
|
|
|
Instr para byte arrays [src]
Programación Visual Basic
|
cobein
|
3
|
2,315
|
31 Mayo 2009, 12:42 pm
por cobein
|
|
|
Alternativa a pow? [c]
« 1 2 »
Programación C/C++
|
flacc
|
10
|
11,784
|
11 Diciembre 2010, 15:25 pm
por pucheto
|
|
|
[ANSI C] Split(), strlen(), mid(), Instr(), strcpy().
« 1 2 »
Programación C/C++
|
BlackZeroX
|
11
|
10,274
|
14 Enero 2011, 02:35 am
por Littlehorse
|
|