tpsystools_4.04/source/StMerge.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StMerge.pas 4.04                            *}
{*********************************************************}
{* SysTools: "Mail Merge" functionality                  *}
{*********************************************************}

{$include StDefine.inc}

unit StMerge;

interface

uses
  Windows, SysUtils, Classes;

const
  StDefaultTagStart = '<';
  StDefaultTagEnd   = '>';
  StDefaultEscapeChar = '\';

type
  TStGotMergeTagEvent = procedure (Sender : TObject; Tag : AnsiString;
    var Value : AnsiString; var Discard : Boolean) of object;

  TStMergeProgressEvent = procedure (Sender : TObject; Index : Integer; var Abort : Boolean);

  TStTextMerge = class
  private
    FBadTag: AnsiString;
    FDefaultTags: TStrings;
    FEscapeChar: AnsiChar;
    FMergedText : TStrings;
    FMergeTags: TStrings;
    FTagEnd: AnsiString;
    FTagStart: AnsiString;
    FTemplate : TStrings;
    FOnMergeStart: TNotifyEvent;
    FOnMergeDone: TNotifyEvent;
    FOnLineStart: TStMergeProgressEvent;
    FOnLineDone: TStMergeProgressEvent;
    FOnGotMergeTag: TStGotMergeTagEvent;
    FOnGotUnknownTag: TStGotMergeTagEvent;
  protected {private}
    procedure DoGotUnknownTag(Tag: AnsiString; var Value: AnsiString;
      var Discard: Boolean);
    procedure DoGotMergeTag(Tag : AnsiString; var Value : AnsiString;
      var Discard : Boolean);
    procedure SetEscapeChar(const Value: AnsiChar);
    procedure SetTagEnd(const Value: AnsiString);
    procedure SetTagStart(const Value: AnsiString);
  public
    constructor Create;
    destructor Destroy; override;

    { Access and Update Methods }
    procedure Merge;

    { Persistence and streaming methods }
    {template }
    procedure LoadTemplateFromFile(const AFile : TFileName);
    procedure LoadTemplateFromStream(AStream : TStream);
    procedure SaveTemplateToFile(const AFile : TFileName);
    procedure SaveTemplateToStream(AStream : TStream);
    { merge result text }
    procedure SaveMergeToFile(const AFile : TFileName);
    procedure SaveMergeToStream(AStream : TStream);

    { properties }
    property BadTag : AnsiString
      read FBadTag write FBadTag;
    property DefaultTags : TStrings
      read FDefaultTags;
    property EscapeChar : AnsiChar
      read FEscapeChar write SetEscapeChar;
    property MergedText : TStrings
      read FMergedText;
    property MergeTags : TStrings
      read FMergeTags;
    property TagEnd : AnsiString
      read FTagEnd write SetTagEnd;
    property TagStart : AnsiString
      read FTagStart write SetTagStart;
    property Template : TStrings
      read FTemplate;

    { events }
    property OnGotMergeTag : TStGotMergeTagEvent
      read FOnGotMergeTag write FOnGotMergeTag;
    property OnGotUnknownTag : TStGotMergeTagEvent
      read FOnGotUnknownTag write FOnGotUnknownTag;
    property OnLineDone : TStMergeProgressEvent
      read FOnLineDone write FOnLineDone;
    property OnLineStart : TStMergeProgressEvent
      read FOnLineStart write FOnLineStart;
    property OnMergeDone : TNotifyEvent
      read FOnMergeDone write FOnMergeDone;
    property OnMergeStart : TNotifyEvent
      read FOnMergeStart write FOnMergeStart;
  end;

implementation

{ TStTextMerge }

constructor TStTextMerge.Create;
begin

  inherited Create;
  FDefaultTags := TStringList.Create;
  FMergeTags   := TStringList.Create;
  FMergedText  := TStringList.Create;
  FTemplate    := TStringList.Create;

  FTagEnd      := StDefaultTagEnd;
  FTagStart    := StDefaultTagStart;
  FEscapeChar  := StDefaultEscapeChar;
  FBadTag      := '';
end;

destructor TStTextMerge.Destroy;
begin
  FDefaultTags.Free;
  FMergeTags.Free;
  FMergedText.Free;
  FTemplate.Free;
  inherited Destroy;
end;

procedure TStTextMerge.DoGotMergeTag(Tag : AnsiString;
  var Value : AnsiString; var Discard : Boolean);
begin
  if Assigned(FOnGotMergeTag) then
    FOnGotMergeTag(self, Tag, Value, Discard);
