Поиск фрагмента текста...

← →
Андрей С. (2006-09-24 13:57) [0]

Здравствуйте, уважаемые форумчане!
Хочу обратиться к вам за помощью вот по какому вопросу...

Задача состоит в том, чтобы программа, так сказать, автоматически редактировала все файлы с расширением .html в текущей папке. Только не просто редактировала, а искала заранее определённую пользователем строчку (фиксированный фрагмент текста длинной в одну строчку), после чего всё, что идёт до него, включая эту строчку, удаляла из файла. Затем ищется вторая строчка (которая также заранее указывается пользователем) и всё, что идёт ПОСЛЕ неё, включая её саму, удаляется.
Т.е. на примере что-то вроде того:

файл example.html:

111111111111
222222222222
na4alo-na4alo
aaaaaaa
bbbbbbb
ccccccc
konec-konec
333333333333
444444444444

и программа должна из всего этого файла оставить только:

aaaaaaa
bbbbbbb
ccccccc

Понимаете?
Я пробовал сделать это, используя RichEdit, но много мороки, очень долгая работа программы и вообще :) Честно говоря, я в Delphi ещё зелёный, поэтому и пришёл на этот форум за помощью.
Для вас это наверно очень простая задачка, поэтому, если не трудно, помогите пожалуйста кодом. Чтобы можно было нажать на кнопку и программа из той папки, в которой она находится, повырезает вышесказанным образом куски текста из html-файлом и сохранит их в простой .txt, но с именами тех html-файлов.
P.S. Количество html-файлов в папке с программой может быть неограничено.
Заранее спасибо!

← →
Zeqfreed © (2006-09-24 14:26) [1]

function TrimFiles(FileList : TStrings; StartPattern, EndPattern, OutputExt : ShortString) : Integer; var i, j, sIdx, eIdx : Integer; begin Result := 0; if not Assigned(FileList) then Exit; with TStringList.Create() do begin try for i := 0 to FileList.Count - 1 do begin LoadFromFile(FileList[i]); sIdx := IndexOf(StartPattern); eIdx := IndexOf(EndPattern); sIdx := Max(sIdx, 0); if (eIdx = -1) then eIdx := Count - 1; if (eIdx - sIdx > 0) then begin for j := 0 to sIdx do Delete(j); for j := eIdx to Count - 1 do Delete(j); SaveToFile(ChangeFileExt(FileList[i], OutputExt)); if (sIdx > 0) and (eIdx < Count - 1) then Result := Result + 1; end; end; finally Free; end; end; end;

Работоспособность пока не проверял.

← →
Zeqfreed © (2006-09-24 14:49) [2]

function TrimFiles(FileList : TStrings; StartPattern, EndPattern, OutputExt : ShortString) : Integer; var i, j, sIdx, eIdx : Integer; begin Result := 0; if not Assigned(FileList) then Exit; with TStringList.Create() do begin try for i := 0 to FileList.Count - 1 do begin LoadFromFile(FileList[i]); sIdx := IndexOf(StartPattern); eIdx := IndexOf(EndPattern); if (eIdx = -1) then eIdx := Count; if (eIdx - sIdx > 0) then begin if (sIdx > -1) and (eIdx < Count - 1) then Result := Result + 1; for j := eIdx to Count - 1 do Delete(eIdx); for j := 0 to sIdx do Delete(0); SaveToFile(ChangeFileExt(FileList[i], OutputExt)); end; end; finally Free; end; end; end;

Отладил :)
Таки сразу не сообразил о тонкостях удаления :)

← →
Андрей С. (2006-09-24 15:21) [3]

Пишу так:

procedure TForm1.Button1Click(Sender: TObject);
begin
TrimFiles(RichEdit1.Lines,"начальный фрагмент","конечный фрагмент",".txt");
end;

