| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Поиск по файлу [D7, WinXP]
lmz © (2005-05-23 20:17:00)Алгоритм поиска по файлу: например, есть какой то файл, в нём написан какой-то текст, необходимо найти некоторые слова и вывести результаты поиска?
Defunct (2005-05-24 14:20:00) [21]Прощу прощения.. В оригинале было так:
finally
CloseFile(F)
end;
if BufPos < 0 Then Result := -1;
finally
Dispose(Buffer)
end
end;
Defunct (2005-05-24 14:07:00) [22]lmz © (24.05.05 11:23) [18]
Функции специально адаптированные под поиск в файле:
(C) Def and GuAV
У кого осталась та ветка, это приведены функции [74] и [87]. (не самые быстрые, зато рабочие).
function ConstantPos(const Constant: string;
Buffer: Pointer; BufSize: Integer): Integer; Assembler;
asm
Push EDi
Push ESi
Push EBx
Push EBp
Push ECx // store total buffer size for later calculation pos
MOV ESI, EAX // ESi pointer to constant
Mov EDi, EDx // EDi pointer to buffer
Mov EBX, [ESI-4]
Dec EBX
Mov Ah, [ESi+EBx] // Store last char of the constant in AH
Dec EBx // EBx - length of the constant w/o 1st and last chars
Mov Al, [ESi] // Store first char of the constant in AL
Mov EDx,ECx // EDx - Stored residual buffer size
Inc ESi
Mov EBp, ESi // EBp - stored pointer to 2nd char of constant
@@Scan:
Repne ScasB
JNE @@Exit_False // no 1st char of the constant found = exit_false
Mov EDx, ECx // store new residual buffer size
Cmp EDx, EBx // constant still can be settled in buffer
Ja @@CheckLastChar // no - exit with false result
@@Exit_False:
Pop EAx
Xor EAx,EAx // False = (0), check delphi help for more info
Dec EAx
Jmp @@Leave_Proc
@@CheckLastChar: // as proposed in Boyer-Mur alhorithm
Cmp Ah, [EDi+EBx] // check found substring with last char of the constant
Jnz @@Scan // not match - continue searching
@@CompareWholeString:
Mov ECx, Ebx // ECx - constant chars amount
Repe CmpsB
Jz @@Constant_Exists
Mov ESi, EBp // restore pointer to 2nd char of constant
Add EDx, ECx
Sub EDx, EBx // correct residual buffer size
Mov ECx, EDx // restore residual buffer size to ECx
Jnz @@Scan
@@Constant_Exists:
Pop EAx
Sub EAx, EDx
@@Leave_Proc:
Pop EBp
Pop EBx
Pop ESi
Pop EDi
end;
function ConstantExists(FileName, Constant: String): Int64;
const
MaxBufferSize = 1024*1024;
type
TBuffer = array[0..MaxBufferSize-1] of byte;
PBuffer = ^TBuffer;
var
Buffer : PBuffer;
F : File;
BufSize : Integer;
BufPos : Integer;
begin
BufPos := -1;
New(Buffer);
try
AssignFile(F, FileName);
Reset(F,1);
try
repeat
Result := FilePos(F);
BlockRead(F, Buffer^, MaxBufferSize, BufSize);
If BufSize >= Length(Constant) Then
BufPos := ConstantPos(Constant, Buffer, BufSize);
Result := Result + BufPos;
Seek(F, FilePos(F) - Length(Constant));
until (BufPos>0) or (BufSize<MaxBufferSize);
finally
CloseFile(F)
end
finally
Dispose(Buffer);
end
end;
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var APos : Int64;
begin
APos := ConstantExists('E:\Films\SMovie.avi', 'JUNKV');
if APos <> -1 then
ShowMessage('JUNKV at '+IntToStr(APos) );
end;
Sha (2005-05-24 11:46:00) [23]> lmz © (24.05.05 11:23) [18]
> А можно полный работающий код
Зачем код, можно сразу результат получить. (с) Google.
Alx2 (2005-05-24 11:35:00) [24]>Игорь Шевченко © (24.05.05 11:29) [19]
Стоит перечислить все? :)
Игорь Шевченко (2005-05-24 11:29:00) [25]GuAV © (24.05.05 00:39) [16]
> Также имеет смысл попробовать применить MMF, однако в этом
> прийдётся адаптировать ф-цию Pos под использования указателя
> на буфер и длины вместо строки.
А кроме Pos науке поиска никакие методы, натурально, не известны.
lmz (2005-05-24 11:23:00) [26]А можно полный работающий код
Alx2 (2005-05-24 00:47:00) [27]
procedure LoadFromFile(const FileName: string);
procedure DoError;
begin
raise
Exception.Create('TStorage.LoadFromFile(''' + FileName + '''): ' + SysErrorMessage(GetLastError));
end;
var
cfmHandle, hFile: THandle;
DataAddress: Pointer;
fSize: DWord;
begin
hFile := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile = invalid_handle_value then
DoError
else
try
fSize := GetFileSize(hFile, nil);
if fSize = $FFFFFFFF then
DoError else
begin
cfmHandle := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, fSize, '');
if cfmHandle = 0 then
DoError
else
try
DataAddress := MapViewOfFile(cfmHandle, FILE_MAP_READ, 0, 0, 0);
if DataAddress = nil then
DoError
else
try
Здесь работаем с файлом, как с массивом.
Адрес массива в DataAddress.
"однако в этом прийдётся адаптировать ф-цию Pos под использования указателя на буфер и длины вместо строки." (с) GuAV © (24.05.05 00:39)
{
Как пример: содержимое файла запихнем в строку (зачем? - не знаю. Просто пример:)
SetLength(Str, fSize);
Move(DataAddress^, Str[1], fSize);
}
finally
UnmapViewOfFile(DataAddress);
end;
finally
CloseHandle(cfmHandle);
end;
end;
finally
CloseHandle(hFile);
end;
end;
PS
Только для файлов размером <2Gb
GuAV (2005-05-24 00:39:00) [28]Код писал в основном Defunct (по крайней мере он был последним, я после переходе на mmx сдался :) ). Поскольку тот код содержал ошибку (выход из диапазона при чтении, маловероятно, но потенциально AV), не предсатвляет большой ценности.
Вот тут код, который так и не удалось обогнать:
http://dennishomepage.gugs-cats.dk/PosChallenge.htm- скачайте Validation and Benchmark Tool и сами выберите функцию-альтернативу Pos.
ещё советы:
Читайте файл сразу в строку, используя выделение памяти через SetLength.
Читайте не очень мелкими (чтобы уменьшить количество операций) но и не очень большими (чтобы избежать своппинга) блоками.
Также имеет смысл попробовать применить MMF, однако в этом прийдётся адаптировать ф-цию Pos под использования указателя на буфер и длины вместо строки.
lmz (2005-05-23 23:13:00) [29]Так может у кого-то есть код... поделитесь...
Yanis (2005-05-23 22:04:00) [30]
GuAV & Defunct писали вдвоем.
Точно. Вроде они вдвоём =) Тут главное никого не забыть, а то код 2м писали, а его присвоили одному.
Sha (2005-05-23 22:02:00) [31]GuAV & Defunct писали вдвоем.
Когда уставал один, эстафету подхватывал другой...
Так и не дописали :)
lmz (2005-05-23 21:27:00) [32]Попробую спросить...
Yanis (2005-05-23 21:21:00) [33]
> поиск по анкетам слабо?
> guav(сабака)mail.ru
Опередила =)
Yanis (2005-05-23 21:21:00) [34]http://www.delphimaster.ru/cgi-bin/anketa.pl?id=1087039622
злобная танька (2005-05-23 21:20:00) [35]поиск по анкетам слабо?
guav(сабака)mail.ru
lmz (2005-05-23 21:15:00) [36]Может кто помнит как тема называлась. Как написать письмо этому GuAV?
злобная танька (2005-05-23 20:43:00) [37]одного из авторов GuAV звали
напишите ему письмо :D
Yanis (2005-05-23 20:41:00) [38]
здесь такая тема уже поднималась.. полазийте в архивах форума!
там развели эту тему на 170 страниц, и в итоге написали функцию, как раз как вам нада. Очень быструю.
Да уж. Помню, помню =) Разве её теперь найдешь! Это надо у авторов спросить.
злобная танька (2005-05-23 20:36:00) [39]здесь такая тема уже поднималась.. полазийте в архивах форума!
там развели эту тему на 170 страниц, и в итоге написали функцию, как раз как вам нада. Очень быструю.
DSKalugin (2005-05-23 20:27:00) [40]Поиск в TMemo с использованием TFindDialog
http://delphiworld.narod.ru/base/memo_search_dlg.html
| |
Страницы: 