Alguien lo puede hacer mas rapido?

[LeandroA]

Buenas esto no es un reto, solo me intriga saber si se pude crear/mejorar una funcion mas rapida que esta que hice para buscar una palabra en un archivo, la funcion trabaja con bytes y no con string, como ejemplo puse que busque una palabra existente dentro del "Explorer.exe" y un bucle de 100 vueltas para exijirle un poco a la función. Tambien comente una palabra inexistente para probar.
no discrimina por mayusculas o minusculas "deve encontrarla de cualquier forma".

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Declare Function CharUpperBuffA& Lib "user32" (lpsz As Any, ByVal cchLength&)
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, ByRef lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

Private Type LARGE_INTEGER
   lowpart As Long
   highpart As Long
End Type


Private Const GENERIC_READ          As Long = &H80000000
Private Const FILE_SHARE_READ       As Long = &H1
Private Const OPEN_EXISTING         As Long = 3
Private Const INVALID_HANDLE_VALUE  As Long = -1
Private Const FILE_BEGIN            As Long = 0

Private aUChars(255) As Byte

Private Function LargeIntToCurrency(Low As Long, High As Long) As Currency
   Dim LI As LARGE_INTEGER
   LI.lowpart = Low: LI.highpart = High
   CopyMemory LargeIntToCurrency, LI, LenB(LI)
   LargeIntToCurrency = LargeIntToCurrency * 10000
End Function

Private Function CurrencyToLargeInt(ByVal Curr As Currency) As LARGE_INTEGER
   Curr = Curr / 10000
   CopyMemory CurrencyToLargeInt, Curr, LenB(Curr)
End Function


