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(). ;D
(En principio sin contar con métodos de compración)
Si hay dudas postear. ;)
(http://4.bp.blogspot.com/_SsJppEIafnw/TR0M-9KBR3I/AAAAAAAABEA/eP-VRsUOt_k/s400/000017344445.jpg)
DoEvents! :P
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 :D
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).
Bueno aca les dejo mi codigo. Me conformo con que funcione. Por lo menos pude realizarlo dentro de los pocos conocimientos que tengo ;D ;D
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
Gracias por participar! :D
Aquí dejo la mía (la primera :xD)
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
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... :silbar:
DoEvents! :P
Hola, gente:
Aquí dejo mi aporte:
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!
Me da que no vais a poder superar la velocidad de la funcion de VB :P
http://xbeat.net/vbspeed/c_InStr.htm
Feliz año nueeeevo!!
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:
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 :P
GRACIAS POR LEER!!!
Cita de: Karcrack en 1 Enero 2011, 01:53 AM
Me da que no vais a poder superar la velocidad de la funcion de VB :P
http://xbeat.net/vbspeed/c_InStr.htm
Feliz año nueeeevo!!
Aguafiestas! :laugh:
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... :P
DoEvents! :P
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 :P
Subi un proyecto con todos las funciones y una rutina para probarlas.... y la verdad, ni si quiera le ganamos a InStr :xD
============ 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
:P El proyecto se puede bajar desde aca :)
http://www.mediafire.com/?nnt1jaazilrid1o (http://www.mediafire.com/?nnt1jaazilrid1o)
Lo ire actualizando conforme modifiquen/suban funciones :)
HOLA!!!
XD, Me habia olvidado del Exit Function, ahi lo modifique.
Ahora me veo un poquito mejor en la tabla :P.
P.D1:Vuelvan a hacer la Tabla XD
P.D2: Mr. Frog Si estas en Invisible//No conectado, no puedo hablarte :P.
GRACIAS POR LEER!!!
Saludos:
Aquí les dejo una mejora (creo) del código de raul338. La he llamado Ratok338InStr:
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.
aca el mio :D
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 :xD?
.
mmmm No se que tan rapida sea mi funcion pero cumple su cometido xP
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!¡.
.
.
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().
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!¡.
.
Listo ya modifique mi funcion tenia un pequeño error, creo que ya no da resultados erroneos.
Ya corregi el código (creo), ahora no tengo mucho tiempo. :-\
Pensé que iría más rápido si trabajaba con Bytes... :silbar: :-(
Ya haré más versiones. >:D
DoEvents! :P
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()
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
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
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:
'' ================ 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).
jeje si, año nuevo, cabeza nueva, pense que toda la vida lo usaba asi y lo puse asi :xD ya cambio la firma
Hay actualizo mi funcion :)
Benchmark actualizados
1
============ 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
============ 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
============ 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 (http://www.mediafire.com/?bbr7r0s90xmgtp6)
PD: EL codigo exclusivamente de vb se pone asi [code=vb]Dim s as string[/code]
Quedando Dim s as string
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
Bien pues el resultado que me dio:
RESULTADOS PRUEBA 1:
============ 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.477649485502989
Raul338 10.0386183350126
Miseryk 16.4880727613527
gaston93 2.41434061336485
Mr Frog 5.18079225155567
Tokes 16.6270077772112
79137913 11.2904333267657
Tokes v2 9.7320513982567
Tenient101 10.14500686101
BlackZeroX 3.33684112168503
krabby 4.56310886870851
____________________________________________________________________________________________________________________________________________
RESULTADOS PRUEBA 2:
============ 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.284480818743699
Raul338 1.87330946357435
Miseryk 2.6841720120485
gaston93 3.54192950290311
Mr Frog 3.34420082794071
Tokes 2.48609337482952
79137913 2.04759066734653
Tokes v2 1.64408418552059
Tenient101 1.47925196267583
BlackZeroX 3.07158023007219
krabby 4.22855545029469
___________________________________________________________________________________________________________________________________________
RESULTADOS PRUEBA 3:
============ 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.368475259943215
Raul338 13.7436827438161
Miseryk 49.2554028048075
gaston93 1.92160775460367
Mr Frog 0.345727713266124
Tokes 25.6878945605716
79137913 15.5823844398382
Tokes v2 13.4906600323155
Tenient101 16.8831941475112
BlackZeroX 2.26947023763487
krabby 2.08259039262616
en la tercera prueba de la "Ñ" en ambos resultados sale que Mr. Frog le gana al instr, :D :D :D
...
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...
============ 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 (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Retos/InStr&file=reto.rar)
Temibles Lunas!¡.
bueno si tienes razon hay veces que el vb da un resultado en debug y otro cuando es compilado, e incluso falla en uno y en el otro no.
ehhh pero segun veo el q le gana al instr es Mr Frog.
edito: mmm :C :C quede tercer puesto .
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 (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Retos/InStr&file=Update%20reto.rar)
============ 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
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
============ 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!¡.
Jamas podreis superar a InStr()!!! >:D
Yo estoy cerca.. pero me falta el empujonzito del ASM inline... me dejais? :-[
.
La funcion de la Rana al buscar la Letra Ñ No la busca.... por eso es rapida... trabaja con Array's asi que debe ser mayor o Igual a 0 ¬¬# y CBool() toma como true cualquier numero distinto de 0, ya que 0 es false y al buscar una letra...
' Mr. Frog ©
Private Function myInstrMrFrog(ByVal Start&, ByVal String1$, ByVal String2$)
Dim bvString1() As Byte, bvString2() As Byte
Dim ls2Len&, lLimit&
Dim Q&, C&
ls2Len& = ((Len(String2$)) - &H1)
If CBool(ls2Len&) 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&))
'Put int_ff , ,ChrW$(bvString1(Q& + C&)); ChrW$(bvString2(C&))
C& = C& + &H1
If ((C& - &H1) = ls2Len&) Then
myInstrMrFrog = Q& + &H1
Exit Function
End If
Loop
Q& = (Q& + C&) + &H1
C& = &H0
Loop
End If
End If
End Function
Corrigiendo dicha linea... Con esto se arregla que Explote la funcion al buscar una string Vacia.
' Mr. Frog ©
Private Function myInstrMrFrog(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&))
'Put int_ff , ,ChrW$(bvString1(Q& + C&)); ChrW$(bvString2(C&))
C& = C& + &H1
If ((C& - &H1) = ls2Len&) Then
myInstrMrFrog = Q& + &H1
Exit Function
End If
Loop
Q& = (Q& + C&) + &H1
C& = &H0
Loop
End If
End If
End Function
============ RETO INSTR 01/01/2011 - 03:49:20 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.5884212
1 gaston93 2.8621812
2 Mr Frog 4.4889812
3 Raul338 15.8145412
4 BlackZeroX 5.0922212
5 krabby 7.1112212
6 Miseryk 27.8807812
7 Tenient101 15.0253412
8 Tokes v2 15.6543412
9 79137913 17.5959812
10 Tokes 30.6114212
============ RETO INSTR 01/01/2011 - 03:49:20 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 1.1657844
1 79137913 1.8203044
2 Tenient101 1.9081844
3 BlackZeroX 2.0457044
4 Raul338 2.0655044
5 Tokes v2 2.4687044
6 Tokes 2.7844644
7 Miseryk 3.3320644
8 Mr Frog 3.7709044
9 gaston93 4.8395844
10 krabby 5.6555444
============ RETO INSTR 01/01/2011 - 03:49:20 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 InStr 0.4920232
1 gaston93 1.8135032
2 BlackZeroX 1.8769032
3 krabby 2.1987032
4 Mr Frog 3.8963832
5 Raul338 18.0244632
6 Tokes v2 17.9593432
7 79137913 22.1435432
8 Tenient101 23.3084632
9 Tokes 42.3355032
10 Miseryk 82.4681032
Temibles Lunas!¡.
Cita de: Karcrack en 1 Enero 2011, 22:23 PM
Jamas podreis superar a InStr()!!! >:D
============ VELOCIDAD ============
0 Mr Frog 0.2237288
1 InStr 0.4316488Aunque fuera en solo un test, le saco el doble... ::) :xD
Cita de: Karcrack en 1 Enero 2011, 22:23 PM
Yo estoy cerca.. pero me falta el empujonzito del ASM inline... me dejais? :-[
Tramposo! :¬¬
Ook, puedes ponerlo, así de paso aprendo... :P
@BlackZer0xOops, se me escapo lo de CBool() tienes razón... :silbar:
DoEvents! :P
mmmmm se me paso ese detalle de q si se busca cadena vacia el instr siempre devuelve la posicion que le indicamos, black zero nos dio un jalon de orejas, ahora todos a mejorar nuestros codes.
Bueno, dejo mi segunda manera de hacerlo... :)
Private Function InstrMrFrog02&(ByVal Start&, ByVal String1$, ByVal String2$)
Dim lTemp&, lenStr1&
lenStr1& = VBA.Len(String1$)
If CBool(lenStr1&) Then
If CBool(VBA.LenB(String2$)) Then
lTemp& = Len(VBA.Split(String1$, String2$)(&H0&))
If Not (lTemp& = lenStr1&) Then
InstrMrFrog02& = (lTemp& + &H1&)
End If
End If
End If
End Function
Creo que sería conveniente no testear casi a cada función que se añade, mejor esperar al final y hacerlo todo de una vez, ¿no? :huh:
DoEvents! :P
Esto no quedó muy claro
(En principio sin contar con métodos de compración)
si te refieres a que no se debe usar estructuras de decisión entonces todos perdimos por usar el if :P, pero bueno si no es asi se puede usar otra función parecida a la instr ;D
Public Function InstrNew2(Start As Integer, Str1 As String, Str2 As String) As Integer
InstrNew2 = Len(Str1) - InStrRev(StrReverse(Str1), StrReverse(Str2), Start - 2) + 1
End Function
http://pastebin.ca/2036231 (http://pastebin.ca/2036231)
Aún así no le gana al instr :¬¬ :xD
.
Plagiador pense que no la hibas a poner ¬¬",
es en cierta manera IGUAL a la primera que puse, solo que tu usas Len a cada rato
¬¬".
Cita de: Mr. Frog © en 2 Enero 2011, 01:21 AM
Bueno, dejo mi segunda manera de hacerlo... :)
Private Function InstrMrFrog02&(ByVal Start&, ByVal String1$, ByVal String2$)
Dim lTemp&, lenStr1&
lenStr1& = VBA.Len(String1$)
If CBool(lenStr1&) Then
If CBool(VBA.LenB(String2$)) Then
lTemp& = Len(VBA.Split(String1$, String2$)(&H0&))
If Not (lTemp& = lenStr1&) Then
InstrMrFrog02& = (lTemp& + &H1&)
End If
End If
End If
End Function
Creo que sería conveniente no testear casi a cada función que se añade, mejor esperar al final y hacerlo todo de una vez, ¿no? :huh:
DoEvents! :P
Teoricamente lo que estas haciendo e slo mismo que yo hice... ¬¬".
http://foro.elhacker.net/programacion_visual_basic/reto_alternativa_a_instr-t315420.0.html;msg1562191#msg1562191
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
Temibles Lunas!¡.
@Black
No me fije en la tuya para hacerlo, no soy tan descarado... :¬¬ :laugh:
Pero ahora que lo dices : sí, son practicamente iguales, esta no cuenta... :P
@Tenient101
:xD
Me refiero al 4 argumento que trae el Instr() ;) :
Compare As VbCompareMethod
DoEvents! :P
.
No hay problema el algoritmo que te dige trae errores que corregi en mi otro algoritmo
http://foro.elhacker.net/programacion_visual_basic/reto_alternativa_a_instr-t315420.0.html;msg1562386#msg1562386
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
Temibles Lunas!¡.
.
Alguien deberia hacer limpieza aca :xD
Mejore el sistemita de pruebas, y agrego una prueba mas (gracias BlackZeroX) se busca un string nulo :xD (se pueden hacer mas pruebas, ej buscar "abc" en "a", etc pero habria que modificar mas, hacerlo mas personalizable xD).
Y agregue que se ordene automaticamente los resultados :)
============ 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
http://www.mediafire.com/?sws0gx764h4xake (http://www.mediafire.com/?sws0gx764h4xake)
Modifique 2 lineas de mi funcion tambien! :)
propongo que para no estar codeando a cada rato haciendo pequeñas mejoras, mejor averiguamos todo lo que hace el instr , luego ponemos a prueba el instr en distintos casos para ver lo que resulta, por ejmplo: que es lo que devuelve cuando se busca cadenas vacias, o que devuelve cuando se le pasa una posicion mayor a la cadena de busqueda, etc... y luego tratamos de igualar, o mejor dicho imitar al instr y despues vemos cual de todos los codes es el mejor.
editado: Mr Frog. anda pensando en otro reto, y lo lanzas despues de este.
;D ;D ;D ;D
.
* Si String1 = "" y String2 = "" entonces se retorna 0
* Si String1 <> "" y String = "" entonces; Segun el siguiente caso
Si Start = 1 se retorna Start
Si Start > 1 se retorna Start
* Si string1 = "" y String2 <> "" entonces se retorna 0
* El Caso que falta Son por logica y ya esta hecho... es decir la busqueda pertiente y Retornar 0 si no se encontro o retornar la posicion donde se encontro.
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Public Function RetInstr2(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
Dim lng_ST2 As Long
lng_ST1 = lstrlenW(StrPtr(String1))
lng_ST2 = lstrlenW(StrPtr(String2))
If Start < 0 Then Start = 0
If lng_ST2 > 0 Then
If Not Start > lng_ST1 Then
If Start = 1 Then
If lng_ST2 > 1 Then
RetInstr2 = (Start + lstrlenW(StrPtr(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0)))) + 1
Else
RetInstr2 = (Start + lstrlenW(StrPtr(Split(Right$(String1, lng_ST1), String2, 2, Compare)(0))))
End If
Else
RetInstr2 = (Start + lstrlenW(StrPtr(Split(Right$(String1, lng_ST1 - Start + 1), String2, 2, Compare)(0))))
End If
If RetInstr2 > lng_ST1 Then RetInstr2 = 0
End If
ElseIf lng_ST1 > 0 Then
RetInstr2 = Start
Else
RetInstr2 = 0
End If
End Function
Cita de: krabby en 2 Enero 2011, 03:51 AM
editado: Mr Frog. anda pensando en otro reto, y lo lanzas despues de este.
tengo uno y se llama
zig zag mañana lo pongo...
Bien pues ... ya son las 2:35 am por aki y me kgo de sueño, mañana espero el reto zig zag (me suena a encriptacion) , pero weno qué será? qué será?
hasta mañana.
@BlackZeroX▓▓▒▒░░: Hasta donde yo se usar la funcion Len() de VB es mucho mas rapido, ya que VB automaticamente mete un DWORD con el tamaño de la cadena antes de ella :)
Y para todos aquellos que utilizamos un Array... recordad compilar desactivando la comprobacion de seguridad en los Arrays... si no cada vez que haces cualquier acceso al Array comprueba que el tamaño sea mayor que el indice... y eso relentiza mucho ;)
@BlackTiene razón
Karcry... testeé velocidad y se nota un ligera tardanza usando api
lstrlenW() respecto a
Len() de vb. :-\
@karcryhttp://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=30761&lngWId=1
CitarThis code runs as much as 5000 times faster than VB's InStr function!
:silbar:
Cita de: Karcrack en 1 Enero 2011, 22:23 PM
Jamas podreis superar a InStr()!!! >:D
Te lo dedico :-* >:D :laugh: :laugh: :laugh: :laugh:
Fue divertido el reto, a ver si retomamos los retos poco a poco en esta sección, que es una forma divertida de pasar el rato y mejorar/aprender... ;D
Ahora a por el de Black! :)
http://goo.gl/7Wkqb
DoEvents! :P
Veo que varios usaron Split, sin embargo creo recordar que habiamos puesto un reto tratando de reemplazar a Split :xD
Nose si podriamos juntarlos (no encuetro el thread) :P nose , se me ocurre :)
Yo el único que lo hice un poco diferente... :silbar:
:xD
DoEvents! :P
.
@raul338
Se usaba instr() si no mal recuerdo
:silbar: :silbar: :silbar: :silbar:
Public Function RetInstr3(Optional Start, Optional String1, Optional String2, Optional Compare As VbCompareMethod = vbBinaryCompare)
RetInstr3 = InStr(Start, String1, String2, Compare)
End Function
Dulces Lunas!¡.
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
Quizá ya un poco tarde... :silbar:
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! :silbar:
DoEvents! :P
.
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!¡.
Ya corregí la función ahora devuelve lo que tiene que devolver... ;)
Cita de: Mr. Frog © en 16 Enero 2011, 18:56 PM
Recordar quitar comprobación en los límites de arrays al compilar!
Debería haber tambien tests con cadenas laaaargas! :silbar:
DoEvents! :P
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(http://img522.imageshack.us/img522/2307/dibujoqgr.jpg)
DoEvents! :P