字符串不断增加内存分配效率的问题

在操作字符串的时候，如果要对字符串进行添加操作，那么内存的分配开销非常大，因此可以用下面的StringBuilder对象来解决，这个适合于数据不断增加的情况。

You can change the ALLOCATE_FACTOR constant to change the balance

between speed and balance; high values result in more speed, but more

memory usage. ALLOCATE_FACTOR = 1 means normal concatenation.

type

 TStringBuilder = class(TObject)

 private

   FValue: AnsiString;

   FValueLength: Integer;

   function GetValue: AnsiString;

 public

   procedure Add(const S: AnsiString);

   property Value: AnsiString read GetValue;

 end;

function TStringBuilder.GetValue: AnsiString;

begin

 SetLength(FValue, FValueLength);

 Result := FValue;

end;

procedure TStringBuilder.Add(const S: AnsiString);

const

 ALLOCATE_FACTOR = 1.5;

begin

 if S <> '' then

 begin

   if FValueLength + Length(S) > Length(FValue) then

     SetLength(FValue, Round((FValueLength + Length(S)) *

       ALLOCATE_FACTOR));

   Move(S[1], FValue[FValueLength + 1], Length(S));

   FValueLength := FValueLength + Length(S);

 end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 I: Integer;

 Strings: TStringBuilder;

begin

 Strings := TStringBuilder.Create;

 try

   for I := 1 to 100000 do

     Strings.Add('My string '+IntToStr(I));

   ShowMessage(Strings.Value);

 finally

   Strings.Free;

 end;

end;

----------------------------------------

{*******************************************************}

{                                                       }

{       StringBuilder                   2007/03/06      }

{                                                       }

{       for Delphi                                      }

{                                                       }

{*******************************************************}

unit StringBuilder;

interface

type

 TStringBuilder = class(TObject)

 private

   FBuffer: array of WideChar;

   FLength: Integer;

   procedure ArrayCopy(Src: PWideChar; SrcPos: Integer; Dest: PWideChar;

     DestPos: Integer; Len: Integer);

   procedure ExpandCapacity(MinimumCapacity: Integer);

   function GetCharAt(Index: Integer): WideChar;

   function KMPSearch(Str: PWideChar; Len: Integer; Index: Integer): Integer;

   procedure SetCharAt(Index: Integer; C: WideChar);

 public

   constructor Create(ACapacity: Integer = 16); overload;

   constructor Create(S: WideString); overload;

   destructor Destroy; override;

   procedure Append(S: WideString); overload;

   procedure Append(Sb: TStringBuilder); overload;

   procedure Append(Str: PWideChar; Offset, Len: Integer); overload;

   function Capacity: Integer;

   procedure Delete(StartIndex, EndIndex: Integer);

   procedure DeleteCharAt(Index: Integer);

   procedure EnsureCapacity(MinimumCapacity: Integer);

   procedure GetChars(SrcBegin, SrcEnd: Integer;

     Dest: PWideChar; DestBegin: Integer);

   function IndexOf(S: WideString; FromIndex: Integer = 0):Integer;

   procedure Insert(Offset: Integer; S: WideString); overload;

   procedure Insert(Index: Integer; Str: PWideChar;

     Offset, Len: Integer); overload;

   procedure Replace(StartIndex, EndIndex: Integer; S: WideString);

   procedure SetLength(Len: Integer);

   function SubString(StartIndex, EndIndex: Integer): WideString;

   function ToString: WideString;

   procedure TrimToSize;

   property CharAt[Index: Integer]: WideChar read GetCharAt write SetCharAt;

   property Length: Integer read FLength;

 end;

implementation

uses

 SysUtils, SysConst;

{ TStringBuilder.ArrayCopy

  配列の指定位置からを指定した長さ分の配列をコピーする。

 指定位置、長さが０未満の場合は ERangeError が発生する。}

procedure TStringBuilder.ArrayCopy(Src: PWideChar; SrcPos: Integer;

 Dest: PWideChar; DestPos: Integer; Len: Integer);

begin

 if (SrcPos < 0) or (DestPos < 0) or (Len < 0) then

   raise ERangeError.CreateRes(@SRangeError);

 Move((Src + SrcPos)^, (Dest + DestPos)^, Len * SizeOf(WideChar));

end;

{ TStringBuilder.ExpandCapacity

 内部バッファの拡張。新しい容量は、次の２つのうち大きい方とする。

   指定した容量

   現在の容量＋１の２倍 }

procedure TStringBuilder.ExpandCapacity(MinimumCapacity: Integer);

var

 NewCapacity: Integer;

begin

 NewCapacity := (Capacity + 1) * 2;

 if NewCapacity < 0 then

   NewCapacity := MaxInt

 else if MinimumCapacity > NewCapacity then

   NewCapacity := MinimumCapacity;

 System.SetLength(FBuffer, NewCapacity);

end;

{ TStringBuilder.GetCharAt }

function TStringBuilder.GetCharAt(Index: Integer): WideChar;

begin

 if (Index < 0) or (Index >= FLength) then

   raise ERangeError.CreateRes(@SRangeError);

 Result := FBuffer[Index];

end;

{ TStringBuilder.KMPSearch

 Knuth-Morris-Pratt algorithm }

function TStringBuilder.KMPSearch(Str: PWideChar; Len: Integer; Index: Integer):

 Integer;

var

 Table: array of Integer;

 I, J: Integer;

begin

 Result := -1;

 System.SetLength(Table, Len + 1);

 Table[0] := 0;

 Table[1] := 0;

 I := 1;

 J := 0;

 while Len > I do

 begin

   if Str[I] = Str[J] then

   begin

     Inc(I);

     Inc(J);

     Table[I] := J;

   end

   else if J = 0 then

   begin

     Inc(I);

     Table[I] := 0;

   end

   else

     J := Table[J];

 end;

 I := 0;

 while Index < FLength do

 begin

   if FBuffer[Index] = Str[I] then

   begin

     Inc(Index);

     Inc(I);

     if Len = I then

     begin

       Result := Index - Len;

       Exit;

     end;

   end

   else if I = 0 then

   begin

     Inc(Index);

   end

   else

     I := Table[I];

 end;

end;

{ TStringBuilder.SetCharAt }

procedure TStringBuilder.SetCharAt(Index: Integer; C: WideChar);

begin

 if (Index < 0) or (Index >= FLength) then

   raise ERangeError.CreateRes(@SRangeError);

 FBuffer[Index] := C;

end;

{ TStringBuilder.Create

 引数がない場合、初期容量 16 文字で文字なしとする。

 引数がある場合、引数で指定された初期容量で文字なしとする。

                 ただし０未満の場合は ERangeError が発生する。}

constructor TStringBuilder.Create(ACapacity: Integer = 16);

begin

 System.SetLength(FBuffer, ACapacity);

 FLength := 0;

end;

{ TStringBuilder.Create }

constructor TStringBuilder.Create(S: WideString);

begin

 Append(S);

end;

{ TStringBuilder.Destroy }

destructor TStringBuilder.Destroy;

begin

 FBuffer := nil;

 inherited Destroy;

end;

{ TStringBuilder.Append }

procedure TStringBuilder.Append(S: WideString);

var

 Len, NewLen: Integer;

begin

 Len := System.Length(S);

 if Len <> 0 then

 begin

   NewLen := FLength + Len;

   if NewLen > Capacity then

     ExpandCapacity(NewLen);

   ArrayCopy(PWideChar(S), 0, PWideChar(FBuffer), FLength, Len);

   FLength := NewLen;

 end;

end;

{ TStringBuilder.Append }

procedure TStringBuilder.Append(Sb: TStringBuilder);

var

 Len, NewLen: Integer;

begin

 Len := Sb.Length;

 if Len <> 0 then

 begin

   NewLen := FLength + Len;

   if NewLen > Capacity then

     ExpandCapacity(NewLen);

   Sb.GetChars(0, Len, PWideChar(FBuffer), FLength);

   FLength := NewLen;

 end;

end;

{ TStringBuilder.Append }

procedure TStringBuilder.Append(Str: PWideChar; Offset, Len: Integer);

var

 NewLen: Integer;

begin

 NewLen := FLength + Len;

 if NewLen > Capacity then

   ExpandCapacity(NewLen);

 ArrayCopy(Str, Offset, PWideChar(FBuffer), FLength, Len);

 FLength := NewLen;

end;

{ TStringBuilder.Capacity }

function TStringBuilder.Capacity: Integer;

begin

 Result := System.Length(FBuffer);

end;

{ TStringBuilder.Delete

 StartIndex から EndIndex - 1 まで削除する。

 StartIndex を含む。

 EndIndex を含まない。}

procedure TStringBuilder.Delete(StartIndex, EndIndex: Integer);

var

 Len: Integer;

 P: PWideChar;

begin

 if EndIndex > FLength then

   EndIndex := FLength;

 if (StartIndex < 0) or (StartIndex > EndIndex) then

   raise ERangeError.CreateRes(@SRangeError);

 Len := EndIndex - StartIndex;

 if Len > 0 then

 begin

   P := PWideChar(FBuffer);

   ArrayCopy(P, StartIndex + Len, P, StartIndex, FLength - EndIndex);

   Dec(FLength, Len);

 end;

end;

{ TStringBuilder.DeleteCharAt }

procedure TStringBuilder.DeleteCharAt(Index: Integer);

var

 P: PWideChar;

begin

 if (Index < 0) or (Index >= FLength) then

   raise ERangeError.CreateRes(@SRangeError);

 P := PWideChar(FBuffer);

 ArrayCopy(P, Index + 1, P, Index, FLength - Index - 1);

 Dec(FLength);

end;

{ TStringBuilder.EnsureCapacity

 指定した容量が現在の容量より大きい場合は拡張する。}

procedure TStringBuilder.EnsureCapacity(MinimumCapacity: Integer);

begin

 if MinimumCapacity > Capacity then

   ExpandCapacity(MinimumCapacity);

end;

{ TStringBuilder.GetChars

 文字列を Dest にコピーする。

 コピー元の開始位置は SrcBegin

 コピー元の終了位置は SrcEnd - 1

 したがって、コピーされる文字数は SrcEnd - SrcBegin

 コピー先の開始位置は DestBegin

 コピー先の終了位置は DestBegin + (SrcEnd - SrcBegin) - 1 }

procedure TStringBuilder.GetChars(SrcBegin, SrcEnd: Integer;

 Dest: PWideChar; DestBegin: Integer);

begin

 if (SrcBegin < 0) or (SrcEnd < 0) or (SrcEnd > FLength) or

   (SrcBegin > SrcEnd) then

   raise ERangeError.CreateRes(@SRangeError);

 ArrayCopy(PWideChar(FBuffer), SrcBegin, Dest, DestBegin, SrcEnd - SrcBegin);

end;

{ TStringBuilder.IndexOf

 検索文字列が見つからない場合は -1 を返す。}

function TStringBuilder.IndexOf(S: WideString; FromIndex: Integer = 0): Integer;

begin

 if System.Length(S) > 0 then

 begin

   Result := KMPSearch(PWideChar(S), System.Length(S), FromIndex);

 end

 else

   Result := -1;

end;

{ TStringBuilder.Insert }

procedure TStringBuilder.Insert(Offset: Integer; S: WideString);

var

 Len, NewLen: Integer;

 P: PWideChar;

begin

 if (Offset < 0) or (Offset > FLength) then

   raise ERangeError.CreateRes(@SRangeError);

 Len := System.Length(S);

 NewLen := FLength + Len;

 if NewLen > Capacity then

   ExpandCapacity(NewLen);

 P := PWideChar(FBuffer);

 ArrayCopy(P, Offset, P, Offset + Len, FLength - Offset);

 ArrayCopy(PWideChar(S), 0, P, Offset, Len);

 FLength := NewLen;

end;

{ TStringBuilder.Insert }

procedure TStringBuilder.Insert(Index: Integer; Str: PWideChar;

 Offset, Len: Integer);

var

 NewLen: Integer;

 P: PWideChar;

begin

 if (Index < 0) or (Index > FLength) or (Offset < 0) or (Len < 0) then

   raise ERangeError.CreateRes(@SRangeError);

 NewLen := FLength + Len;

 if NewLen > Capacity then

   ExpandCapacity(NewLen);

 P := PWideChar(FBuffer);

 ArrayCopy(P, Index, P, Index + Len, FLength - Index);

 ArrayCopy(Str, Offset, P, Index, Len);

 FLength := NewLen;

end;

{ TStringBuilder.Replace

 StartIndex から EndIndex - 1 までを置換する。

 StartIndex を含む。

 EndIndex を含まない。}

procedure TStringBuilder.Replace(StartIndex, EndIndex: Integer; S: WideString);

var

 Len, NewLen: Integer;

 P: PWideChar;

begin

 if (StartIndex < 0) or (StartIndex > FLength) or (StartIndex > EndIndex) then

   raise ERangeError.CreateRes(@SRangeError);

 if EndIndex > FLength then

   EndIndex := FLength;

 Len := System.Length(S);

 NewLen := FLength + Len - (EndIndex - StartIndex);

 if NewLen > Capacity then

   ExpandCapacity(NewLen);

 P := PWideChar(FBuffer);

 ArrayCopy(P, EndIndex, P, StartIndex + Len, FLength - EndIndex);

 ArrayCopy(PWideChar(S), 0, P, StartIndex, Len);

 FLength := NewLen;

end;

{ TStringBuilder.SetLength }

procedure TStringBuilder.SetLength(Len: Integer);

var

 I: Integer;

begin

 if (Len < 0) then

   raise ERangeError.CreateRes(@SRangeError);

 if Len > Capacity  then

   ExpandCapacity(Len);

 if FLength < Len then

 begin

   for I := FLength to Len - 1 do

     FBuffer[I] := #$00;

 end

 else

   FLength := Len;

end;

{ TStringBuilder.SubString

 StartIndex から EndIndex - 1 までの部分文字列。

 StartIndex を含む。

 EndIndex を含まない。}

function TStringBuilder.SubString(StartIndex, EndIndex: Integer): WideString;

begin

 if (StartIndex < 0) or (StartIndex > FLength) or (StartIndex > EndIndex) then

   raise ERangeError.CreateRes(@SRangeError);

 Result := Copy(PWideChar(FBuffer), StartIndex + 1, EndIndex - StartIndex);

end;

{ TStringBuilder.ToString }

function TStringBuilder.ToString: WideString;

begin

 Result := Copy(PWideChar(FBuffer), 1, FLength);

end;

{ TStringBuilder.TrimToSize }

procedure TStringBuilder.TrimToSize;

begin

 if FLength < Capacity then

   System.SetLength(FBuffer, FLength);

end;

end.