16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"RE:ファイル内文字列の検索・置き換え"
この発言は #00415 本田勝彦 さんのファイル内文字列の検索・置き換え に対するコメントです
ユニットにしました。オプションとして
・大文字小文字を区別しない。
・改行を無視する
・スペースを無視する
を指定出来ます。(指定すると遅くなるけど)
また、プログレスバーを表示するメソッドへのポインタも受け取れます。
表示が不要の時は、nil を渡して下さい。
使用例
function TForm1.ProgressProc(StreamSize, Position: Longint): Boolean;
begin
ProgressBar1.Position := Round(Position / StreamSize * 100);
Result := True;
end;
ReplaceFile('a:\autoexec.bat', 'a:\work.txt', 'windows', '窓',
[roMatchCase, roCrlf, roSpace], ProgressProc);
---- キリトリ -------------------------------------------------------
unit RplcStrm; // Replace Stream
interface
uses
Windows, SysUtils, Classes;
type
TProgressProc = function(const StreamSize, Position:
Longint): Boolean of Object;
TReplaceOption = (roMatchCase, roCrlf, roSpace);
TReplaceOptions = set of TReplaceOption;
function ReplaceStream(InputStream, OutputStream: TStream;
const TargetText, ReplaceText: String;
Options: TReplaceOptions; ProgressProc: TProgressProc): Boolean;
function ReplaceFile(const InputFile, OutputFile, TargetText,
ReplaceText: String; Options: TReplaceOptions;
ProgressProc: TProgressProc): Boolean;
implementation
type
TSearchInfo = record
Start, Length: Integer;
IsPossible: Boolean;
end;
function Search(const Pattern: String; P: PChar;
var Info: TSearchInfo; Options: TReplaceOptions): Boolean;
var
L, SC, C, I: Integer;
begin
Result := False;
L := Length(Pattern);
SC := StrLen(P);
Info.Start := 0;
while SC > 0 do
begin
I := 0;
C := 0;
Info.Length := 0;
Info.IsPossible := False;
while (Pattern[I + 1] = P[Info.Start + I + C]) or
(Info.IsPossible and
((P[Info.Start + I + C] = #0) or
((roCrlf in Options) and
(P[Info.Start + I + C] in [#$0D, #$0A])) or
((roSpace in Options) and (
(P[Info.Start + I + C] = #$20) or
((P[Info.Start + I + C] = #$81) and
(P[Info.Start + I + C + 1] = #$40))))))do
begin
if Info.IsPossible and (P[Info.Start + I + C] = #0) then
Exit;
if Info.IsPossible and
(((roCrlf in Options) and
(P[Info.Start + I + C] in [#$0D, #$0A])) or
((roSpace in Options) and (P[Info.Start + I + C] = #$20))) then
begin
Inc(C);
Inc(Info.Length);
Continue;
end;
if Info.IsPossible and (roSpace in Options) and
(P[Info.Start + I + C] = #$81) and
(P[Info.Start + I + C + 1] = #$40) then
begin
Inc(C, 2);
Inc(Info.Length, 2);
Continue;
end;
if (I = 0) and
(not IsDBCSLeadByte(Byte(Pattern[I + 1])) or
(IsDBCSLeadByte(Byte(Pattern[I + 1])) and
IsDBCSLeadByte(Byte(P[Info.Start + I + C])) and
(Pattern[I + 2] = P[Info.Start + I + C + 1]))) then
Info.IsPossible := True;
Inc(I);
Inc(Info.Length);
if I >= L then
begin
Result := True;
Exit;
end;
end;
Inc(Info.Start);
Dec(SC);
end;
end;
function ReplaceStream(InputStream, OutputStream: TStream;
const TargetText, ReplaceText: String;
Options: TReplaceOptions; ProgressProc: TProgressProc): Boolean;
const
BufferSize = $2000;
var
Buffer, P, UpperBuf: PChar;
Info: TSearchInfo;
T, R: Integer;
Count: Longint;
I: Integer;
ShowProgress, MatchCase: Boolean;
StreamSize: Longint;
Target: String;
begin
if (InputStream = nil) or (OutputStream = nil) or
(InputStream = OutputStream) or
(TargetText = '') or (TargetText = ' ') or
(TargetText = ' ') or (ReplaceText = '') then Exit;
ShowProgress := @ProgressProc <> nil;
if ShowProgress then
StreamSize := InputStream.Size;
MatchCase := roMatchCase in Options;
Target := TargetText;
if MatchCase then
begin
Target := AnsiUpperCase(Target);
UpperBuf := StrAlloc(BufferSize + 1);
end;
T := Length(Target);
R := Length(ReplaceText);
Buffer := StrAlloc(BufferSize + 1);
try
P := Buffer;
Info.Length := 0;
while True do
begin
Count := InputStream.Read(P^, BufferSize - Info.Length);
if Count = 0 then
begin
if Buffer <> P then
OutputStream.Write(Buffer^, P - Buffer);
Break;
end
else
begin
Buffer[Info.Length + Count] := #0;
if MatchCase then
begin
Move(Buffer[0], UpperBuf[0], Info.Length + Count);
CharUpperBuff(UpperBuf, Info.Length + Count);
P := UpperBuf;
end
else
P := Buffer;
while Search(Target, P, Info, Options) do
begin
if MatchCase then
P := Buffer + (P - UpperBuf);
OutputStream.Write(P^, Info.Start);
OutputStream.Write(ReplaceText[1], R);
if Info.Length > T then
for I := Info.Start to Info.Start + Info.Length do
if P[I] in [#$0D, #$0A] then
begin
OutputStream.Write(#$0D#$0A, 2);
Break;
end;
Inc(P, Info.Start + Info.Length);
if MatchCase then
P := UpperBuf + (P - Buffer);
end;
if MatchCase then
P := Buffer + (P - UpperBuf);
OutputStream.Write(P^, Info.Start);
if Info.IsPossible then
begin
Inc(P, Info.Start);
Move(P[0], Buffer[0], Info.Length);
end;
P := Buffer;
Inc(P, Info.Length);
end;
if ShowProgress then
if not ProgressProc(StreamSize, InputStream.Position) then
Exit;
end;
Result := True;
finally
StrDispose(Buffer);
if roMatchCase in Options then
StrDispose(UpperBuf);
end;
end;
function ReplaceFile(const InputFile, OutputFile, TargetText,
ReplaceText: String; Options: TReplaceOptions;
ProgressProc: TProgressProc): Boolean;
var
InputStream, OutputStream: TFileStream;
begin
Result := False;
if (InputFile = '') or (OutputFile = '') or (InputFile = OutputFile) or
(TargetText = '') or (TargetText = ' ') or (TargetText = ' ') or
(ReplaceText = '') then Exit;
InputStream := TFileStream.Create(InputFile, fmOpenRead);
OutputStream := TFileStream.Create(OutputFile, fmCreate);
try
Result := ReplaceStream(InputStream, OutputStream,
TargetText, ReplaceText, Options, ProgressProc);
finally
InputStream.Free;
OutputStream.Free;
end;
end;
end.
---- キリトリ -------------------------------------------------------
本田勝彦
Original document by 本田勝彦 氏 ID:(VYR01647)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum
|