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	(* *** 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.