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

この発言に対し以下のコメントが寄せられています

#00433　本田勝彦        さん　RE^2:ファイル内文字列の検索・置き換え






ユニット版最速バージョンです。#416, #417 はあまりにも遅かったので
削除させていただきました。お読みになられた方スミマセンm(_ _)m

---- ｷﾘﾄﾘ ------------------------------------------------------------
unit RplcStrm; // Replace Stream

interface

uses
  Windows, SysUtils, Classes;

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

  TSearchBufferOption = (sbMatchCase, 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

type
  TCharMap = array[Char] of Char;
var
  UpperCharMap, AlphaCharMap: TCharMap;
  Ch: Char;

function SearchBuffer(const TargetText: String; P: PChar;
  Options: TSearchBufferOptions; var Info: THitPointInfo): Boolean;
var
  L, SC, C, I, Extend: Integer;
  Pattern: String;
  MatchChar, DBCSPattern, DBCSBuffer: Boolean;
begin
  Result := False;
  Pattern := TargetText;
  if not (sbMatchCase in Options) then
    Pattern := AnsiUpperCase(Pattern);
  L := Length(TargetText);
  Info.Start := 0;
  SC := StrLen(P);
  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;
      DBCSPattern := Pattern[I + 1] in [#$81..#$9F, #$E0..#$FC];
      DBCSBuffer := P[Info.Start + I + C] in [#$81..#$9F, #$E0..#$FC];
      if sbMatchCase in Options then
        if DBCSBuffer then
          MatchChar := DBCSPattern and
                       (Pattern[I + 1] = P[Info.Start + I + C]) and
                       (Pattern[I + 2] = P[Info.Start + I + C + 1])
        else
          MatchChar := Pattern[I + 1] = P[Info.Start + I + C]
      else
        if DBCSBuffer then
          if (P[Info.Start + I + C] = #$82) and
             (P[Info.Start + I + C + 1] in [#$81..#$9A]) then // ａ..ｚ
            MatchChar :=
              (Pattern[I + 1] = #$82) and
              (Pattern[I + 2] = AlphaCharMap[P[Info.Start + I + C + 1]])
          else
            MatchChar := DBCSPattern and
                         (Pattern[I + 1] = P[Info.Start + I + C]) and
                         (Pattern[I + 2] = P[Info.Start + I + C + 1])
        else
          MatchChar :=
            Pattern[I + 1] = UpperCharMap[P[Info.Start + I + C]];
      if not MatchChar then
      begin
        Extend := 0;
        if I > 0 then
          if (sbIncludeCRLF in Options) and
             (P[Info.Start + I + C] in [#$0D, #$0A]) then
            Extend := 1
          else
            if (sbIncludeSpace in Options) and
               (P[Info.Start + I + C] in [#$20, #$09]) then
              Extend := 1
            else
              if (sbIncludeSpace in Options) and
                 (P[Info.Start + I + C] = #$81) and
                 (P[Info.Start + I + C + 1] = #$40) then
                Extend := 2;
        if Extend > 0 then
        begin
          Inc(C, Extend);
          Inc(Info.Length, Extend);
          Continue;
        end
        else
          Break;
      end
      else
      begin
        Inc(I, Byte(DBCSBuffer) + 1);
        Inc(Info.Length, Byte(DBCSBuffer) + 1);
        if I >= L then
        begin
          Result := True;
          Exit;
        end;
      end;
    end;
    Inc(Info.Start, Byte(DBCSBuffer) + 1);
    Dec(SC, Byte(DBCSBuffer) + 1);
  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 (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 (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;

initialization
  for Ch := Low(UpperCharMap) to High(UpperCharMap) do
  begin
    UpperCharMap[Ch] := Ch;
    AlphaCharMap[Ch] := Ch;
  end;
  CharUpperBuff(PChar(@UpperCharMap), SizeOf(UpperCharMap));
  for Ch := #$81 to #$9A do
    AlphaCharMap[Ch] := Char(Ord(Ch) - $21);
end.
---- ｷﾘﾄﾘ ------------------------------------------------------------
                                                  本田勝彦

Original document by 本田勝彦        氏 ID:(VYR01647)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。