[RETO] + Funcion Extraer Numeros de Cadenas!

Iniciado por x64core, 4 Enero 2012, 23:06 PM

0 Miembros y 13 Visitantes están viendo este tema.

BlackZeroX

#10
Cita de: Karcrack en  5 Enero 2012, 11:42 AM
No debería devolver un número?
Deberías poner la declaración de la función, para que BlackZeroX no empiece a usar buffers declarados fuera de esta :P

¡TE MALDIGO¡.

@RHL - 该0在
Maldito Tramposo usas la misma String para retornar...



¡Aun asi dejo la actualizada! (Edite mi codigo).

Dulces Lunas!¡.
The Dark Shadow is my passion.

x64core

 :xD
no es trampa v_v
haber quien le gana a mi MOV :3

Karcrack

#12
@RHL: No deberías declarar RtlMoveMemory() por el ordinal... es probable que no funcione en todas las versiones de W$.


Mi código:
Código (vb) [Seleccionar]
Private Static Sub kGetNums(ByRef s As String)
   Dim bv(0)   As Byte
   Dim pbv     As Long
   Dim rps     As Long
   Dim i       As Long
   Dim b       As Byte
   Dim w       As Long
   
   If pbv = 0 Then pbv = VarPtr(bv(0))
   
   rps = StrPtr(s) - pbv
   w = 0
   
   For i = 0 To LenB(s) Step 10
       b = bv(rps + i + 0)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 2)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 4)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 6)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 8)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
   Next i
   
   bv(rps + w) = 0
End Sub

Código (vb) [Seleccionar]
dim x as string
x = "1e2e3a4b"
call kGetNums(x)
msgbox x

HAY QUE DESACTIVAR LA COMPROBACIÓN DE TAMAÑO DEL BUFFER!!! Y probar compilado (of course!)!!!
He arriesgado un poco con el unwinding del bucle... pero ya veremos los resultados :laugh: :laugh:

Sería conveniente también que para hacer las pruebas de velocidad además de hacerlo compilado hacerlo sin comprobación de buffers y comprobación de overflow!!

PD: He ganado a "tu" mov :P :P

BlackZeroX

Yo hiba a hacer el truquito de "Quitar la comprovacion en limites de las matrices"...  :¬¬ eso me pasa por irme a bañar  :¬¬.

Ahora te odio mas...

Temibles Lunas!¡.
The Dark Shadow is my passion.

x64core

#14
Eso ya es magia negra o blanca v_v
igual ya termino todo me temía lo peor v_v' osea un mov sin apis ni asm inline
ya hay ganador no creo que nadie supere la funcion la funcion de karcrack :P v_V

EDIT:
@Karcrack
Karcrack, te espero en el proximo reto que se valdra absolutamente de todo!


79137913

HOLA!!!

Como me lo imaginaba Kcrack WON XD.



@KCrack:
Como hago para que una funcion :
Private Function A (b() as byte) as byte ()

Me soporte la entrada de srtings en b() as byte ...



@Raul, no me podes usar la misma variable para devolver y pedir  retLen XD, ... por eso siempre digo que hay que poner la declaracion de la funcion sino se da lugar a confuciones.

GRACIAS POR LEER!!!
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

79137913                          *Shadow Scouts Team*

BlackZeroX

#16
La funcion de Karcrack me crashea mmm aun asi prueba esta funcion... ("Quitar la comprovacion en limites de las matrices)... En TEORIA es mas rapida que la que puso Karcrack...

Código (vb) [Seleccionar]


Private Function getNumbers2(ByRef sIn As String, ByRef sOut As String) As Long
Dim thisWord(0) As Integer  '   //  Un caracter = 2 bytes = integer
Dim dwOffSetGet As Long     '   //  Offset Get caracter...
Dim dwOffSetSet As Long     '   //  Offset Set caracter...
Dim wWord       As Integer  '   //  Letra en asc...
Dim dwRet       As Integer  '   //  Cantidad de digitos encontrados...
Dim dwLenI      As Long     '   //  Longitud en bytes de sIn...
Dim dwLenB      As Long     '   //  Longitud en bytes de sOut...
Dim dwOffset    As Long     '   //  Offset del Buffer...

    dwOffSetGet = (StrPtr(sIn) - VarPtr(thisWord(0))) \ 2
    dwLenB = LenB(sOut)
   
    If (dwLenB) Then
        dwOffSetSet = (StrPtr(sOut) - VarPtr(thisWord(0))) \ 2
    End If
    dwLenI = LenB(sIn)

    If (dwLenI) Then
        Do
            If (dwLenI And &H80000000) Then Exit Do
           
            wWord = thisWord(dwOffSetGet)
           
            If (wWord >= &H30) Then
                If (wWord <= &H39) Then
                    dwRet = (dwRet + 1)
                    If (dwLenB) Then
                        thisWord(dwOffSetSet) = wWord
                        dwOffSetSet = (dwOffSetSet + 1)
                        dwLenB = (dwLenB - 2)
                    End If
                End If
            End If
           
            dwOffSetGet = (dwOffSetGet + 1)
            dwLenI = (dwLenI - 2)
           
        Loop While (wWord > 0)
    End If

    thisWord(dwOffSetSet) = &H0&
    getNumbers2 = dwRet
   
End Function

The Dark Shadow is my passion.

seba123neo

yo probe la funcion de Karcrack y no hay manera de que funcione, me tira subindice fuera del intervalo.

saludos.
La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson

BlackZeroX

Cuando lo compiles "Quitar la comprovacion en limites de las matrices"... hay en Opciones despues de darle generar exe...

Dulces Lunas!¡.
The Dark Shadow is my passion.

x64core

#19
@79137913
el retlen lo escribi porque yo queria, la longitud de los valores encontrados no venia al reto
osea era cuestion de uno, y en cuanto a devolver y recibir en la misma variable... esta bien modificare el codigo a tu gusto ;)

Funcion GetNums ( STR as string ) as string