Private Function FindWordInFile(ByVal sPath As String, ByVal sWord As String, Optional ByVal bUnicode As Boolean) As Boolean
   Dim bArray() As Byte
   Dim lRet As Long
   Dim hFile As Long
   Dim sFind() As Byte
   Dim s As String
   Dim t As Long
   Dim i As Long
   Dim FileSize As Currency
   Dim tLI As LARGE_INTEGER
   Dim LenBuffer As Long
   Dim CurPos As Currency

   sWord = UCase(sWord)
   If bUnicode Then sWord = StrConv(sWord, vbUnicode)
   sFind = StrConv(sWord, vbFromUnicode)

   hFile = CreateFile(sPath, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
   
   If hFile <> INVALID_HANDLE_VALUE Then
   
       
       tLI.lowpart = GetFileSize(hFile, tLI.highpart)
   
       LenBuffer = &H2800 ' 10 KB
   
       FileSize = LargeIntToCurrency(tLI.lowpart, tLI.highpart)
       
       If FileSize < UBound(sFind) Then GoTo OutSearch
   
       If LenBuffer > FileSize Then LenBuffer = FileSize
   
       ReDim bArray(LenBuffer - 1)

       Do
           ReadFile hFile, bArray(0), UBound(bArray) + 1, lRet, 0&
           
           If lRet = 0 Then Exit Do
           
           CurPos = CurPos + lRet

           If lRet < LenBuffer Then
               ReDim Preserve bArray(lRet)
           End If

           If InBytes(bArray, sFind) <> -1 Then
               FindWordInFile = True
               Exit Do
           End If
           
           If CurPos = FileSize Then Exit Do
           
           tLI = CurrencyToLargeInt(CurPos - UBound(sFind) + 1)
           
           SetFilePointer hFile, tLI.lowpart, tLI.highpart, FILE_BEGIN
                       
       Loop
       
OutSearch:
       
       CloseHandle hFile

   End If
End Function



Public Function InBytes(ByRef bvSource() As Byte, ByRef bvMatch() As Byte) As Long

   Dim i       As Long
   Dim j       As Long
   Dim lChr    As Byte
   Dim LenMach As Long

   LenMach = UBound(bvMatch)
   
   lChr = bvMatch(0)
   
   If LenMach > 0 Then
   
       For i = 0 To UBound(bvSource) - LenMach
     
           If (lChr = aUChars(bvSource(i))) Then

               j = LenMach - 1
   
               Do
                   If bvMatch(j) <> aUChars(bvSource(i + j)) Then GoTo NotEqual
                   j = j - 1
               Loop While j
               
               InBytes = i
               
               Exit Function
   
           End If
NotEqual:
       
       Next
   
   Else
       For i = 0 To UBound(bvSource)
           If (lChr = aUChars(bvSource(i))) Then
               InBytes = i
               Exit Function
           End If
       Next
   End If

   InBytes = -1
End Function

Private Sub Form_Initialize()
   Dim i As Long

   For i = 0 To 255: aUChars(i) = i: Next
   CharUpperBuffA aUChars(0), 256

End Sub

Private Sub Form_Load()
   Dim t As Long, i As Long, Ret As Boolean
   t = GetTickCount
   For i = 0 To 100 'Este bucle es solo para exijirle un poco mas a la funcion
       Ret = FindWordInFile(Environ("windir") & "\explorer.exe", "Mostrar en el escritorio", True)
       'Ret = FindWordInFile(Environ("windir") & "\explorer.exe", "esta palabra no existe")
   Next
   
   MsgBox GetTickCount - t
   Me.Caption = Ret
   
End Sub


PD: Complilarlo

[BlackZeroX]

la funcion devuelve el puntero al string del archivo donde se desea buscar!¡.

Se puede ingresar un puntero de inicio
devuelve -1 si no encontro nada

Código (vb) [Seleccionar] Expandir



Option Explicit

Public Function FindInStr(ByVal InThisFile As String, ByVal InStrToFind As String, Optional ByVal PointFile As Long = 0, Optional ByVal bUnicode As Boolean = False) As Long
    Dim lFF             As Integer
    Dim lLenFile        As Long
    Dim vAFile()        As Byte, lindex     As Long, ByteAlt        As Byte
    Dim vAStr()         As Byte
    Dim lLenStr         As Long, LIndexStr  As Long

    FindInStr = -1
    lLenStr = Len(InStrToFind)
   
    If Not Dir(InThisFile, vbArchive) = "" And lLenStr > 0 Then
        lFF = FreeFile
        Open InThisFile For Binary As lFF
            lLenFile = LOF(lFF)
            If lLenFile Then
                If bUnicode Then
                    InStrToFind = StrConv(InStrToFind, vbUnicode)
                End If
                vAStr = StrConv(InStrToFind, vbFromUnicode)
               
                ReDim vAFile(0 To lLenFile)
                If PointFile > 0 Then
                    If Not (lLenFile - lLenStr >= PointFile) Then GoTo Err_
                    Get lFF, PointFile, vAFile
                Else
                    Get lFF, , vAFile
                End If

                For lindex = 0 To lLenFile - lLenStr - 2
                    For LIndexStr = 0 To lLenStr - 1
                        If Not vAFile(lindex + LIndexStr) = vAStr(LIndexStr) Then
                            If vAFile(lindex + LIndexStr) < 91 Then
                                ByteAlt = vAFile(lindex + LIndexStr) + 32
                            ElseIf vAFile(lindex + LIndexStr) < 123 Then
                                ByteAlt = vAFile(lindex + LIndexStr) - 32
                            End If
                            If Not ByteAlt = vAStr(LIndexStr) Then Exit For
                        End If
                    Next LIndexStr
                    If LIndexStr >= lLenStr - 1 Then
                        FindInStr = lindex + PointFile
                        If PointFile Then FindInStr = FindInStr - 1
                        Exit Function
                    End If
                Next lindex
            End If
Err_:   Close lFF
    End If

End Function

Private Sub Form_Load()
    MsgBox FindInStr(Environ("windir") & "\explorer.exe", "Mostrar en el escritorio", , False)
End Sub



Dulce Infierno Lunar!¡.

[LeandroA]

Gracias BlackZeroX por coloaborar, esta bien reducido pero es mucho mas lenta y si pasamos archivos grandes daria error (esto ultimo no importa mucho se puede solucionar)

un bucle de 101 lamadas testeado con GetTickCount

BlackZeroX  2437
LeandroA     782

Saludos.

[Psyke1]

Quizas sea una chorrada, pero y si usamos RegExp?

DoEvents¡!

[raul338]

Quizas sea una chorrada, pero y si usamos RegExp?

Puede que sea una forma mejor de hacerlo, pero... tienes que optimizarlo bien para que no consuma tiempo (ya que tiene varias validaciones) y... comparando con bytes, si esta optimizado no creo que le pueda ganar

[BlackZeroX]

@LeandroA

Esperame ando trabajando en otra version, esta digamos que como todo seria algo asi como un esboso!¡.

@*PsYkE1*, raul338

Da igual como lo hagas el chiste de esto es que sea lo mas RAPIDO posible!¡.

Dulces Lunas!¡.

[Karcrack]

Código [Seleccionar] Expandir

http://www.xbeat.net/vbspeed/cod_InStrMarzo.htm
La funcion InStr01 debe ser la mas rapida en caso de que uses vbTextCompare, si no quieres trabajar con cadenas podras alterarla para que funcione con ByteArrays

El truco de esta funcion esta en sus Arrays trucados

[LeandroA]

Código [Seleccionar] Expandir

http://www.xbeat.net/vbspeed/cod_InStrMarzo.htm
La funcion InStr01 debe ser la mas rapida en caso de que uses vbTextCompare, si no quieres trabajar con cadenas podras alterarla para que funcione con ByteArrays

El truco de esta funcion esta en sus Arrays trucados

si he visto el enlace inclusive saque algunos tips, trabaja practicamente igual solo que este pasa una cadena como puntero y lo pasa a un array (no entendi bien eso) pero en fin da lo mismo porque yo estoy trabajando directamente con byte array.
bueno creo que es lo maximo que se pude llegar con vb, no estoy seguro ejcutandolo con ASM o declarando las apis en .tlv

Saludos.

[raul338]

Ya esta leandro, pedile a Tokes a ver si con su magia hace algo para optimizar

Yo lo logre con Expresiones regulares, pero, tarda un poco mas (usando FSO) y la pega es que no acepta UTF-8 directo (o sea, hay q convertir feamente u.u)

[Psyke1]

Ya esta leandro, pedile a Tokes a ver si con su magia hace algo para optimizar

Yo lo logre con Expresiones regulares, pero, tarda un poco mas (usando FSO) y la pega es que no acepta UTF-8 directo (o sea, hay q convertir feamente u.u)

Vaya raul...
Nos quedamos sin RegExp... 

DoEvents¡!