この発言は
#00415　本田勝彦        さんのファイル内文字列の検索・置き換え
に対するコメントです



  

　検索ルーチンも外へ出しました。検索対象文字列に、改行文字
  半角全角スペースタブがあってもヒットします。
  大文字小文字区別無し検索も速くなりました。
  
例：メモのカーソル位置から検索
var
  Info: THitPointInfo;
  Buffer, P: PChar;
begin
  Buffer := Memo1.Lines.GetText;
  P := Buffer;
  try
    Inc(P, Memo1.SelStart + Memo1.SelLength);
    if SearchBuffer(Edit1.Text, P,
       [sbNoMatchCase, sbIncludeCRLF, sbIncludeSpace], Info) then
    begin
      Memo1.SelStart := P - Buffer + Info.Start;
      Memo1.SelLength := Info.Length;
      Memo1.SetFocus;
    end;
  finally
    StrDispose(Buffer);
  end;
end;
  
例：メモ内の文字列の一括置き換え
var
  MS1, MS2: TMemoryStream;
begin
  MS1 := TMemoryStream.Create;
  MS2 := TMemoryStream.Create;
  try
    Memo1.Lines.SaveToStream(MS1);
    MS1.Position := 0;
    if ReplaceStream(MS1, MS2, Edit1.Text, Edit2.Text,
        [sbNoMatchCase, sbIncludeCRLF, sbIncludeSpace], nil) then
    begin
      MS2.Position := 0;
      Memo1.Lines.LoadFromStream(MS2);
    end;
  finally
    MS1.free;
    MS2.free;
  end;
end;
---- キリトリ -------------------------------------------------------
unit RplcStrm; // Replace Stream

interface

uses
  Windows, SysUtils, Classes;

type
  TProgressProc = function(const StreamSize, Position:
      Longint): Boolean of Object;

  TSearchBufferOption = (sbNoMatchCase, sbIncludeCRLF, sbIncludeSpace);
  TSearchBufferOptions = set of TSearchBufferOption;

  THitPointInfo = record
    Start, Length: Integer;
  end;

function SearchBuffer(const TargetText: String; P: PChar;
  Options: TSearchBufferOptions; var Info: THitPointInfo): Boolean;

function ReplaceStream(InputStream, OutputStream: TStream;
  const TargetText, ReplaceText: String;
  Options: TSearchBufferOptions; ProgressProc: TProgressProc): Boolean;

function ReplaceFile(const InputFile, OutputFile, TargetText,
  ReplaceText: String; Options: TSearchBufferOptions;
  ProgressProc: TProgressProc): Boolean;

implementation

function SearchBuffer(const TargetText: String; P: PChar;
  Options: TSearchBufferOptions; var Info: THitPointInfo): Boolean;
var
  L, SC, C, I: Integer;
  Ch: Char;
  CharMap, UpperCharMap: array[Char] of Char;
  Pattern, S: String;
begin
  Result := False;
  Pattern := TargetText;
  if sbNoMatchCase in Options then
    Pattern := AnsiUpperCase(Pattern);
  for Ch := Low(CharMap) to High(CharMap) do
  begin
    CharMap[Ch] := Ch;
    UpperCharMap[Ch] := Ch;
  end;
  CharUpperBuff(PChar(@UpperCharMap), SizeOf(UpperCharMap));
  L := Length(Pattern);
  SC := StrLen(P);
  Info.Start := 0;
  while SC > 0 do
  begin
    I := 0;
    C := 0;
    Info.Length := 0;
    while True do
    begin
      if (I > 0) and (P[Info.Start + I + C] = #0) then
        Exit;
      if IsDBCSLeadByte(byte(P[Info.Start + I + C])) then
      begin
        S := P[Info.Start + I + C] + P[Info.Start + I + C + 1];
        if sbNoMatchCase in Options then
          S := AnsiUpperCase(S);
        if S <> Copy(Pattern, I + 1, 2) then
          if (I > 0) and (sbIncludeCRLF in Options) and
             (S = #$81#$40) then
          begin
            Inc(C, 2);
            Inc(Info.Length, 2);
            Continue;
          end
          else
            Break;
        Inc(I);
        Inc(Info.Length);
      end
      else
      begin
        if ((sbNoMatchCase in Options) and
           (UpperCharMap[P[Info.Start + I + C]] <> Pattern[I + 1])) or
           (not (sbNoMatchCase in Options) and
           (CharMap[P[Info.Start + I + C]] <> Pattern[I + 1])) then
          if ((I > 0) and (sbIncludeCRLF in Options) and
             (P[Info.Start + I + C] in [#$0D, #$0A])) or
             ((I > 0) and (sbIncludeSpace in Options) and
             (P[Info.Start + I + C] in [#$20, #$09])) then
          begin
            Inc(C);
            Inc(Info.Length);
            Continue;
          end
          else
            Break;
      end;
      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: TSearchBufferOptions; ProgressProc: TProgressProc): Boolean;
const
  BufferSize = $2000;
var
  Buffer, P: PChar;
  T, R, Count, I, StreamSize: Longint;
  ShowProgress: Boolean;
  Info: THitPointInfo;
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;
  T := Length(TargetText);
  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;
        P := Buffer;
        while SearchBuffer(TargetText, P, Options, Info) do
        begin
          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);
        end;
        OutputStream.Write(P^, Info.Start);
        if Info.Length > 0 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);
  end;
end;

function ReplaceFile(const InputFile, OutputFile, TargetText,
  ReplaceText: String; Options: TSearchBufferOptions;
  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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。