お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
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