500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу


Как работать с нетипизированным файлом (BlockRead и текстовый файл)?

Следующий код демонстрирует использование нетипизированного входного файла для блочного чтения (blockread) текстового файла, сканирование входного буфера в поисках любого символа и их замены на символы перевода строки и возврата каретки. Поскольку код использует входные и выходные буфера размером 16к, то получаемая скорость весьма приемлема.

Примечание: В процессе обработки, если длина строки выходного файла превышает 255 символов и вы хотите прочесть ее с помощью ReadLn, то просто используйте в запросе ReadLn несколько строк, например так:

ReadLn(infile,string1,string2);

Так можно прочесть вплоть до 510 символьных строк с 1-й по 255 символ в string1 и остальное в string2;

program fixfile;{ Компилируем из DOS-приглашения: DCC FIXFILE.PAS }
uses { запускаем из File Manager }
sysutils,dialogs,forms;

type
bufptr = obufr;
iobufr = array[0..16384] of char;

var
infile : file;
oufile : textfile;
inbufr,
oubufr : bufptr;

idx: integer;
bytesread: integer;
bytes2read: integer;

totalbytesread: longint;
actualfilesize: longint;

OpenDialog1: TOpenDialog;

infilename,
oufilename: string;


begin
infilename := '';
OpenDialog1 := TOpenDialog.Create(Application);

OpenDialog1.Options := [];
OpenDialog1.Filter := 'Все файлы|*.*';
OpenDialog1.FilterIndex := 1;
OpenDialog1.Title := 'Укажите исходный файл для преобразования';
if OpenDialog1.execute then
infilename := OpenDialog1.filename;

if infilename='' then
begin
OpenDialog1.free;
halt;
end;

OpenDialog1.Title := 'Укажите имя создаваемого целевого файла';
if OpenDialog1.execute then
oufilename := OpenDialog1.filename;

OpenDialog1.free;

if oufilename='' then
halt;

if infilename=oufilename then
halt;

new(inbufr);
new(oubufr);

assignfile(infile,infilename);
reset(infile,1);
actualfilesize := filesize(infile);

assignfile(oufile,oufilename);
system.settextbuf(oufile,oubufr^);
rewrite(oufile);

totalbytesread := 0;
bytesread := 0;
bytes2read := 0;

while (totalbytesread<actualfilesize)
and (bytes2read=bytesread) and (IOresult=0) do
begin
if (actualfilesize-totalbytesread)>sizeof(inbufr^) then
bytes2read := sizeof(inbufr^)
else
bytes2read := actualfilesize-totalbytesread;

blockread(infile,inbufr^,bytes2read,bytesread);