end;

procedure TStTextMerge.DoGotUnknownTag(Tag : AnsiString;
  var Value : AnsiString; var Discard : Boolean);
begin
  if Assigned(FOnGotUnknownTag) then
    FOnGotUnknownTag(self, Tag, Value, Discard)
  else
    Value := FBadTag;
end;

procedure TStTextMerge.LoadTemplateFromFile(const AFile: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFile, fmOpenRead or fmShareDenyNone);
  try
    LoadTemplateFromStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStTextMerge.LoadTemplateFromStream(AStream: TStream);
begin
  FTemplate.Clear;
  FTemplate.LoadFromStream(AStream);
end;

procedure TStTextMerge.Merge;
{ merge template with current DataTags }
const
  TagIDChars = ['A'..'Z', 'a'..'z', '0'..'9', '_'];

  function MatchDelim(Delim : AnsiString; var PC : PAnsiChar) : Boolean;
  { see if current sequence matches specified Tag delimiter }
  var
    Match : PAnsiChar;
    Len : Integer;
  begin

    { compare text starting at PC with Tag delimiter }
    Len := Length(Delim);
    GetMem(Match, Len + 1);
    FillChar(Match^, Len + 1, #0);
    StrLCopy(Match, PC, Len);

    Result := StrPas(Match) = Delim;
    if Result then
      Inc(PC, Len);  {advance past Tag delimiter }

    FreeMem(Match, Len + 1);
  end;

  function GetTag(const Tag: AnsiString; var Discard : Boolean) : AnsiString;
  var
    IdxMerge, IdxDef : Integer;
    TagID : AnsiString;
  begin
    { extract TagID from delimiters }
    TagID := Copy(Tag, Length(TagStart) + 1, Length(Tag));
    TagID := Copy(TagID, 1, Length(TagID) - Length(TagEnd));

    { see if it matches Tag in MergeTags or DefaultTags }
    IdxMerge := FMergeTags.IndexOfName(TagID);
    IdxDef   := FDefaultTags.IndexOfName(TagID);

    { fire events as needed }
    if (IdxMerge < 0) and (IdxDef < 0) then begin { no match }
      DoGotUnknownTag(TagID, Result, Discard)
    end
    else begin  { found match }
      if (IdxMerge > -1) then begin { match in MergeTags }
        Result := FMergeTags.Values[TagID];
        DoGotMergeTag(TagID, Result, Discard);
      end
      else { not in MergTags, use Default }
      if (IdxDef > -1) then begin
        Result := FDefaultTags.Values[TagID];
        DoGotMergeTag(TagID, Result, Discard);
      end;
    end;
  end;

  procedure ReplaceTags(Idx : Integer);
  type
    TagSearchStates = (fsCollectingText, fsCollectingTagID);
  var
    i, Len : Integer;
    P, Cur : PAnsiChar;
    Buff, NewBuff, TagBuff, DataBuff, TextBuff : AnsiString;
    State : TagSearchStates;
    FS, FE, Prev : AnsiChar;
    {Escaped,} Discard : Boolean;
  begin
    { copy current template line }
    Buff := FTemplate[Idx];
    Len := Length(Buff);

    { output line starts empty }
    NewBuff := '';
    TagBuff := '';
    TextBuff := '';

    { starts of delimiter strings }
    FS := FTagStart[1];
    FE := FTagEnd[1];
    Prev := ' ';

    { point at start of current line }
    P := PAnsiChar(Buff);
    Cur := P;

    { start looking for Tags }
    State := fsCollectingText;
    for i := 1 to Len do begin
      case State of
        { accumulating non-Tag text }
        fsCollectingText: begin
          { matching the start of a Tag? }
          if (Cur^ = FS) and (Prev <> EscapeChar) and
            MatchDelim(FTagStart, Cur) then
          begin
            { dump what we've got }
            NewBuff := NewBuff + TextBuff;
            TextBuff := '';

            { start accumulating a TagID }
            TagBuff := TagStart;
            State := fsCollectingTagID;
          end

          else
          if (Cur^ = FS) and (Prev = EscapeChar) and
            MatchDelim(FTagStart, Cur) then
          begin
            { overwrite escape character }
            TextBuff[Length(TextBuff)] := Cur^;

            { go to next character }
            Prev := Cur^;
            Inc(Cur);
          end

          else
          { accumulate text }
          begin
            TextBuff := TextBuff + Cur^;

            { go to next character }
            Prev := Cur^;
            Inc(Cur);
          end;
        end;

        { accumulating a possible Tag }
        fsCollectingTagID: begin
          { matching the end of a Tag? }
          if (Cur^ = FE) and (Prev <> EscapeChar) and
            MatchDelim(FTagEnd, Cur) then
          begin
            { insert Tag value in place of TagID }
            TagBuff := TagBuff + TagEnd;
            DataBuff := GetTag(TagBuff, Discard);
            if not Discard then
              NewBuff := NewBuff + DataBuff;

            { switch back to accumulating non-Tag text }
            State := fsCollectingText;
          end

          else
          { accumulate TagID }
          if (Cur^ in TagIDChars) then begin
            TagBuff := TagBuff + Cur^;
            { go to next character }
            Prev := Cur^;
            Inc(Cur);
          end

          else
          { doesn't look like a TagID; pass it back to text collection logic }
          begin
            { turn the "failed Tag" into regular accumulated text }
            TextBuff := TagBuff + Cur^;
            TagBuff := '';

            { go to next character }
            Prev := Cur^;
            Inc(Cur);

            { switch back to accumulating non-Tag text }
            State := fsCollectingText;
          end;

        end;
      end; {case State}

    end; {for}

    { append anything remaining }
    if State = fsCollectingText then
      NewBuff := NewBuff + TextBuff
    else
      NewBuff := NewBuff + TagBuff;

    { update merge text with current line }
    FMergedText.Add(NewBuff);
  end;

var
  i : Integer;
  Abort : Boolean;

begin
  { notify start of merge }
  if Assigned(FOnMergeStart) then
    FOnMergeStart(self);

  FMergedText.Clear;

  Abort := False;
  { iterate Template }
  for i := 0 to Pred(FTemplate.Count) do begin
    if Assigned(FOnLineStart) then
      FOnLineStart(self, i, Abort);
      
    if Abort then Break;

    ReplaceTags(i);

    if Assigned(FOnLineDone) then
      FOnLineDone(self, i, Abort);

    if Abort then Break;
  end; {for}

  { notify end of merge }
  if Assigned(FOnMergeDone) then
    FOnMergeDone(self);
end;

procedure TStTextMerge.SaveMergeToFile(const AFile: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFile, fmCreate);
  try
    SaveMergeToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStTextMerge.SaveMergeToStream(AStream: TStream);
begin
  FMergedText.SaveToStream(AStream);
end;

procedure TStTextMerge.SaveTemplateToFile(const AFile: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFile, fmCreate);
  try
    SaveTemplateToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStTextMerge.SaveTemplateToStream(AStream: TStream);
begin
  FTemplate.SaveToStream(AStream);
end;

procedure TStTextMerge.SetEscapeChar(const Value: AnsiChar);
begin
  FEscapeChar := Value;
end;

procedure TStTextMerge.SetTagEnd(const Value: AnsiString);
begin
  FTagEnd := Value;
end;

procedure TStTextMerge.SetTagStart(const Value: AnsiString);
begin
  FTagStart := Value;
end;

end.
1	torben	2671	(* *** BEGIN LICENSE BLOCK ***
2			* Version: MPL 1.1
3			*
4			* The contents of this file are subject to the Mozilla Public License Version
5			* 1.1 (the "License"); you may not use this file except in compliance with
6			* the License. You may obtain a copy of the License at
7			* http://www.mozilla.org/MPL/
8			*
9			* Software distributed under the License is distributed on an "AS IS" basis,
10			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11			* for the specific language governing rights and limitations under the
12			* License.
13			*
14			* The Original Code is TurboPower SysTools
15			*
16			* The Initial Developer of the Original Code is
17			* TurboPower Software
18			*
19			* Portions created by the Initial Developer are Copyright (C) 1996-2002
20			* the Initial Developer. All Rights Reserved.
21			*
22			* Contributor(s):
23			*
24			* *** END LICENSE BLOCK *** *)
25
26			{*********************************************************}
27			{* SysTools: StMerge.pas 4.04 *}
28			{*********************************************************}
29			{* SysTools: "Mail Merge" functionality *}
30			{*********************************************************}
31
32			{$include StDefine.inc}
33
34			unit StMerge;
35
36			interface
37
38			uses
39			Windows, SysUtils, Classes;
40
41			const
42			StDefaultTagStart = '<';
43			StDefaultTagEnd = '>';
44			StDefaultEscapeChar = '\';
45
46			type
47			TStGotMergeTagEvent = procedure (Sender : TObject; Tag : AnsiString;
48			var Value : AnsiString; var Discard : Boolean) of object;
49
50			TStMergeProgressEvent = procedure (Sender : TObject; Index : Integer; var Abort : Boolean);
51
52			TStTextMerge = class
53			private
54			FBadTag: AnsiString;
55			FDefaultTags: TStrings;
56			FEscapeChar: AnsiChar;
57			FMergedText : TStrings;
58			FMergeTags: TStrings;
59			FTagEnd: AnsiString;
60			FTagStart: AnsiString;
61			FTemplate : TStrings;
62			FOnMergeStart: TNotifyEvent;
63			FOnMergeDone: TNotifyEvent;
64			FOnLineStart: TStMergeProgressEvent;
65			FOnLineDone: TStMergeProgressEvent;
66			FOnGotMergeTag: TStGotMergeTagEvent;
67			FOnGotUnknownTag: TStGotMergeTagEvent;
68			protected {private}
69			procedure DoGotUnknownTag(Tag: AnsiString; var Value: AnsiString;
70			var Discard: Boolean);
71			procedure DoGotMergeTag(Tag : AnsiString; var Value : AnsiString;
72			var Discard : Boolean);
73			procedure SetEscapeChar(const Value: AnsiChar);
74			procedure SetTagEnd(const Value: AnsiString);
75			procedure SetTagStart(const Value: AnsiString);
76			public
77			constructor Create;
78			destructor Destroy; override;
79
80			{ Access and Update Methods }
81			procedure Merge;
82
83			{ Persistence and streaming methods }
84			{template }
85			procedure LoadTemplateFromFile(const AFile : TFileName);
86			procedure LoadTemplateFromStream(AStream : TStream);
87			procedure SaveTemplateToFile(const AFile : TFileName);
88			procedure SaveTemplateToStream(AStream : TStream);
89			{ merge result text }
90			procedure SaveMergeToFile(const AFile : TFileName);
91			procedure SaveMergeToStream(AStream : TStream);
92
93			{ properties }
94			property BadTag : AnsiString
95			read FBadTag write FBadTag;
96			property DefaultTags : TStrings
97			read FDefaultTags;
98			property EscapeChar : AnsiChar
99			read FEscapeChar write SetEscapeChar;
100			property MergedText : TStrings
101			read FMergedText;
102			property MergeTags : TStrings
103			read FMergeTags;
104			property TagEnd : AnsiString
105			read FTagEnd write SetTagEnd;
106			property TagStart : AnsiString
107			read FTagStart write SetTagStart;
108			property Template : TStrings
109			read FTemplate;
110
111			{ events }
112			property OnGotMergeTag : TStGotMergeTagEvent
113			read FOnGotMergeTag write FOnGotMergeTag;
114			property OnGotUnknownTag : TStGotMergeTagEvent
115			read FOnGotUnknownTag write FOnGotUnknownTag;
116			property OnLineDone : TStMergeProgressEvent
117			read FOnLineDone write FOnLineDone;
118			property OnLineStart : TStMergeProgressEvent
119			read FOnLineStart write FOnLineStart;
120			property OnMergeDone : TNotifyEvent
121			read FOnMergeDone write FOnMergeDone;
122			property OnMergeStart : TNotifyEvent
123			read FOnMergeStart write FOnMergeStart;
124			end;
125
126			implementation
127
128			{ TStTextMerge }
129
130			constructor TStTextMerge.Create;
131			begin
132
133			inherited Create;
134			FDefaultTags := TStringList.Create;
135			FMergeTags := TStringList.Create;
136			FMergedText := TStringList.Create;
137			FTemplate := TStringList.Create;
138
139			FTagEnd := StDefaultTagEnd;
140			FTagStart := StDefaultTagStart;
141			FEscapeChar := StDefaultEscapeChar;
142			FBadTag := '';
143			end;
144
145			destructor TStTextMerge.Destroy;
146			begin
147			FDefaultTags.Free;
148			FMergeTags.Free;
149			FMergedText.Free;
150			FTemplate.Free;
151			inherited Destroy;
152			end;
153
154			procedure TStTextMerge.DoGotMergeTag(Tag : AnsiString;
155			var Value : AnsiString; var Discard : Boolean);
156			begin
157			if Assigned(FOnGotMergeTag) then
158			FOnGotMergeTag(self, Tag, Value, Discard);
159			end;
160
161			procedure TStTextMerge.DoGotUnknownTag(Tag : AnsiString;
162			var Value : AnsiString; var Discard : Boolean);
163			begin
164			if Assigned(FOnGotUnknownTag) then
165			FOnGotUnknownTag(self, Tag, Value, Discard)
166			else
167			Value := FBadTag;
168			end;
169
170			procedure TStTextMerge.LoadTemplateFromFile(const AFile: TFileName);
171			var
172			FS : TFileStream;
173			begin
174			FS := TFileStream.Create(AFile, fmOpenRead or fmShareDenyNone);
175			try
176			LoadTemplateFromStream(FS);
177			finally
178			FS.Free;
179			end;
180			end;
181
182			procedure TStTextMerge.LoadTemplateFromStream(AStream: TStream);
183			begin
184			FTemplate.Clear;
185			FTemplate.LoadFromStream(AStream);
186			end;
187
188			procedure TStTextMerge.Merge;
189			{ merge template with current DataTags }
190			const
191			TagIDChars = ['A'..'Z', 'a'..'z', '0'..'9', '_'];
192
193			function MatchDelim(Delim : AnsiString; var PC : PAnsiChar) : Boolean;
194			{ see if current sequence matches specified Tag delimiter }
195			var
196			Match : PAnsiChar;
197			Len : Integer;
198			begin
199
200			{ compare text starting at PC with Tag delimiter }
201			Len := Length(Delim);
202			GetMem(Match, Len + 1);
203			FillChar(Match^, Len + 1, #0);
204			StrLCopy(Match, PC, Len);
205
206			Result := StrPas(Match) = Delim;
207			if Result then
208			Inc(PC, Len); {advance past Tag delimiter }
209
210			FreeMem(Match, Len + 1);
211			end;
212
213			function GetTag(const Tag: AnsiString; var Discard : Boolean) : AnsiString;
214			var
215			IdxMerge, IdxDef : Integer;
216			TagID : AnsiString;
217			begin
218			{ extract TagID from delimiters }
219			TagID := Copy(Tag, Length(TagStart) + 1, Length(Tag));
220			TagID := Copy(TagID, 1, Length(TagID) - Length(TagEnd));
221
222			{ see if it matches Tag in MergeTags or DefaultTags }
223			IdxMerge := FMergeTags.IndexOfName(TagID);
224			IdxDef := FDefaultTags.IndexOfName(TagID);
225
226			{ fire events as needed }
227			if (IdxMerge < 0) and (IdxDef < 0) then begin { no match }
228			DoGotUnknownTag(TagID, Result, Discard)
229			end
230			else begin { found match }
231			if (IdxMerge > -1) then begin { match in MergeTags }
232			Result := FMergeTags.Values[TagID];
233			DoGotMergeTag(TagID, Result, Discard);
234			end
235			else { not in MergTags, use Default }
236			if (IdxDef > -1) then begin
237			Result := FDefaultTags.Values[TagID];
238			DoGotMergeTag(TagID, Result, Discard);
239			end;
240			end;
241			end;
242
243			procedure ReplaceTags(Idx : Integer);
244			type
245			TagSearchStates = (fsCollectingText, fsCollectingTagID);
246			var
247			i, Len : Integer;
248			P, Cur : PAnsiChar;
249			Buff, NewBuff, TagBuff, DataBuff, TextBuff : AnsiString;
250			State : TagSearchStates;
251			FS, FE, Prev : AnsiChar;
252			{Escaped,} Discard : Boolean;
253			begin
254			{ copy current template line }
255			Buff := FTemplate[Idx];
256			Len := Length(Buff);
257
258			{ output line starts empty }
259			NewBuff := '';
260			TagBuff := '';
261			TextBuff := '';
262
263			{ starts of delimiter strings }
264			FS := FTagStart[1];
265			FE := FTagEnd[1];
266			Prev := ' ';
267
268			{ point at start of current line }
269			P := PAnsiChar(Buff);
270			Cur := P;
271
272			{ start looking for Tags }
273			State := fsCollectingText;
274			for i := 1 to Len do begin
275			case State of
276			{ accumulating non-Tag text }
277			fsCollectingText: begin
278			{ matching the start of a Tag? }
279			if (Cur^ = FS) and (Prev <> EscapeChar) and
280			MatchDelim(FTagStart, Cur) then
281			begin
282			{ dump what we've got }
283			NewBuff := NewBuff + TextBuff;
284			TextBuff := '';
285
286			{ start accumulating a TagID }
287			TagBuff := TagStart;
288			State := fsCollectingTagID;
289			end
290
291			else
292			if (Cur^ = FS) and (Prev = EscapeChar) and
293			MatchDelim(FTagStart, Cur) then
294			begin
295			{ overwrite escape character }
296			TextBuff[Length(TextBuff)] := Cur^;
297
298			{ go to next character }
299			Prev := Cur^;
300			Inc(Cur);
301			end
302
303			else
304			{ accumulate text }
305			begin
306			TextBuff := TextBuff + Cur^;
307
308			{ go to next character }
309			Prev := Cur^;
310			Inc(Cur);
311			end;
312			end;
313
314			{ accumulating a possible Tag }
315			fsCollectingTagID: begin
316			{ matching the end of a Tag? }
317			if (Cur^ = FE) and (Prev <> EscapeChar) and
318			MatchDelim(FTagEnd, Cur) then
319			begin
320			{ insert Tag value in place of TagID }
321			TagBuff := TagBuff + TagEnd;
322			DataBuff := GetTag(TagBuff, Discard);
323			if not Discard then
324			NewBuff := NewBuff + DataBuff;
325
326			{ switch back to accumulating non-Tag text }
327			State := fsCollectingText;
328			end
329
330			else
331			{ accumulate TagID }
332			if (Cur^ in TagIDChars) then begin
333			TagBuff := TagBuff + Cur^;
334			{ go to next character }
335			Prev := Cur^;
336			Inc(Cur);
337			end
338
339			else
340			{ doesn't look like a TagID; pass it back to text collection logic }
341			begin
342			{ turn the "failed Tag" into regular accumulated text }
343			TextBuff := TagBuff + Cur^;
344			TagBuff := '';
345
346			{ go to next character }
347			Prev := Cur^;
348			Inc(Cur);
349
350			{ switch back to accumulating non-Tag text }
351			State := fsCollectingText;
352			end;
353
354			end;
355			end; {case State}
356
357			end; {for}
358
359			{ append anything remaining }
360			if State = fsCollectingText then
361			NewBuff := NewBuff + TextBuff
362			else
363			NewBuff := NewBuff + TagBuff;
364
365			{ update merge text with current line }
366			FMergedText.Add(NewBuff);
367			end;
368
369			var
370			i : Integer;
371			Abort : Boolean;
372
373			begin
374			{ notify start of merge }
375			if Assigned(FOnMergeStart) then
376			FOnMergeStart(self);
377
378			FMergedText.Clear;
379
380			Abort := False;
381			{ iterate Template }
382			for i := 0 to Pred(FTemplate.Count) do begin
383			if Assigned(FOnLineStart) then
384			FOnLineStart(self, i, Abort);
385
386			if Abort then Break;
387
388			ReplaceTags(i);
389
390			if Assigned(FOnLineDone) then
391			FOnLineDone(self, i, Abort);
392
393			if Abort then Break;
394			end; {for}
395
396			{ notify end of merge }
397			if Assigned(FOnMergeDone) then
398			FOnMergeDone(self);
399			end;
400
401			procedure TStTextMerge.SaveMergeToFile(const AFile: TFileName);
402			var
403			FS : TFileStream;
404			begin
405			FS := TFileStream.Create(AFile, fmCreate);
406			try
407			SaveMergeToStream(FS);
408			finally
409			FS.Free;
410			end;
411			end;
412
413			procedure TStTextMerge.SaveMergeToStream(AStream: TStream);
414			begin
415			FMergedText.SaveToStream(AStream);
416			end;
417
418			procedure TStTextMerge.SaveTemplateToFile(const AFile: TFileName);
419			var
420			FS : TFileStream;
421			begin
422			FS := TFileStream.Create(AFile, fmCreate);
423			try
424			SaveTemplateToStream(FS);
425			finally
426			FS.Free;
427			end;
428			end;
429
430			procedure TStTextMerge.SaveTemplateToStream(AStream: TStream);
431			begin
432			FTemplate.SaveToStream(AStream);
433			end;
434
435			procedure TStTextMerge.SetEscapeChar(const Value: AnsiChar);
436			begin
437			FEscapeChar := Value;
438			end;
439
440			procedure TStTextMerge.SetTagEnd(const Value: AnsiString);
441			begin
442			FTagEnd := Value;
443			end;
444
445			procedure TStTextMerge.SetTagStart(const Value: AnsiString);
446			begin
447			FTagStart := Value;
448			end;
449
450			end.