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".
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
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
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!¡.
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.
Quizas sea una chorrada, pero y si usamos RegExp?
DoEvents¡! :P
Cita de: *PsYkE1* en 19 Agosto 2010, 03:28 AM
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 :P
@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!¡.
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 :laugh:
Cita de: Karcrack en 19 Agosto 2010, 14:38 PM
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 :laugh:
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.
Ya esta leandro, pedile a Tokes a ver si con su magia hace algo para optimizar :P
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)
Cita de: raul338 en 19 Agosto 2010, 20:10 PM
Ya esta leandro, pedile a Tokes a ver si con su magia hace algo para optimizar :P
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... :laugh:
DoEvents¡! :P
Deberias poner las APIs en un TLB, te ahorrias algo de tiempo ;) Voy a ir viendo si puedo acelerarlo >:D
MOD: Se me ocurre hacer la comprobacion en vez de en bloques de 1 byte en Longs o incluso Currencies... El problema esta si el tamaño de lo que se esta buscando no es multiple... porque entonces habria que hacer la comprobacion por Bytes :-\...
MOD2:Voy a intentar hacer algo con ASM y SSE :P Nada, SSE tambien requiere que los datos esten alineados... a 16bytes...