totalbytesread := totalbytesread + bytesread;
for idx := 0 to bytesread do
if inbufr^ [idx]='''' then { <= преобразуемый символ }
writeln(oufile)
else
write(oufile,inbufr^ [idx]);
end;

closefile(infile);
closefile(oufile);

dispose(inbufr);
dispose(oubufr);

end.

Как мне воспользоваться функцией readln(), если файл содержит строки с более чем 255 символами?

ReadLn акцептует массив символов array [0..something] of Char и использует его в качестве буфера для чтения символов, замыкая цепочку терминирующим нулем. Единственное ограничение: компилятор должен иметь возможность вычисления размера буфера во время компиляции, что делает невозможным объявление переменой типа PChar и ее распределение во время выполнения программы.

Обходной путь:

Type
{используем самое большое количество символов в строке, с которым вы можете иметь дело}
TLine = Array [0..1024] of Char;

PLine = ^TLine;

Var
pBuf: PLine;
...
New( pBuf );

...
ReadLn( F, pBuf^ );

Для передачи pBuf функциям, которым требуется параметр типа Pchar, используйте приведение типа подобно PChar( pBuf ).
Примечание: вы, конечно, можете использовать объявление переменной типа TLine или непосредственно массив символов, но я предпочитаю распределять из кучи нечто большее, чем 4 байта...

Как сделать блокировку доступа к откруытому файла другими программами?

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

type FileShareType = (DenyCompatibility,DenyAll,DenyWrite,DenyRead,DenyNone);

FileAccessType = (ReadOnly,WriteOnly,ReadWrite);

procedure SetFileAccess(AccessMode: FileAccessType;ShareMode: FileShareType);

{ Устанавливаем режим доступа к файлу для следующего вызова открытия файла }
begin
FileMode := ord(AccessMode) or (ord(ShareMode) shl 4)
end;

Вот и все.

Кто-нибудь знает быстрый способ поиска строки в текстовом файле?

unit BMSearch;

{Поиск строки методом Boyer-Moore.
Это - один из самых быстрых алгоритмов поиска строки.}

interface

type
{$ifdef WINDOWS}

size_t = Word;
{$else}

size_t = LongInt;
{$endif}

type

TTranslationTable = array[char] of char; { таблица перевода }


TSearchBM = class(TObject)
private
FTranslate : TTranslationTable; { таблица перевода }
FJumpTable : array[char] of Byte; { таблица переходов }
FShift_1 : integer;
FPattern : pchar;
FPatternLen : size_t;


public
procedure Prepare( Pattern: pchar; PatternLen: size_t; IgnoreCase: Boolean );
procedure PrepareStr( const Pattern: string; IgnoreCase: Boolean );


function Search( Text: pchar; TextLen: size_t ): pchar;
function Pos( const S: string ): integer;
end;


implementation

uses SysUtils;

{Игнорируем регистр таблицы перевода}
procedure CreateTranslationTable( var T: TTranslationTable; IgnoreCase: Boolean );
var
c: char;
begin
for c := #0 to #255 do
T[c] := c;

if not IgnoreCase then
exit;

for c := 'a' to 'z' do
T[c] := UpCase(c);

{ Связываем все нижние символы с их эквивалентом верхнего регистра }
T['Б'] := 'A';
T['А'] := 'A';
T['Д'] := 'A';
T['В'] := 'A';


T['б'] := 'A';
T['а'] := 'A';
T['д'] := 'A';
T['в'] := 'A';


T['Й'] := 'E';
T['И'] := 'E';
T['Л'] := 'E';
T['К'] := 'E';


T['й'] := 'E';
T['и'] := 'E';
T['л'] := 'E';
T['к'] := 'E';


T['Н'] := 'I';
T['М'] := 'I';
T['П'] := 'I';
T['О'] := 'I';


T['н'] := 'I';
T['м'] := 'I';
T['п'] := 'I';
T['о'] := 'I';


T['У'] := 'O';
T['Т'] := 'O';
T['Ц'] := 'O';
T['Ф'] := 'O';


T['у'] := 'O';
T['т'] := 'O';
T['ц'] := 'O';
T['ф'] := 'O';


T['Ъ'] := 'U';
T['Щ'] := 'U';
T['Ь'] := 'U';
T['Ы'] := 'U';


T['ъ'] := 'U';
T['щ'] := 'U';
T['ь'] := 'U';
T['ы'] := 'U';


T['с'] := 'С';
end;

{Подготовка таблицы переходов}
procedure TSearchBM.Prepare( Pattern: pchar; PatternLen: size_t;

IgnoreCase: Boolean );
var

i: integer;
c, lastc: char;
begin

FPattern := Pattern;
FPatternLen := PatternLen;


if FPatternLen < 1 then
FPatternLen := strlen(FPattern);


{Данный алгоритм базируется на наборе из 256 символов}
if FPatternLen > 256 then
exit;

{1. Подготовка таблицы перевода}
CreateTranslationTable( FTranslate, IgnoreCase);

{2. Подготовка таблицы переходов}
for c := #0 to #255 do
FJumpTable[c] := FPatternLen;

for i := FPatternLen - 1 downto 0 do begin
c := FTranslate[FPattern[i]];
if FJumpTable[c] >= FPatternLen - 1 then
FJumpTable[c] := FPatternLen - 1 - i;
end;

FShift_1 := FPatternLen - 1;
lastc := FTranslate[Pattern[FPatternLen - 1]];

for i := FPatternLen - 2 downto 0 do
if FTranslate[FPattern[i]] = lastc then begin
FShift_1 := FPatternLen - 1 - i;
break;
end;

if FShift_1 = 0 then
FShift_1 := 1;
end;

procedure TSearchBM.PrepareStr( const Pattern: string; IgnoreCase: Boolean );
var
str: pchar;
begin
if Pattern <> '' then begin
{$ifdef Windows}

str := @Pattern[1];
{$else}

str := pchar(Pattern);
{$endif}

Prepare( str, Length(Pattern), IgnoreCase);
end;
end;

{Поиск последнего символа & просмотр справа налево}
function TSearchBM.Search( Text: pchar; TextLen: size_t ): pchar;
var
shift, m1, j: integer;
jumps: size_t;
begin
result := nil;
if FPatternLen > 256 then
exit;

if TextLen < 1 then
TextLen := strlen(Text);

m1 := FPatternLen - 1;
shift := 0;
jumps := 0;

{Поиск последнего символа}

while jumps <= TextLen do begin
Inc( Text, shift);
shift := FJumpTable[FTranslate[Text^]];
while shift <> 0 do begin
Inc( jumps, shift);
if jumps > TextLen then
exit;

Inc( Text, shift);
shift := FJumpTable[FTranslate[Text^]];
end;

{Сравниваем справа налево FPatternLen - 1 символов}
if jumps >= m1 then begin
j := 0;
while FTranslate[FPattern[m1 - j]] = FTranslate[(Text - j)^] do begin
Inc(j);
if j = FPatternLen then begin
result := Text - m1;
exit;
end;
end;
end;

shift := FShift_1;
Inc( jumps, shift);
end;
end;

function TSearchBM.Pos( const S: string ): integer;
var
str, p: pchar;
begin
result := 0;
if S <> '' then begin
{$ifdef Windows}

str := @S[1];
{$else}

str := pchar(S);
{$endif}

p := Search( str, Length(S));
if p <> nil then
result := 1 + p - str;
end;
end;

end.


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz