Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Psyke1 en 13 Febrero 2011, 19:54 pm



Título: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 13 Febrero 2011, 19:54 pm
Un reto fácil, en el que creo que puede participar mucha gente. :)
Consiste en obtener el nombre de archivo a partir de una ruta, así:

Código:
C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi
Deberia devolver la función:
Código:
SexoDeRanas.avi

Quien sea más rápido, gana. ;)
Se testeará con cFrogContest.cls :P

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: ignorantev1.1 en 13 Febrero 2011, 20:03 pm
Código
  1. Function getFileName(ByVal path As String) As String
  2.    Dim cM As Integer
  3.    cM = InStrRev(path, "\") + 1
  4.    If cM = 0 Then Exit Function
  5.    getFileName = Mid(path, cM)
  6. End Function
  7.  


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: seba123neo en 13 Febrero 2011, 20:08 pm
Código
  1. Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
  2.  
  3. Public Function StripPath(ByVal sPath As String) As String
  4.   Call PathStripPath(sPath)
  5.   StripPath = sPath
  6. End Function
  7.  


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: seba123neo en 13 Febrero 2011, 20:34 pm
la api es una de las mas compactas, pero es la mas lenta, aca paso una optimizacion de la que puso ignorantev1.1 , es unos 300 milisegundos mas rapida.

Código
  1. Function getFileName(ByVal path As String) As String
  2.    getFileName = Mid$(path, InStrRev(path, "\") + 1)
  3. End Function


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: 79137913 en 13 Febrero 2011, 20:45 pm
HOLA!!!

No tengo el VB aca asi que solo dejo el codigo(sin testear):
Código
  1. Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
  2.  
  3. Private Function Fn7913(sPath As String) As String
  4.     Dim Mem As String
  5.     Mem = String(255, 0)
  6.     GetFileTitle sPath, Mem, 255
  7.     Fn7913 = Trim(Mem)
  8. End Function

GRACIAS POR LEER!!!


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: grester43hck en 13 Febrero 2011, 20:55 pm
Código
  1. Function nombre_archivo(ByVal Ruta As String) As String
  2. Dim partes() As String
  3. partes = Split(Ruta, "\")
  4. nombre_archivo = partes(UBound(partes))
  5. End Function

Seguramente no es la mas rapida ni por asomo xD


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: seba123neo en 13 Febrero 2011, 21:01 pm
Seguramente no es la mas rapida ni por asomo xD

no, es lentisima  ;D

las 2 mas rapidas hasta ahora es la segunda que puse yo y la de 79137913, a veces una dura mas y la otra menos, esta en la pelea.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: ignorantev1.1 en 13 Febrero 2011, 21:09 pm
Esta pregunta la he hecho unas 450 veces pero se me olvida  :-[

Como medimos la velocidad?

@seba123neo
Jajajajaja te barriste con tu segunda funcion  ;-)


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 13 Febrero 2011, 21:10 pm
La mía:
Código
  1. Public Static Function GetFileMrFrog(ByRef sFile As String) As String
  2.    GetFileMrFrog = RightB$(sFile, LenB(sFile) - InStrB(sFile, "\") - 1)
  3. End Function

@ignorantev1.1
http://foro.elhacker.net/programacion_visual_basic/src_cfrogcontestcls_by_mr_frog_copy-t318871.0.html

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: seba123neo en 13 Febrero 2011, 21:16 pm
con la clase CTiming, la podes bajar de aca:

CTiming (http://www.xbeat.net/vbspeed/download/CTiming.zip)

aca va el codigo, con las funciones posteadas hasta ahora. pongan un boton en el form y este codigo.

Código
  1. Option Explicit
  2.  
  3. Private CTiming As CTiming
  4.  
  5. Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
  6. Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
  7.  
  8. Const Path As String = "C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi"
  9.  
  10. Dim i As Long
  11. Dim ValTest As Long
  12. Dim vres As String
  13.  
  14. Private Sub Command1_Click()
  15.    Me.Print "Test de velocidad" & vbCrLf
  16.  
  17.    ValTest = 10000
  18.  
  19.    CTiming.Reset
  20.  
  21.    For i = 0 To ValTest
  22.        vres = StripPath(Path)
  23.    Next
  24.  
  25.    Me.Print "seba123neo api: " & CTiming.sElapsed
  26.  
  27.    CTiming.Reset
  28.  
  29.    For i = 0 To ValTest
  30.        vres = GetFileName(Path)
  31.    Next
  32.  
  33.    Me.Print "ignorantev1.1: " & CTiming.sElapsed
  34.  
  35.    CTiming.Reset
  36.  
  37.    For i = 0 To ValTest
  38.        vres = getFileName2(Path)
  39.    Next
  40.  
  41.    Me.Print "seba123neo (ignorantev1.1): " & CTiming.sElapsed
  42.  
  43.    CTiming.Reset
  44.  
  45.    For i = 0 To ValTest
  46.        vres = Fn7913(Path)
  47.    Next
  48.  
  49.    Me.Print "79137913: " & CTiming.sElapsed
  50.  
  51.    CTiming.Reset
  52.  
  53.    For i = 0 To ValTest
  54.        vres = nombre_archivo(Path)
  55.    Next
  56.  
  57.    Me.Print "grester43hck: " & CTiming.sElapsed
  58.  
  59.    CTiming.Reset
  60.  
  61.    For i = 0 To ValTest
  62.        vres = GetFileMrFrog(Path)
  63.    Next
  64.  
  65.    Me.Print "Mr. Frog ©: " & CTiming.sElapsed
  66.  
  67.    CTiming.Reset
  68.  
  69.    For i = 0 To ValTest
  70.        vres = GetFileName123(Path)
  71.    Next
  72.  
  73.    Me.Print "seba123neo (segunda): " & CTiming.sElapsed
  74.  
  75.    CTiming.Reset
  76.  
  77.    For i = 0 To ValTest
  78.        vres = SacarFilenameE_C(Path)
  79.    Next
  80.  
  81.    Me.Print "Elemental Code: " & CTiming.sElapsed
  82.  
  83.    CTiming.Reset
  84.  
  85.    For i = 0 To ValTest
  86.        vres = SacarFilenameE_Cv2(Path)
  87.    Next
  88.  
  89.    Me.Print "Elemental Code 2: " & CTiming.sElapsed
  90.  
  91. End Sub
  92.  
  93. Private Sub Form_Load()
  94.    Set CTiming = New CTiming
  95.    Me.AutoRedraw = True
  96. End Sub
  97.  
  98. Private Function StripPath(ByVal sPath As String) As String
  99.   Call PathStripPath(sPath)
  100.   StripPath = sPath
  101. End Function
  102.  
  103. Private Function getFileName2(ByVal Path As String) As String
  104.    getFileName2 = Mid$(Path, InStrRev(Path, "\") + 1)
  105. End Function
  106.  
  107. Private Function GetFileName(ByVal Path As String) As String
  108.    Dim cM As Integer
  109.    cM = InStrRev(Path, "\") + 1
  110.    If cM = 0 Then Exit Function
  111.    GetFileName = Mid(Path, cM)
  112. End Function
  113.  
  114. Private Function Fn7913(ByVal sPath As String) As String
  115.    Dim Buffer As String
  116.    Buffer = String(255, 0)
  117.    GetFileTitle sPath, Buffer, Len(Buffer)
  118.    Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
  119. End Function
  120.  
  121. Private Function nombre_archivo(ByVal Ruta As String) As String
  122.    Dim partes() As String
  123.    partes = Split(Ruta, "\")
  124.    nombre_archivo = partes(UBound(partes))
  125. End Function
  126.  
  127. Public Static Function GetFileMrFrog(ByRef sFile As String) As String
  128.    GetFileMrFrog = RightB$(sFile, LenB(sFile) - InStrB(sFile, "\") - 1)
  129. End Function
  130.  
  131. Public Function GetFileName123(ByRef vPath As String) As String
  132.    GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\"))
  133. End Function
  134.  
  135. Public Function SacarFilenameE_C(ByRef sPath As String) As String
  136.    SacarFilenameE_C = StrReverse(Left(StrReverse(sPath), InStr(1, StrReverse(sPath), "\", vbBinaryCompare) - 1))
  137. End Function
  138.  
  139. Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String
  140.    SacarFilenameE_Cv2 = Right(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare))
  141. End Function
  142.  

PD: no vi que era con la clase modificada de Mr. Frog © , pero me imagino que no hay diferencia no ?

saludos.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: seba123neo en 13 Febrero 2011, 21:24 pm
con razon la de 79137913 a veces decia mas y otras menos, en realidad no la estaba usando, usaba 2 veces la funcion mia  :xD, ahi corregi el codigo de las funciones, en mi post, aparte fijate 79137913 que esta mal porque no estas eliminando los espacios del buffer que creas y eso la hace lentisima, la funcion bien esta aca:

GetFileTitle - Obtener nombre de archivo de un path (http://www.recursosvisualbasic.com.ar/htm/listado-api/98-obtener-archivo-de-path.htm)

o sea seria:

Código
  1. Private Function Fn7913(ByVal sPath As String) As String
  2.    Dim Buffer As String
  3.    Buffer = String(255, 0)
  4.    GetFileTitle sPath, Buffer, Len(Buffer)
  5.    Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
  6. End Function

igual sigue un poco mas lenta que las demas.

@ Mr. Frog ©

la funcion que posteaste no funciona, solo le quita el directorio principal.

aca va otra, esta tarda la mitad de la ultima que habia posteado.

Código
  1. Public Function GetFileName123(ByRef vPath As String) As String
  2.    GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\"))
  3. End Function

saludos.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Elemental Code en 13 Febrero 2011, 21:53 pm
No creo que sea la mas rapida
pero tampoco creo que sea la mas lenta :P

Código
  1. Public Function SacarFilenameE_C(ByRef sPath As String) As String
  2. SacarFilenameE_C = StrReverse$(Left$(StrReverse$(sPath), InStr(1, StrReverse$(sPath), "\", vbBinaryCompare) - 1))
  3. End Function

EDITO:
Medio segundo despues de que puse el tema encontre la funcion InStrRev :P

aca una segunda funcion

Código
  1. Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String
  2.    SacarFilenameE_Cv2 = Right$(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare))
  3. End Function


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 13 Febrero 2011, 22:32 pm
Código
  1. Public Static Function GetFileMrFrog(ByRef sFile As String) As String
  2.    GetFileMrFrog = RightB$(sFile, InStrRev(sFile, "\") * 2 - 2)
  3. End Function

Esta si! :P
Despues testeo ahora no tengo tiempo.
@Seba123neo
Jajajaj hice la clase precisamente para ahorrarte el trabajo! :xD

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Elemental Code en 13 Febrero 2011, 22:51 pm
Van a pensar que salio asi porque lo hice yo  :-[ :-[
Código:
================================================================================
º Contest Name : ObtenerNombreArchivo
º Explanation  : Mas claro, hechale agua
º Arguments    : C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi
º Loops        : 1000
º Date & Hour  : 02-13-2011 <-> 18:48:31
================================================================================
Results [compiled] :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- SacarFilenameE_C                                    -> 24,129044 msec
2.- SacarFilenameE_Cv2                                  -> 27,445965 msec
3.- getFileNameIgnorante                                -> 30,370386 msec
4.- getFileNameIgnoranteMODSeba                         -> 36,459560 msec
5.- GetFilename123                                      -> 38,079072 msec
6.- nombre_archivoGrester                               -> 46,986994 msec
7.- Fn7913                                              -> 256,390794 msec
================================================================================
º The following functions returns incorrect results :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- GetFileMrFrog
2.- StripPathSeba
================================================================================
>>> Test made by cFrogContest.cls <-> Visit foro.elhacker.net <<<
================================================================================



capas que le erre en algo  :-[

Asi esta codeado:
Código:
Private cFC                     As New cFrogContest '// Class declaration.

Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Public Function SacarFilenameE_C(ByRef sPath As String) As String
SacarFilenameE_C = StrReverse$(Left$(StrReverse$(sPath), InStr(1, StrReverse(sPath), "\", vbBinaryCompare) - 1))
End Function
Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String
    SacarFilenameE_Cv2 = Right$(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare))
End Function
Public Static Function GetFileMrFrog(ByRef sFile As String) As String
    GetFileMrFrog = RightB$(sFile, InStrRev(sFile, "\") * 2 - 2)
End Function
Public Function getFileNameIgnorante(ByVal path As String) As String
    Dim cM As Integer
    cM = InStrRev(path, "\") + 1
    If cM = 0 Then Exit Function
    getFileNameIgnorante = Mid(path, cM)
End Function
Public Function StripPathSeba(ByVal sPath As String) As String
   Call PathStripPath(sPath)
   StripPathSeba = sPath
End Function
Public Function getFileNameIgnoranteMODSeba(ByVal path As String) As String
    getFileNameIgnoranteMODSeba = Mid$(path, InStrRev(path, "\") + 1)
End Function
Public Function nombre_archivoGrester(ByVal Ruta As String) As String
Dim partes() As String
partes = Split(Ruta, "\")
nombre_archivoGrester = partes(UBound(partes))
End Function
Public Function Fn7913(ByVal sPath As String) As String
    Dim Buffer As String
    Buffer = String(255, 0)
    GetFileTitle sPath, Buffer, Len(Buffer)
    Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
 End Function
 Public Function GetFileName123(ByRef vPath As String) As String
    GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\"))
End Function

Private Sub Form_Load()
    With cFC
        .ContestName = "ObtenerNombreArchivo"                      '// The constest name.
        .Explanation = "Mas claro, hechale agua" '// Little explanation.
        .SaveDirectory = App.path                       '// Directory where you saved the test.
        .ReplaceFile = True                        '// To overwrite the file.
        .Functions "Fn7913,GetFileMrFrog,GetFilename123,getFileNameIgnorante,getFileNameIgnoranteMODSeba,nombre_archivoGrester,SacarFilenameE_C,SacarFilenameE_Cv2,StripPathSeba"  '// Name of the functions.
        .Arguments "C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi"        '// Arguments of functions (must be the same in all functions).
        .NumberOfLoops = 1000                        '// Number of Loop to call them.
        .Result = "SexoDeRanas.avi"                           '// This result should give functions.
        .SetObject Me                               '// Object (needed to make the calls).
        .TestIt                                     '// Execute the test and save it.
        .ShowTest                                   '// Shows the txt file.
    End With
    
End


End Sub

y necesita la clase que codeo mi amigo ranafonico.

http://foro.elhacker.net/programacion_visual_basic/src_cfrogcontestcls_by_mr_frog_copy-t318871.0.html


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: BlackZeroX en 13 Febrero 2011, 23:10 pm
.
tal vez no sea la mas rapida pero si la que no te va a devolver cosas raras.

Ej (Agregar estas cadena al Test):

Código:

C:\carpetas con varios puntos ... segun los parametros\ARCHIVO
C:\carpetas con varios puntos ... segun los parametros\ARCHIVO
C:\carpetas con varios puntos ... segun los parametros\ARCHIVO
C:\carpetas con varios puntos ... segun los parametros\ARCHIVO.EXE
C:\carpetas con varios puntos ... segun los parametros\ARCHIVO.EXE
C:\carpetas con varios puntos ... segun los parametros\ARCHIVO.EXE
C:ARCHIVO.exe
C:ARCHIVO.exe
C:ARCHIVO.exe
C:...ARCHIVO.exe
C:...ARCHIVO.exe
C:...ARCHIVO.exe


GetPatchInfo (http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8)

Dulces Lunas!¡.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Elemental Code en 13 Febrero 2011, 23:19 pm
@BlackZeroX

La funcion del hombre rana me fuerza a usar los mismos argumentos para todas las funciones.
Tu funcion tiene mas vueltas que una calecita  :huh: :-\

PD: Aguante el topo yiyo  ;D


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: seba123neo en 13 Febrero 2011, 23:25 pm
te falta postear la ultima que puse, fijate que editamos el post casi al mismo tiempo  :xD y pusimos la misma funcion con una diferencia, solo que la tuya hace el vbBinaryCompare.

la de la api que yo posteo creo que no anda con la clase de Mr. Frog ©  porque en la documentacion de la api dice que esta api no devuelve ningun valor, el valor que devuelve lo hace sobre la misma variable que le pasas y por eso creo que la clase que llama a la api espera un resultado que nunca llega y termina en error.

saludos.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: BlackZeroX en 13 Febrero 2011, 23:37 pm
@BlackZeroX

Tu funcion tiene mas vueltas que una calecita  :huh: :-\

PD: Aguante el topo yiyo  ;D

1) No tiene tantas vueltas. aun que el resultado es seguro xP ( Puse algunas cadenas Extras y muchas de ellas si las pruebo con las funciones que se publicaron aquí crashean a excepción de las API que en mi forma de ver deberian excluirse del reto pero bueno ).
2) Yeah.

Dulces Lunas!¡.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: 79137913 en 14 Febrero 2011, 00:23 am
HOLA!!!

Pff que bajon era re lenta, aho ra mo pongo a hacer otra funcion, daba asco la primera, pero testeenla por que no tengo vb aca

GRACIAS POR LEER!!!


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: 79137913 en 14 Febrero 2011, 02:11 am
HOLA!!!

Estuve buscando otras maneras de hacerlo, pero cuanto mas ganaba velocidad la funcion mas se asemejaba a las que habian posteado, asi que no vale :P.

En fin quiten la mia del test que solo realentiza...

Ahh, aca les dejo la version mas lenta que puede haber :P

Agreguen en referencias Microsoft Scripting Runtime

Código
  1. Private Function VeryVerySlow7193(sPath as string) as string
  2. Dim fso As New FileSystemObject
  3. Dim Archivo as File
  4. Set Archivo = fso.GetFile(sPath)
  5. If Not (Fi  Is Nothing) Then VeryVerySlow7913 = Fi.Name : Exit Function
  6. VeryVerySlow7913 = "Error, asegurese que el archivo existe (This Function Sucks)"
  7. End Function

GRACIAS POR LEER!!!


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 02:45 am
En primer lugar gracias a todos por participar! :D
En segundo lugar perdón por haber puesto códigos que no funcionaban, andaba con prisa... :¬¬
Este es mi último código:

Código
  1. Public Static Function MrFrogGetFileFast(ByRef sPath As String) As String
  2. Dim L                                               As Long
  3. Dim lngPos                                          As Long
  4.  
  5.    L = LenB(sPath) \ 2
  6.    lngPos = L - InStrRev(sPath, "\", L, vbBinaryCompare)
  7.    MrFrogGetFileFast = RightB$(sPath, lngPos + lngPos)
  8. End Function

Test:
Código:
Option Explicit

Private cFC As New cFrogContest

Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer

Public Static Function MrFrogGetFileFast(ByRef sPath As String) As String
Dim L                                               As Long
Dim lngPos                                          As Long
   
    L = LenB(sPath) \ 2
    lngPos = L - InStrRev(sPath, "\", L, vbBinaryCompare)
    MrFrogGetFileFast = RightB$(sPath, lngPos + lngPos)
End Function

Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String
    SacarFilenameE_Cv2 = Right$(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare))
End Function

Public Function SacarFilenameE_C(ByRef sPath As String) As String
SacarFilenameE_C = StrReverse$(Left$(StrReverse$(sPath), InStr(1, StrReverse(sPath), "\", vbBinaryCompare) - 1))
End Function

Public Function getFileNameIgnorante(ByVal path As String) As String
    Dim cM As Integer
    cM = InStrRev(path, "\") + 1
    If cM = 0 Then Exit Function
    getFileNameIgnorante = Mid(path, cM)
End Function

Public Function StripPathSeba(ByVal sPath As String) As String
   Call PathStripPath(sPath)
   StripPathSeba = sPath
End Function

Public Function getFileNameIgnoranteMODSeba(ByVal path As String) As String
    getFileNameIgnoranteMODSeba = Mid$(path, InStrRev(path, "\") + 1)
End Function

Public Function nombre_archivoGrester(ByVal Ruta As String) As String
Dim partes() As String
partes = Split(Ruta, "\")
nombre_archivoGrester = partes(UBound(partes))
End Function

Public Function Fn7913(ByVal sPath As String) As String
    Dim Buffer As String
    Buffer = String(255, 0)
    GetFileTitle sPath, Buffer, Len(Buffer)
    Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
 End Function
 
Public Function GetFileName123(ByRef vPath As String) As String
    GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\"))
End Function

Private Sub Form_Load()
    With cFC
        .ContestName = "ObtenerNombreArchivo"
        .Explanation = "Mas claro, hechale agua"
        .SaveDirectory = App.path
        .ReplaceFile = True
        .Functions "Fn7913,MrFrogGetFileFast,GetFilename123,getFileNameIgnorante,getFileNameIgnoranteMODSeba,nombre_archivoGrester,SacarFilenameE_C,SacarFilenameE_Cv2,StripPathSeba"
        .Arguments "C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi"
        .NumberOfLoops = 10000
        .Result = "SexoDeRanas.avi"
        .SetObject Me
        .TestIt
        .ShowTest
    End With
   
    End
End Sub

Resultado :
Código:
================================================================================
º Contest Name : ObtenerNombreArchivo
º Explanation  : Mas claro, hechale agua
º Arguments    : C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi
º Loops        : 10000
º Date & Hour  : 02-14-2011 <-> 02:54:08
================================================================================
Results [compiled] :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- MrFrogGetFileFast                                   -> 66,783268 msec
2.- SacarFilenameE_Cv2                                  -> 70,190216 msec
3.- MrFrogGetFileFast                                   -> 74,492314 msec
4.- SacarFilenameE_C                                    -> 78,365336 msec
5.- getFileNameIgnorante                                -> 79,100052 msec
6.- getFileNameIgnoranteMODSeba                         -> 88,191208 msec
7.- GetFilename123                                      -> 91,506807 msec
8.- nombre_archivoGrester                               -> 129,792677 msec
9.- Fn7913                                -> 2159,992821 msec
================================================================================
º The following functions returns incorrect results :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- StripPathSeba
================================================================================
>>> Test made by cFrogContest.cls <-> Visit foro.elhacker.net <<<
================================================================================

Pd: Me alegra ver que usais mi clase :-*

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: BlackZeroX en 14 Febrero 2011, 09:33 am

Pd: Me alegra ver que usais mi clase :-*


mmm, no habia casi ninguna publicacion en el hilo q no lo mensionaras...


Quien sea más rápido, gana. ;)
Se testeará con cFrogContest.cls :P



@ignorantev1.1
http://foro.elhacker.net/programacion_visual_basic/src_cfrogcontestcls_by_mr_frog_copy-t318871.0.html



@Seba123neo
Jajajaj hice la clase precisamente para ahorrarte el trabajo! :xD


P.D.: mi funcion no figuro en la prueba... jaja las limitaciones de una clase que hacen discriminar a otras, pero bueno ni que.

Dulces Lunas!¡.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: BlackZeroX en 14 Febrero 2011, 10:38 am
.
Le hice una pequeña modificación a mi función GetPathInfo para que los parametros sean usados con el operador Or.

No será la más rápida pero si la más dinamica  :rolleyes:.

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Código siempre y cuando         //
  9. ' // no se eliminen los créditos originales de este código      //
  10. ' // No importando que sea modificado/editado o engrandecido    //
  11. ' // o achicado, si es en base a este código                    //
  12. ' ////////////////////////////////////////////////////////////////
  13. ' // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8
  14. ' ////////////////////////////////////////////////////////////////
  15.  
  16. Option Explicit
  17. Enum GetFileStr
  18.    Extensión = 1
  19.    FileName = 2
  20.    Ruta = 4
  21. End Enum
  22. Public Function GetPatchInfo(ByVal StrRutaFull As String, Optional ByVal Options As GetFileStr = FileName) As String
  23. Dim lng_ptr(1)              As Long
  24. Dim lng_aux                 As Long
  25.    lng_aux = Len(StrRutaFull)
  26.    lng_ptr(0) = InStrRev(StrRutaFull, "\")
  27.    If lng_ptr(0) > 0 Then
  28.        lng_ptr(1) = InStrRev(StrRutaFull, ".")
  29.        If lng_ptr(1) > 0 And Not lng_ptr(0) < lng_ptr(1) Then
  30.            lng_ptr(1) = lng_aux + 1
  31.        End If
  32.        If (Options And Ruta) = Ruta Then
  33.            GetPatchInfo = Mid$(StrRutaFull, 1, lng_ptr(0)) & GetPatchInfo
  34.        End If
  35.        If (Options And FileName) = FileName Then
  36.            If lng_ptr(1) = lng_aux Then
  37.                lng_aux = lng_aux - lng_ptr(0) - 1
  38.            Else
  39.                lng_aux = lng_ptr(1) - lng_ptr(0) - 1
  40.            End If
  41.            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(0) + 1, lng_aux)
  42.        End If
  43.        If (Options And Extensión) = Extensión Then
  44.            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(1), lng_ptr(1))
  45.        End If
  46.    End If
  47. End Function
  48.  
  49.  

Temibles Lunas!¡.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 13:34 pm
@Black
Siento no haber puesto tu función, no me fije al no poner el codigo directo en el hilo... :rolleyes:
El inconveniente de mi clase es que todas las funciones deben tener los mismos argumentos. :-(
Únicamente añadí la mia al test de Elemental Code. :silbar:
Igual se me ocurre una version aún más rápida de hacerlo :D

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Elemental Code en 14 Febrero 2011, 17:50 pm
a pesar de que el hombre rana algo raro hizo porque dio mas rapido mi segunda funcion que la primera

el pibe gano.
Código:
================================================================================
º Contest Name : ObtenerNombreArchivo
º Explanation  : Mas claro, hechale agua
º Arguments    : C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi
º Loops        : 1000
º Date & Hour  : 02-14-2011 <-> 13:47:25
================================================================================
Results [compiled] :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- MrFrogGetFileFast                                   -> 23,140550 msec
2.- SacarFilenameE_C                                    -> 25,971375 msec
3.- SacarFilenameE_Cv2                                  -> 29,063666 msec
4.- getFileNameIgnorante                                -> 31,133647 msec
5.- SacarFilenameE_CB                                   -> 33,288770 msec
6.- getFileNameIgnoranteMODSeba                         -> 37,030797 msec
7.- GetFilename123                                      -> 37,921469 msec
8.- nombre_archivoGrester                               -> 48,419315 msec
9.- Fn7913                                              -> 257,055627 msec
================================================================================
º The following functions returns incorrect results :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- StripPathSeba
================================================================================
>>> Test made by cFrogContest.cls <-> Visit foro.elhacker.net <<<
================================================================================

Se me hace medio imposible que la segunda funcion que hice funcione mas rapido que la primera ya que instrReverse es casi el doble de lento que el instr comun :S


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 19:36 pm
@Elemental Code:
No hice nada raro, compilé, ejecute y eso salió. El resultado puede tener pequeñas variaciones. Lo puedes ver tambien en el test de Black.
Repetí el test y me sale mas rápida tu segunda.

Debes tener en cuenta que a mayor número de funciones utilizadas, generalmente emplearás más tiempo.

2ª función :
Código
  1. Right$(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare))
Funciones utilizadas:
1 Right()
2 Len()
1 InstrRev()

Total : 4

1ª función :
Código
  1. StrReverse$(Left$(StrReverse$(sPath), InStr(1, StrReverse(sPath), "\", vbBinaryCompare) - 1))
Funciones utilizadas:
3 StrReverse()
1 Left()
1 Instr()

Total : 5

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Karcrack en 14 Febrero 2011, 21:03 pm
En una clase, GetFile05:
Código:
' By Chris Lucas, cdl1051@earthlink.net, 20011204
' Thanks to Olaf for the class implementation concept

Option Explicit

Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)

Private SafeArrayHeader(5) As Long
Private SafeArray() As Long

Private Sub Class_Initialize()
    SafeArrayHeader(0) = 1                ' Number of dimensions
    SafeArrayHeader(1) = 4                ' Bytes per element (long = 4)
    SafeArrayHeader(4) = &H7FFFFFFF       ' Array size

    ' Force SafeArray to use SafeArrayHeader as its own header
    RtlMoveMemory ByVal ArrPtr(SafeArray), VarPtr(SafeArrayHeader(0)), 4
End Sub

Friend Function GetExtension06(sText As String) As String
    Dim i&, SLen&, tmp1&, tmp2&

    SafeArrayHeader(3) = StrPtr(sText)
    SLen = LenB(sText) \ 2

    If (SLen And 1) Then
        If (SafeArray(SLen \ 2) And &HFFFF&) = &H2E& Then Exit Function
    End If

    For i = SLen \ 2 - 1 To 0 Step -1
        tmp1 = SafeArray(i)
        tmp2 = (tmp1 And &HFFFF0000)
        If tmp2 = &H2E0000 Then GoTo HiWord
        If tmp2 = &H5C0000 Then Exit Function
        tmp2 = (tmp1 And &HFFFF&)
        If tmp2 = &H2E& Then GoTo LoWord
        If tmp2 = &H5C& Then Exit Function
    Next i

    Exit Function

HiWord:
    GetExtension06 = RightB$(sText, SLen + SLen - i - i - i - i - 4)
    Exit Function
LoWord:
    GetExtension06 = RightB$(sText, SLen + SLen - i - i - i - i - 2)

End Function

Friend Function GetFile05(sText As String) As String
    Dim i&, SLen&, tmp1&

    SafeArrayHeader(3) = StrPtr(sText):
    SLen = LenB(sText) \ 2

    If (SLen And 1&) Then
        If (SafeArray(SLen \ 2) And &HFFFF&) = &H5C& Then Exit Function
    End If

    For i = SLen \ 2 - 1 To 0 Step -1
        tmp1 = SafeArray(i)
        If (tmp1 And &HFFFF0000) = &H5C0000 Then GoTo HiWord
        If (tmp1 And &HFFFF&) = &H5C& Then GoTo LoWord
    Next i

HiWord:
    GetFile05 = RightB$(sText, SLen + SLen - i - i - i - i - 4)
    Exit Function
LoWord:
    GetFile05 = RightB$(sText, SLen + SLen - i - i - i - i - 2)

End Function

Friend Function GetPath05(sText As String) As String
    Dim i&, SLen&, tmp1&

    SafeArrayHeader(3) = StrPtr(sText):
    SLen = LenB(sText) \ 2

    If (SLen And 1) Then
        If (SafeArray(SLen \ 2) And &HFFFF&) = &H5C& Then
            GetPath05 = sText
            Exit Function
        End If
    End If

    For i = SLen \ 2 - 1 To 0 Step -1
        tmp1 = SafeArray(i)
        If (tmp1 And &HFFFF0000) = &H5C0000 Then GoTo HiWord
        If (tmp1 And &HFFFF&) = &H5C& Then GoTo LoWord
    Next i

    GetPath05 = sText
    Exit Function
HiWord:
    GetPath05 = LeftB$(sText, i + i + i + i + 4)
    Exit Function
LoWord:
    GetPath05 = LeftB$(sText, i + i + i + i + 2)

End Function

Private Sub Class_Terminate()
    ' Make SafeArray once again use its own header
    ' If this code doesn't run the IDE will crash
    RtlMoveMemory ByVal ArrPtr(SafeArray), 0&, 4
End Sub
Código:
http://xbeat.net/vbspeed/c_GetFile.htm
Ante cualquier duda, NO es mio! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 21:25 pm
Lo pongo así:
Código
  1. Private c As New Class1
  2.  
  3. Public Function GetFilevbspeed(ByRef s As String) As String
  4.    GetFilevbspeed = c.GetFile05(s)
  5. End Function

Y estos son los resultados:
Código:
================================================================================
º Contest Name : ObtenerNombreArchivo
º Explanation  : Mas claro, hechale agua
º Arguments    : C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi
º Loops        : 10000
º Date & Hour  : 02-14-2011 <-> 21:23:28
================================================================================
Results [compiled] :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- MrFrogGetFileFast                                   -> 67,317405 msec
2.- SacarFilenameE_Cv2                                  -> 69,679881 msec
3.- SacarFilenameE_C                                    -> 76,798269 msec
4.- getFileNameIgnorante                                -> 78,093355 msec
5.- getFileNameIgnoranteMODSeba                         -> 85,564123 msec
6.- GetFilename123                                      -> 95,046462 msec
7.- GetFilevbspeed                                      -> 102,299685 msec
8.- Reto_GetPatchInfo                                   -> 117,060663 msec
9.- nombre_archivoGrester                               -> 129,081305 msec
10.- Fn7913                               -> 1818,863233 msec
================================================================================
º The following functions returns incorrect results :
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1.- StripPathSeba
================================================================================
>>> Test made by cFrogContest.cls <-> Visit foro.elhacker.net <<<
================================================================================
¿No debería ser más rápida? :huh:

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Karcrack en 14 Febrero 2011, 21:32 pm
Tal vez deberias hacerlo asi:
Código:
Private c As Class1
 
sub Main()
set c = new Class1
end sub

Public Function GetFilevbspeed(ByRef s As String) As String
    GetFilevbspeed = c.GetFile05(s)
End Function

De la otra forma creo que se llama al Class_Initialize cada vez :huh:


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 21:35 pm
@Karcrack
Mismos resutlados...  :silbar:

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Karcrack en 14 Febrero 2011, 21:48 pm
Mi no saber... en SpeedVb la muestra como la mas rapida con diferencia... asi que algo haces mal :¬¬ :xD


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 21:54 pm
Caca!, si testeo con CTiming me gana... mi clase esta mal (?)
Quizas hacer una funcion que llame a la clase perdia tiempo asi??

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Karcrack en 14 Febrero 2011, 22:02 pm
Uiiiis... va a ser que tu clase ralentiza el código... tal vez al llamar a una clase tu sistema no sea optimo...


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 14 Febrero 2011, 22:05 pm
Ya, pero bueno, con funciones, los resultados son más o menos coherentes... :rolleyes:
Será cosa del CallByNameEx() ! :-( :-( :-( :-(

DoEvents! :P


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Karcrack en 14 Febrero 2011, 22:12 pm
Supongo que si, has de tener en cuenta que las clases tienen una estructura bastante compleja que el CallByNameEx ha de recorrer cada vez... tal vez podrías hacer algo para restar el tiempo que le cuesta al CBNEx encontrar la funcion...


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: BlackZeroX en 15 Febrero 2011, 04:06 am
Supongo que si, has de tener en cuenta que las clases tienen una estructura bastante compleja que el CallByNameEx ha de recorrer cada vez... tal vez podrías hacer algo para restar el tiempo que le cuesta al CBNEx encontrar la funcion...

GetProcAdress()... y las demás APIS que no recuerdo xP.

Dulces Lunas!¡.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: BlackZeroX en 15 Febrero 2011, 04:08 am
.
Hago la ultima ediciona  mi codigo, ayq ue cuando quite el While Wend no quite algunas cosas.

Código
  1.  
  2. '
  3. ' ////////////////////////////////////////////////////////////////
  4. ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
  5. ' //                                                            //
  6. ' // Web: http://InfrAngeluX.Sytes.Net/                         //
  7. ' //                                                            //
  8. ' // |-> Pueden Distribuir Este Código siempre y cuando         //
  9. ' // no se eliminen los créditos originales de este código      //
  10. ' // No importando que sea modificado/editado o engrandecido    //
  11. ' // o achicado, si es en base a este código                    //
  12. ' ////////////////////////////////////////////////////////////////
  13. ' // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8
  14. ' ////////////////////////////////////////////////////////////////
  15.  
  16. Option Explicit
  17. Enum GetFileStr
  18.    Extensión = 1
  19.    FileName = 2
  20.    Ruta = 4
  21. End Enum
  22. Public Function GetPatchInfo(ByVal StrRutaFull As String, Optional ByVal Options As GetFileStr = FileName) As String
  23. Dim lng_ptr(1)              As Long
  24. Dim lng_aux                 As Long
  25.    lng_aux = Len(StrRutaFull)
  26.    lng_ptr(0) = InStrRev(StrRutaFull, "\")
  27.    If lng_ptr(0) > 0 Then
  28.        lng_ptr(1) = InStrRev(StrRutaFull, ".")
  29.        If lng_ptr(1) > 0 And Not lng_ptr(0) < lng_ptr(1) Then
  30.            lng_ptr(1) = lng_aux + 1
  31.        End If
  32.        If (Options And Ruta) = Ruta Then
  33.            GetPatchInfo = Mid$(StrRutaFull, 1, lng_ptr(0)) & GetPatchInfo
  34.        End If
  35.        If (Options And FileName) = FileName Then
  36.            If lng_ptr(1) = lng_aux Then
  37.                lng_aux = lng_aux - lng_ptr(0) - 1
  38.            Else
  39.                lng_aux = lng_ptr(1) - lng_ptr(0) - 1
  40.            End If
  41.            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(0) + 1, lng_aux)
  42.        End If
  43.        If (Options And Extensión) = Extensión Then
  44.            GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(1), lng_ptr(1))
  45.        End If
  46.    End If
  47. End Function
  48.  
  49. Public Function Reto_GetPatchInfo$(ByRef StrPath$)
  50.    ' // Esta funcion la agrego para el reto en cuestion...
  51.    Reto_GetPatchInfo = GetPatchInfo(StrPath$, FileName Or Extensión)
  52. End Function
  53.  
  54.  

Temibles Lunas!¡.


Título: Re: [RETO] Obtener nombre de archivo
Publicado por: Psyke1 en 15 Febrero 2011, 16:08 pm
GetProcAdress()... y las demás APIS que no recuerdo xP.

Dulces Lunas!¡.
Pero eso que dices no es para llamar funciones de una dll? :huh:
La verdad que no veo la manera de sacar el tiempo que tarda en llamar la funcion CBNX... :-(

DoEvents! :P