но в итоге в выходной файл попадает всё то же самое, что и было в обрабатываемым. Т.е. ничего не удаляется :(

← →
Ketmar © (2006-09-24 15:25) [4]

>[3] Андрей С. 24-Sep-2006, 15:21
немедленно в магазин. хозтоваров. за метлой.

← →
Furyz © (2006-09-24 15:29) [5]

> TrimFiles(RichEdit1.Lines,"начальный фрагмент","конечный
> фрагмент",".txt");

ты передаеш не тот параметр

← →
Zeqfreed © (2006-09-24 15:33) [6]

> [3] Андрей С. (24.09.06 15:21)

Содержимое файла в студию :)

← →
Андрей С. (2006-09-24 16:18) [7]

Вот, к примеру, такой html-файл:

<HTML>
<HEAD>
<TITLE>Какой-то там заголовок</TITLE>

<теги теги теги: "теги-теги-теги">
<теги те2ги теги: "теги-теги-теги">
<теги 1теги теги: "теги-теги-теги">
<теги теdги теги: "теги-теги-теги">
<теги тег1и теги: "теги-теги-теги">

<теги тег1и теги: "../../../теги-теги-теги.тег">
</HEAD>
<BODY>
<IMG src="../../../test/test.gif" width=120 height=140> START SAMPLE 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. Вот это надо оставить. <IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
<IMG src="../../../test/test.gif" width=120 height=140> 
 

<IMG src="../../../test/test.gif" width=120 height=140> END SAMPLE 
<теги теги теги: "теги-теги-теги">
<теги те2ги теги: "теги-теги-теги">
<теги 1теги теги: "теги-теги-теги">
<теги теdги теги: "теги-теги-теги">
<теги тег1и теги: "теги-теги-теги">

<теги тег1и теги: "../../../теги-теги-теги.тег">

</BODY>
</HTML>

Начальной строкой здесь считаю: START SAMPLE 
Конечной: END SAMPLE 

На выходе получается точно такой же файл. Один в один :(

← →
Андрей С. (2006-09-24 16:19) [8]

Там "START SAMPLE" и "END SAMPLE" с обоих сторон заключены в тег [b],[/b] ;)

← →
Zeqfreed © (2006-09-24 16:36) [9]

> [7] Андрей С. (24.09.06 16:18)

> Начальной строкой здесь считаю: START SAMPLE >
> Конечной: END SAMPLE 

К сожалению, все остальные, включая TStringList, считают это подстрокой.

← →
Андрей С. (2006-09-24 16:37) [10]

Т.е.? Значит, работать не будет? :*(

> [10] Андрей С. (24.09.06 16:37)

Значит нужно выбрать одно из решений:
а) Задавать в качестве шаблона строки действительно целую строку, а не её подстроку
б) Вынести подстроку на отдельную строку в файлах
в) Изменить логику выбора строки
г) …

Если честно, я бы работал с такими файлами несколько по-другому, а именно: загружал бы их в память посредством MapViewOfFile, затем совершал бы поиск шаблонных вхождений и копировал нужную часть в новый файл. Это, пожалуй, одно из наиболее производительных решений.

По идее такое должно работать. Только внешний цикл для перебирания файлов сам пиши...

procedure X(filename,StartPattern, EndPattern:string); var s:string; k:integer; begin with TFileStream.Create(filename, fmOpenReadWrite) do try SetLength(s,Size); ReadBuffer(Pointer(s)^, Size); k:=pos(StartPattern,s); if k>0 then delete(s,1,length(StartPattern)+k-1); k:=pos(EndPattern,s); if k>0 then SetLength(s,k-1); size:=0; Position:=0; WriteBuffer(pointer(s)^,length(s)); finally free; end; end;

procedure TrimFile(filename,StartPattern, EndPattern:string); var s:string; k:integer; begin with TFileStream.Create(filename, fmOpenReadWrite) do try SetLength(s,Size); ReadBuffer(Pointer(s)^, Size); k:=pos(StartPattern,s); if k>0 then delete(s,1,length(StartPattern)+k-1); k:=pos(EndPattern,s); if k>0 then SetLength(s,k-1); size:=0; Position:=0; WriteBuffer(pointer(s)^,length(s)); finally free; end; end; procedure TrimFilesOfDir(Dir,mask,StartPattern,EndPattern:string); var srec:TSearchRec; begin if FindFirst(Dir+mask, faAnyFile - faDirectory, SRec) = 0 then repeat TrimFile(Dir+SRec.name,StartPattern,EndPattern); until FindNext(SRec) <> 0; FindClose(SRec); end; procedure TForm1.Button1Click(Sender: TObject); begin TrimFilesOfDir("c:\mojapapka","*.html","na4alo-na4alo","konec-konec"); end;

Ошибся немного...

procedure TForm1.Button1Click(Sender: TObject);
begin
TrimFilesOfDir("c:\mojapapka\","*.html","na4alo-na4alo","konec-konec");
end;

← →
Андрей С. (2006-09-25 08:44) [15]

Пасибочки ;)

Поиск фрагмента текста... Найти похожие ветки