Поиск по файлу

← →
lmz © (2005-05-23 20:17) [0]

Алгоритм поиска по файлу: например, есть какой то файл, в нём написан какой-то текст, необходимо найти некоторые слова и вывести результаты поиска?

← →
злобная танька (2005-05-23 20:21) [1]

копируй файл в переменную и шерсти его функцией Pos!

← →
lmz © (2005-05-23 20:23) [2]

А если файл очень большой, тогда поиск может затянуться на несколько минут... может есть что оптимальное...

← →
Yanis © (2005-05-23 20:26) [3]

Особенно прикольно когда файл размером около 1GB =)

← →
DSKalugin © (2005-05-23 20:27) [4]

Поиск в TMemo с использованием TFindDialog
http://delphiworld.narod.ru/base/memo_search_dlg.html

← →
злобная танька (2005-05-23 20:36) [5]

здесь такая тема уже поднималась.. полазийте в архивах форума!
там развели эту тему на 170 страниц, и в итоге написали функцию, как раз как вам нада. Очень быструю.

← →
Yanis © (2005-05-23 20:41) [6]

здесь такая тема уже поднималась.. полазийте в архивах форума!
там развели эту тему на 170 страниц, и в итоге написали функцию, как раз как вам нада. Очень быструю.

Да уж. Помню, помню =) Разве её теперь найдешь! Это надо у авторов спросить.

← →
злобная танька (2005-05-23 20:43) [7]

одного из авторов GuAV звали
напишите ему письмо :D

← →
lmz © (2005-05-23 21:15) [8]

Может кто помнит как тема называлась. Как написать письмо этому GuAV?

← →
злобная танька (2005-05-23 21:20) [9]

поиск по анкетам слабо?
guav(сабака)mail.ru

← →
Yanis © (2005-05-23 21:21) [10]

http://www.delphimaster.ru/cgi-bin/anketa.pl?id=1087039622

← →
Yanis © (2005-05-23 21:21) [11]

> поиск по анкетам слабо?
> guav(сабака)mail.ru

Опередила =)

← →
lmz © (2005-05-23 21:27) [12]

Попробую спросить...

← →
Sha © (2005-05-23 22:02) [13]

GuAV & Defunct писали вдвоем.
Когда уставал один, эстафету подхватывал другой...
Так и не дописали :)

← →
Yanis © (2005-05-23 22:04) [14]

GuAV & Defunct писали вдвоем.

Точно. Вроде они вдвоём =) Тут главное никого не забыть, а то код 2м писали, а его присвоили одному.

← →
lmz © (2005-05-23 23:13) [15]

Так может у кого-то есть код... поделитесь...

← →
GuAV © (2005-05-24 00:39) [16]

Код писал в основном Defunct (по крайней мере он был последним, я после переходе на mmx сдался :) ). Поскольку тот код содержал ошибку (выход из диапазона при чтении, маловероятно, но потенциально AV), не предсатвляет большой ценности.

Вот тут код, который так и не удалось обогнать:

http://dennishomepage.gugs-cats.dk/PosChallenge.htm - скачайте Validation and Benchmark Tool и сами выберите функцию-альтернативу Pos.

ещё советы:

Читайте файл сразу в строку, используя выделение памяти через SetLength.

Читайте не очень мелкими (чтобы уменьшить количество операций) но и не очень большими (чтобы избежать своппинга) блоками.

Также имеет смысл попробовать применить MMF, однако в этом прийдётся адаптировать ф-цию Pos под использования указателя на буфер и длины вместо строки.

← →
Alx2 © (2005-05-24 00:47) [17]

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

← →
lmz © (2005-05-24 11:23) [18]

А можно полный работающий код

← →
Игорь Шевченко © (2005-05-24 11:29) [19]

GuAV © (24.05.05 00:39) [16]

> Также имеет смысл попробовать применить MMF, однако в этом
> прийдётся адаптировать ф-цию Pos под использования указателя
> на буфер и длины вместо строки.

А кроме Pos науке поиска никакие методы, натурально, не известны.

← →
Alx2 © (2005-05-24 11:35) [20]

>Игорь Шевченко © (24.05.05 11:29) [19]
Стоит перечислить все? :)

← →
Sha © (2005-05-24 11:46) [21]

> lmz © (24.05.05 11:23) [18]
> А можно полный работающий код

Зачем код, можно сразу результат получить. (с) Google.

← →
Defunct © (2005-05-24 14:07) [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;

← →
Defunct © (2005-05-24 14:20) [23]

Прощу прощения.. В оригинале было так:

finally CloseFile(F) end; if BufPos < 0 Then Result := -1; finally Dispose(Buffer) end end;

← →
lmz © (2005-05-24 14:52) [24]

Не то получается, наример есть какая-то база, возьмём телефоный справочник, в этом файле записаны фамилии, номера, адреса, мне надо, чтобы при вводе какой-то фамилии выводились все похожие?

← →
Viktop (2005-05-24 14:54) [25]

А здесь что не так?

← →
lmz © (2005-05-24 14:59) [26]

Во всяком случае, у меня получилось не так, тут число получается...

← →
Viktop (2005-05-24 15:05) [27]

Посмотреть бы на эти [74] и [87]

← →
Игорь Шевченко © (2005-05-24 15:14) [28]

> Не то получается

Надеюсь, ты уже исправил данный тебе (даром!) код, так, чтобы он работал в соответствии с твоими требованиями ?

← →
lmz © (2005-05-24 15:17) [29]

> уже исправил

Не исправил...

← →
lmz © (2005-05-24 15:22) [30]

> 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;

Как использовать эту функцию? Что передавать в параметры Buffer и BufSize?

← →
Viktop (2005-05-24 16:01) [31]

Как-то странно работаю эти функции :(. Сначала выдавала на 1 найденый элемент больше. Потом стала выдавать числа за 1000, хотя в файле 100 слов максимум. Далее: В файл поместил 5 одинаковых строк - число найденных = 1

Вот и я про тоже...

чужой код - он такой. никогда не работает, как надо.

> Не то получается, наример есть какая-то база, возьмём телефоный
> справочник, в этом файле записаны фамилии,
- имхо, ты хочешь движок БД написать ? Опять таки, имхо, проще тогда готвую СУБД использовать. В них есть поиск по индексу. А поиск перебором в файле 1Г по любому медленно работать будет.

← →
Viktop (2005-05-24 16:52) [36]

to nikkie
А ты попробуй скорми этим функция файл с парой строк и поэксперементируй. Я бы потправил, но знания asma=0,00001% (знаю что что-то там про регистры есть)

lmz © (24.05.05 15:22) [30]

Вам не нужно использовать непосредственно ASM функцию. Вам достаточно использовать как в примере, функцию ConstantExists, которая возвращает позицию искомой константы в файле.

← →
Viktop (2005-05-24 17:09) [38]

to Defunct
А глюки с поиском Вы не замечали (кол-во найденного)?

Viktop (24.05.05 17:09) [38]

> А глюки с поиском

Подробнее про глюки плз. т.к. не замечал глюков именнов в этих функциях.

> в файле 1Г

Почему 1Г, размер файла может быть от 2 метров до 50 метров...

← →
Viktop (2005-05-24 20:23) [41]

to Defunct
Пост 31

P.S.: Я, кажется простое решение нашёл:
function InStr(index: integer; str1: string; str2: string): integer; var i,len, pos: integer; begin pos:=0; len:=length(str2); for i:=index to length(str1) do begin if copy(str1,i,len)=str2 then begin pos:=i; break; // здесь можно писать свои условия end; end; result:=pos; end;

Параметры функции:
номер символа, с которго ищем, в какой строке ищем, что ищем

Viktop (24.05.05 20:23) [41]

Функция ищет не количество подстрок, а позицию подстроки в файле. При этом в отличие от Pos поиск не приостанавливается на служебных символах #0 и т.п. Изначально функция [22] была предназначена для поиска подстрок в бинарном файле.

← →
Viktop (2005-05-25 04:50) [43]

Ну ведь можно добавить:
For i:=index to length(str1) do begin if copy(str1,i,len)=str2 then begin pos:=i; Inc(numder) end;
А зачем поиск должен приостанавливаться?

Поиск по файлу Найти похожие ветки