/[projects]/dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/out.htm
ViewVC logotype

Contents of /dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/out.htm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (show annotations) (download) (as text)
Tue Aug 25 18:15:15 2015 UTC (8 years, 10 months ago) by torben
File MIME type: text/html
File size: 34846 byte(s)
Added tpsystools component
1 <pre>
2 <font color=#FF0000><i>// Upgraded to Delphi 2009: Sebastian Zierer</i></font>
3
4 <font color=#FF0000><i>(* ***** BEGIN LICENSE BLOCK *****</i></font>
5 <font color=#FF0000><i> * Version: MPL 1.1</i></font>
6 <font color=#FF0000><i> *</i></font>
7 <font color=#FF0000><i> * The contents of this file are subject to the Mozilla Public License Version</i></font>
8 <font color=#FF0000><i> * 1.1 (the &quot;License&quot;); you may not use this file except in compliance with</i></font>
9 <font color=#FF0000><i> * the License. You may obtain a copy of the License at</i></font>
10 <font color=#FF0000><i> * http://www.mozilla.org/MPL/</i></font>
11 <font color=#FF0000><i> *</i></font>
12 <font color=#FF0000><i> * Software distributed under the License is distributed on an &quot;AS IS&quot; basis,</i></font>
13 <font color=#FF0000><i> * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License</i></font>
14 <font color=#FF0000><i> * for the specific language governing rights and limitations under the</i></font>
15 <font color=#FF0000><i> * License.</i></font>
16 <font color=#FF0000><i> *</i></font>
17 <font color=#FF0000><i> * The Original Code is TurboPower SysTools</i></font>
18 <font color=#FF0000><i> *</i></font>
19 <font color=#FF0000><i> * The Initial Developer of the Original Code is</i></font>
20 <font color=#FF0000><i> * TurboPower Software</i></font>
21 <font color=#FF0000><i> *</i></font>
22 <font color=#FF0000><i> * Portions created by the Initial Developer are Copyright (C) 1996-2002</i></font>
23 <font color=#FF0000><i> * the Initial Developer. All Rights Reserved.</i></font>
24 <font color=#FF0000><i> *</i></font>
25 <font color=#FF0000><i> * Contributor(s):</i></font>
26 <font color=#FF0000><i> *</i></font>
27 <font color=#FF0000><i> * ***** END LICENSE BLOCK ***** *)</i></font>
28
29 <font color=#FF0000><i>{*********************************************************}</i></font>
30 <font color=#FF0000><i>{* SysTools: StToHTML.pas 4.03 *}</i></font>
31 <font color=#FF0000><i>{*********************************************************}</i></font>
32 <font color=#FF0000><i>{* SysTools: HTML Text Formatter *}</i></font>
33 <font color=#FF0000><i>{*********************************************************}</i></font>
34
35 <font color=#FF0000><i>{$I StDefine.inc}</i></font>
36
37 <B>unit</B> StToHTML;
38
39 <B>interface</B>
40
41 <B>uses</B>
42 SysUtils, Windows,
43 Messages, Classes, Graphics, Controls,
44 Forms, Dialogs, StStrms, StBase;
45
46 <B>type</B>
47 TStOnProgressEvent = <B>procedure</B>(Sender : TObject; Percent : Word) <B>of</B> <B>object</B>;
48
49 TStStreamToHTML = <B>class</B>(TObject)
50 <B>protected</B> <font color=#FF0000><i>{private}</i></font>
51 <font color=#FF0000><i>{ Private declarations }</i></font>
52 FCaseSensitive : Boolean;
53 FCommentMarkers : TStringList;
54 FEmbeddedHTML : TStringList;
55 FInFileSize : Cardinal;
56 FInFixedLineLen : integer;
57 FInLineTermChar : Char;
58 FInLineTerminator: TStLineTerminator;
59 FInputStream : TStream;
60 FInSize : Cardinal;
61 FInTextStream : TStAnsiTextStream;
62 FIsCaseSensitive : Boolean;
63 FKeywords : TStringList;
64 FOnProgress : TStOnProgressEvent;
65 FOutputStream : TStream;
66 FOutTextStream : TStAnsiTextStream;
67 FPageFooter : TStringList;
68 FPageHeader : TStringList;
69 FStringMarkers : TStringList;
70 FWordDelims : <B>String</B>;
71 <B>protected</B>
72 <font color=#FF0000><i>{ Protected declarations }</i></font>
73
74 <font color=#FF0000><i>{internal methods}</i></font>
75 <B>function</B> ParseBuffer : Boolean;
76
77 <B>procedure</B> SetCommentMarkers(Value : TStringList);
78 <B>procedure</B> SetEmbeddedHTML(Value : TStringList);
79 <B>procedure</B> SetKeywords(Value : TStringList);
80 <B>procedure</B> SetPageFooter(Value : TStringList);
81 <B>procedure</B> SetPageHeader(Value : TStringList);
82 <B>procedure</B> SetStringMarkers(Value : TStringList);
83
84 <B>public</B>
85 <font color=#FF0000><i>{ Public declarations }</i></font>
86
87 <B>property</B> CaseSensitive : Boolean
88 read FCaseSensitive
89 write FCaseSensitive;
90
91 <B>property</B> CommentMarkers : TStringList
92 read FCommentMarkers
93 write SetCommentMarkers;
94
95 <B>property</B> EmbeddedHTML : TStringList
96 read FEmbeddedHTML
97 write SetEmbeddedHTML;
98
99 <B>property</B> InFixedLineLength : integer
100 read FInFixedLineLen
101 write FInFixedLineLen;
102
103 <B>property</B> InLineTermChar : Char
104 read FInLineTermChar
105 write FInLineTermChar;
106
107 <B>property</B> InLineTerminator : TStLineTerminator
108 read FInLineTerminator
109 write FInLineTerminator;
110
111 <B>property</B> InputStream : TStream
112 read FInputStream
113 write FInputStream;
114
115 <B>property</B> Keywords : TStringList
116 read FKeywords
117 write SetKeywords;
118
119 <B>property</B> OnProgress : TStOnProgressEvent
120 read FOnProgress
121 write FOnProgress;
122
123 <B>property</B> OutputStream : TStream
124 read FOutputStream
125 write FOutputStream;
126
127 <B>property</B> PageFooter : TStringList
128 read FPageFooter
129 write SetPageFooter;
130
131 <B>property</B> PageHeader : TStringList
132 read FPageHeader
133 write SetPageHeader;
134
135 <B>property</B> StringMarkers : TStringList
136 read FStringMarkers
137 write SetStringMarkers;
138
139 <B>property</B> WordDelimiters : <B>String</B>
140 read FWordDelims
141 write FWordDelims;
142
143
144 <B>constructor</B> Create;
145 <B>destructor</B> Destroy; override;
146
147 <B>procedure</B> GenerateHTML;
148 <B>end</B>;
149
150
151 TStFileToHTML = <B>class</B>(TStComponent)
152 <B>protected</B> <font color=#FF0000><i>{private}</i></font>
153 <font color=#FF0000><i>{ Private declarations }</i></font>
154
155 FCaseSensitive : Boolean;
156 FCommentMarkers : TStringList;
157 FEmbeddedHTML : TStringList;
158 FInFile : TFileStream;
159 FInFileName : <B>String</B>;
160 FInLineLength : integer;
161 FInLineTermChar : Char;
162 FInLineTerminator : TStLineTerminator;
163 FKeywords : TStringList;
164 FOnProgress : TStOnProgressEvent;
165 FOutFile : TFileStream;
166 FOutFileName : <B>String</B>;
167 FPageFooter : TStringList;
168 FPageHeader : TStringList;
169 FStream : TStStreamToHTML;
170 FStringMarkers : TStringList;
171 FWordDelims : <B>String</B>;
172
173 <B>protected</B>
174
175 <B>procedure</B> SetCommentMarkers(Value : TStringList);
176 <B>procedure</B> SetEmbeddedHTML(Value : TStringList);
177 <B>procedure</B> SetKeywords(Value : TStringList);
178 <B>procedure</B> SetPageFooter(Value : TStringList);
179 <B>procedure</B> SetPageHeader(Value : TStringList);
180 <B>procedure</B> SetStringMarkers(Value : TStringList);
181
182 <B>public</B>
183 <B>constructor</B> Create(AOwner : TComponent); override;
184 <B>destructor</B> Destroy; override;
185
186 <B>procedure</B> Execute;
187
188 published
189 <B>property</B> CaseSensitive : Boolean
190 read FCaseSensitive
191 write FCaseSensitive default False;
192
193 <B>property</B> CommentMarkers : TStringList
194 read FCommentMarkers
195 write SetCommentMarkers;
196
197 <B>property</B> EmbeddedHTML : TStringList
198 read FEmbeddedHTML
199 write SetEmbeddedHTML;
200
201 <B>property</B> InFileName : <B>String</B>
202 read FInFileName
203 write FInFileName;
204
205 <B>property</B> InFixedLineLength : integer
206 read FInLineLength
207 write FInLineLength default 80;
208
209 <B>property</B> InLineTermChar : Char
210 read FInLineTermChar
211 write FInLineTermChar default #10;
212
213 <B>property</B> InLineTerminator : TStLineTerminator
214 read FInLineTerminator
215 write FInLineTerminator default ltCRLF;
216
217 <B>property</B> Keywords : TStringList
218 read FKeywords
219 write SetKeywords;
220
221 <B>property</B> OnProgress : TStOnProgressEvent
222 read FOnProgress
223 write FOnProgress;
224
225 <B>property</B> OutFileName : <B>String</B>
226 read FOutFileName
227 write FOutFileName;
228
229 <B>property</B> PageFooter : TStringList
230 read FPageFooter
231 write SetPageFooter;
232
233 <B>property</B> PageHeader : TStringList
234 read FPageHeader
235 write SetPageHeader;
236
237 <B>property</B> StringMarkers : TStringList
238 read FStringMarkers
239 write SetStringMarkers;
240
241 <B>property</B> WordDelimiters : <B>String</B>
242 read FWordDelims
243 write FWordDelims;
244 <B>end</B>;
245
246 <B>implementation</B>
247
248
249 <B>uses</B>
250 StConst,
251 StDict;
252
253
254 <font color=#FF0000><i>(*****************************************************************************)</i></font>
255 <font color=#FF0000><i>(* TStStreamToHTML Implementation *)</i></font>
256 <font color=#FF0000><i>(*****************************************************************************)</i></font>
257
258 <B>constructor</B> TStStreamToHTML.Create;
259 <B>begin</B>
260 <B>inherited</B> Create;
261
262 FCommentMarkers := TStringList.Create;
263 FEmbeddedHTML := TStringList.Create;
264 FKeywords := TStringList.Create;
265 FPageFooter := TStringList.Create;
266 FPageHeader := TStringList.Create;
267 FStringMarkers := TStringList.Create;
268
269 FInputStream := <B>nil</B>;
270 FOutputStream := <B>nil</B>;
271
272 FInFileSize := 0;
273 FWordDelims := <font color=#0000FF>',; .()'</font>;
274
275 FInLineTerminator := ltCRLF; <font color=#FF0000><i>{normal Windows text file terminator}</i></font>
276 FInLineTermChar := #10;
277 FInFixedLineLen := 80;
278
279 <B>with</B> FEmbeddedHTML <B>do</B> <B>begin</B>
280 Add(<font color=#0000FF>'&quot;=&amp;quot;'</font>);
281 Add(<font color=#0000FF>'&amp;=&amp;amp;'</font>);
282 Add(<font color=#0000FF>'&lt;=&amp;lt;'</font>);
283 Add(<font color=#0000FF>'&gt;=&amp;gt;'</font>);
284 Add(<font color=#0000FF>'&iexcl;=&amp;iexcl;'</font>);
285 Add(<font color=#0000FF>'&cent;=&amp;cent;'</font>);
286 Add(<font color=#0000FF>'&pound;=&amp;pound;'</font>);
287 Add(<font color=#0000FF>'&copy;=&amp;copy;'</font>);
288 Add(<font color=#0000FF>'&reg;=&amp;reg;'</font>);
289 Add(<font color=#0000FF>'&plusmn;=&amp;plusmn;'</font>);
290 Add(<font color=#0000FF>'&frac14;=&amp;frac14;'</font>);
291 Add(<font color=#0000FF>'&frac12;=&amp;frac12;'</font>);
292 Add(<font color=#0000FF>'&frac34;=&amp;frac34;'</font>);
293 Add(<font color=#0000FF>'&divide;=&amp;divide;'</font>);
294 <B>end</B>;
295 <B>end</B>;
296
297
298 <B>destructor</B> TStStreamToHTML.Destroy;
299 <B>begin</B>
300 FCommentMarkers.Free;
301 FCommentMarkers := <B>nil</B>;
302
303 FEmbeddedHTML.Free;
304 FEmbeddedHTML := <B>nil</B>;
305
306 FKeywords.Free;
307 FKeywords := <B>nil</B>;
308
309 FPageFooter.Free;
310 FPageFooter := <B>nil</B>;
311
312 FPageHeader.Free;
313 FPageHeader := <B>nil</B>;
314
315 FStringMarkers.Free;
316 FStringMarkers := <B>nil</B>;
317
318 FInTextStream.Free;
319 FInTextStream := <B>nil</B>;
320
321 FOutTextStream.Free;
322 FOutTextStream := <B>nil</B>;
323
324 <B>inherited</B> Destroy;
325 <B>end</B>;
326
327
328 <B>procedure</B> TStStreamToHTML.GenerateHTML;
329 <B>begin</B>
330 <B>if</B> <B>not</B> ((Assigned(FInputStream) <B>and</B> (Assigned(FOutputStream)))) <B>then</B>
331 RaiseStError(EStToHTMLError, stscBadStream)
332 <B>else</B>
333 ParseBuffer;
334 <B>end</B>;
335
336
337 <B>procedure</B> DisposeString(Data : Pointer); far;
338 <B>begin</B>
339 Dispose(PString(Data));
340 <B>end</B>;
341
342
343 <B>function</B> TStStreamToHTML.ParseBuffer : Boolean;
344 <B>var</B>
345 I, J,
346 P1,
347 P2,
348 BRead,
349 PC : Longint;
350 CloseStr,
351 SStr,
352 EStr,
353 S,
354 VS,
355 AStr,
356 TmpStr : <B>String</B>;
357 P : Pointer;
358 PS : PString;
359 CommentDict : TStDictionary;
360 HTMLDict : TStDictionary;
361 KeywordsDict : TStDictionary;
362 StringDict : TStDictionary;
363 CommentPend : Boolean;
364
365 <B>function</B> ConvertEmbeddedHTML(<B>const</B> Str2 : <B>String</B>) : <B>String</B>;
366 <B>var</B>
367 L,
368 J : Longint;
369 PH : Pointer;
370 <B>begin</B>
371 Result := <font color=#0000FF>''</font>;
372 <font color=#FF0000><i>{avoid memory reallocations}</i></font>
373 SetLength(Result, 1024);
374 J := 1;
375 <B>for</B> L := 1 <B>to</B> Length(Str2) <B>do</B> <B>begin</B>
376 <B>if</B> (<B>not</B> HTMLDict.Exists(Str2[L], PH)) <B>then</B> <B>begin</B>
377 Result[J] := Str2[L];
378 Inc(J);
379 <B>end</B> <B>else</B> <B>begin</B>
380 Move(<B>String</B>(PH^)[1], Result[J], Length(<B>String</B>(PH^)) * SizeOf(Char));
381 Inc(J, Length(<B>String</B>(PH^)));
382 <B>end</B>;
383 <B>end</B>;
384 Dec(J);
385 SetLength(Result, J);
386 <B>end</B>;
387
388 <B>procedure</B> CheckSubString(<B>const</B> Str1 : <B>String</B>);
389 <B>var</B>
390 S2 : <B>String</B>;
391 <B>begin</B>
392 <B>if</B> (KeywordsDict.Exists(Str1, P)) <B>then</B> <B>begin</B>
393 VS := <B>String</B>(P^);
394 S2 := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1)
395 + ConvertEmbeddedHTML(Str1)
396 + Copy(VS, pos(<font color=#0000FF>';'</font>, VS)+1, Length(VS));
397 <B>if</B> (P1 &gt;= Length(Str1)) <B>and</B> (P1 &lt;= Length(TmpStr)) <B>then</B>
398 S2 := S2 + ConvertEmbeddedHTML(TmpStr[P1]);
399 <B>end</B> <B>else</B> <B>begin</B>
400 S2 := ConvertEmbeddedHTML(Str1);
401 <B>if</B> (P1 &gt;= Length(Str1)) <B>and</B> (P1 &lt;= Length(TmpStr)) <B>then</B>
402 S2 := S2 + ConvertEmbeddedHTML(TmpStr[P1]);
403 <B>end</B>;
404 S := S + S2;
405 <B>end</B>;
406
407 <B>begin</B>
408 <B>if</B> (Length(FWordDelims) = 0) <B>then</B>
409 RaiseStError(EStToHTMLError, stscWordDelimiters);
410
411 <font color=#FF0000><i>{create Dictionaries for lookups}</i></font>
412 CommentDict := TStDictionary.Create(FCommentMarkers.Count+1);
413 KeywordsDict := TStDictionary.Create(FKeywords.Count+1);
414 HTMLDict := TStDictionary.Create(FEmbeddedHTML.Count+1);
415 StringDict := TStDictionary.Create(FStringMarkers.Count+1);
416
417 CommentDict.DisposeData := DisposeString;
418 KeywordsDict.DisposeData := DisposeString;
419 HTMLDict.DisposeData := DisposeString;
420 StringDict.DisposeData := DisposeString;
421
422 FInTextStream := TStAnsiTextStream.Create(FInputStream);
423 FInTextStream.LineTermChar := AnsiChar(FInLineTermChar);
424 FInTextStream.LineTerminator := FInLineTerminator;
425 FInTextStream.FixedLineLength := FInFixedLineLen;
426 FInFileSize := FInTextStream.Size;
427
428 FOutTextStream := TStAnsiTextStream.Create(FOutputStream);
429 FOutTextStream.LineTermChar := #10;
430 FOutTextStream.LineTerminator := ltCRLF;
431 FOutTextStream.FixedLineLength := 80;
432
433 FInLineTerminator := ltCRLF; <font color=#FF0000><i>{normal Windows text file terminator}</i></font>
434 FInLineTermChar := #10;
435 FInFixedLineLen := 80;
436
437 <B>try</B>
438 <B>if</B> (FCaseSensitive) <B>then</B> <B>begin</B>
439 CommentDict.Hash := AnsiHashStr;
440 CommentDict.Equal := AnsiCompareStr;
441 HTMLDict.Hash := AnsiHashStr;
442 HTMLDict.Equal := AnsiCompareStr;
443 KeywordsDict.Hash := AnsiHashStr;
444 KeywordsDict.Equal:= AnsiCompareStr;
445 StringDict.Hash := AnsiHashStr;
446 StringDict.Equal := AnsiCompareStr;
447 <B>end</B> <B>else</B> <B>begin</B>
448 CommentDict.Hash := AnsiHashText;
449 CommentDict.Equal := AnsiCompareText;
450 HTMLDict.Hash := AnsiHashText;
451 HTMLDict.Equal := AnsiCompareText;
452 KeywordsDict.Hash := AnsiHashText;
453 KeywordsDict.Equal:= AnsiCompareText;
454 StringDict.Hash := AnsiHashText;
455 StringDict.Equal := AnsiCompareText;
456 <B>end</B>;
457
458 <font color=#FF0000><i>{Add items from string lists to dictionaries}</i></font>
459 <B>for</B> I := 0 <B>to</B> pred(FKeywords.Count) <B>do</B> <B>begin</B>
460 <B>if</B> (Length(FKeywords[I]) = 0) <B>then</B>
461 continue;
462 <B>if</B> (pos(<font color=#0000FF>'='</font>, FKeywords[I]) &gt; 0) <B>then</B> <B>begin</B>
463 New(PS);
464 S := FKeywords.Names[I];
465 PS^ := FKeywords.Values[S];
466 <B>if</B> (<B>not</B> KeywordsDict.Exists(S, P)) <B>then</B>
467 KeywordsDict.Add(S, PS)
468 <B>else</B>
469 Dispose(PS);
470 <B>end</B> <B>else</B>
471 RaiseStError(EStToHTMLError, stscInvalidSLEntry);
472 <B>end</B>;
473
474 <B>for</B> I := 0 <B>to</B> pred(FStringMarkers.Count) <B>do</B> <B>begin</B>
475 <B>if</B> (Length(FStringMarkers[I]) = 0) <B>then</B>
476 continue;
477 <B>if</B> (pos(<font color=#0000FF>'='</font>, FStringMarkers[I]) &gt; 0) <B>then</B> <B>begin</B>
478 New(PS);
479 S := FStringMarkers.Names[I];
480 PS^ := FStringMarkers.Values[S];
481 <B>if</B> (<B>not</B> StringDict.Exists(S, P)) <B>then</B>
482 StringDict.Add(S, PS)
483 <B>else</B>
484 Dispose(PS);
485 <B>end</B> <B>else</B>
486 RaiseStError(EStToHTMLError, stscInvalidSLEntry);
487 <B>end</B>;
488
489 <B>for</B> I := 0 <B>to</B> pred(FCommentMarkers.Count) <B>do</B> <B>begin</B>
490 <B>if</B> (Length(FCommentMarkers[I]) = 0) <B>then</B>
491 continue;
492 <B>if</B> (pos(<font color=#0000FF>'='</font>, FCommentMarkers[I]) &gt; 0) <B>then</B> <B>begin</B>
493 New(PS);
494 S := FCommentMarkers.Names[I];
495 <B>if</B> (Length(S) = 1) <B>then</B>
496 PS^ := FCommentMarkers.Values[S]
497 <B>else</B> <B>begin</B>
498 PS^ := <font color=#0000FF>':1'</font> + S[2] + <font color=#0000FF>';'</font> + FCommentMarkers.Values[S];
499 S := S[1];
500 <B>end</B>;
501 <B>if</B> (<B>not</B> CommentDict.Exists(S, P)) <B>then</B>
502 CommentDict.Add(S, PS)
503 <B>else</B> <B>begin</B>
504 AStr := <B>String</B>(P^);
505 AStr := AStr + PS^;
506 <B>String</B>(P^) := AStr;
507 CommentDict.Update(S, P);
508 Dispose(PS);
509 <B>end</B>;
510 <B>end</B> <B>else</B>
511 RaiseStError(EStToHTMLError, stscInvalidSLEntry);
512 <B>end</B>;
513
514 <B>for</B> I := 0 <B>to</B> pred(FEmbeddedHTML.Count) <B>do</B> <B>begin</B>
515 <B>if</B> (pos(<font color=#0000FF>'='</font>, FEmbeddedHTML[I]) &gt; 0) <B>then</B> <B>begin</B>
516 New(PS);
517 S := FEmbeddedHTML.Names[I];
518 PS^ := FEmbeddedHTML.Values[S];
519 <B>if</B> (<B>not</B> HTMLDict.Exists(S, P)) <B>then</B>
520 HTMLDict.Add(S, PS)
521 <B>else</B>
522 Dispose(PS);
523 <B>end</B> <B>else</B>
524 RaiseStError(EStToHTMLError, stscInvalidSLEntry);
525 <B>end</B>;
526
527 BRead := 0;
528 <B>if</B> (FPageHeader.Count &gt; 0) <B>then</B> <B>begin</B>
529 <B>for</B> I := 0 <B>to</B> pred(FPageHeader.Count) <B>do</B>
530 FOutTextStream.WriteLine(FPageHeader[I]);
531 <B>end</B>;
532 FOutTextStream.WriteLine(<font color=#0000FF>'&lt;pre&gt;'</font>);
533 CommentPend := False;
534 AStr := <font color=#0000FF>''</font>;
535 SStr := <font color=#0000FF>''</font>;
536 EStr := <font color=#0000FF>''</font>;
537
538 <font color=#FF0000><i>{make sure buffer is at the start}</i></font>
539 FInTextStream.Position := 0;
540 <B>while</B> <B>not</B> FInTextStream.AtEndOfStream <B>do</B> <B>begin</B>
541 TmpStr := FInTextStream.ReadLine;
542 Inc(BRead, Length(TmpStr) + Length(FInTextStream.LineTermChar));
543 <B>if</B> (FInFileSize &gt; 0) <B>then</B> <B>begin</B>
544 PC := Round((BRead / FInFileSize * 100));
545 <B>if</B> (Assigned(FOnProgress)) <B>then</B>
546 FOnProgress(Self, PC);
547 <B>end</B>;
548
549 <B>if</B> (TmpStr = <font color=#0000FF>''</font>) <B>then</B> <B>begin</B>
550 <B>if</B> (CommentPend) <B>then</B>
551 FOutTextStream.WriteLine(EStr)
552 <B>else</B>
553 FOutTextStream.WriteLine(<font color=#0000FF>' '</font>);
554 continue;
555 <B>end</B>;
556
557 <B>if</B> (CommentPend) <B>then</B>
558 S := SStr
559 <B>else</B>
560 S := <font color=#0000FF>''</font>;
561
562 P1 := 1;
563 <B>repeat</B>
564 <B>if</B> (<B>not</B> CommentPend) <B>and</B> (CommentDict.Exists(TmpStr[P1], P)) <B>then</B> <B>begin</B>
565 VS := <B>String</B>(P^);
566 <B>if</B> (Copy(VS, 1 , 2) = <font color=#0000FF>':1'</font>) <B>then</B> <B>begin</B>
567 <B>while</B> (Copy(VS, 1 , 2) = <font color=#0000FF>':1'</font>) <B>do</B> <B>begin</B>
568 System.Delete(VS, 1, 2);
569 <B>if</B> (TmpStr[P1+1] = VS[1]) <B>then</B> <B>begin</B>
570 System.Delete(VS, 1, 2);
571 CloseStr := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1);
572 System.Delete(VS, 1, pos(<font color=#0000FF>';'</font>, VS));
573 SStr := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1);
574 System.Delete(VS, 1, pos(<font color=#0000FF>';'</font>, VS));
575 J := pos(<font color=#0000FF>':1'</font>, VS);
576 <B>if</B> (J = 0) <B>then</B>
577 EStr := Copy(VS, pos(<font color=#0000FF>';'</font>, VS)+1, Length(VS))
578 <B>else</B> <B>begin</B>
579 EStr := Copy(VS, 1, J-1);
580 System.Delete(VS, 1, J+2);
581 <B>end</B>;
582
583 <B>if</B> (CloseStr = <font color=#0000FF>''</font>) <B>then</B> <B>begin</B>
584 S := S + SStr;
585 AStr := Copy(TmpStr, P1, Length(TmpStr));
586 CheckSubString(AStr);
587 S := S + EStr;
588 CloseStr := <font color=#0000FF>''</font>;
589 SStr := <font color=#0000FF>''</font>;
590 EStr := <font color=#0000FF>''</font>;
591 TmpStr := <font color=#0000FF>''</font>;
592 continue;
593 <B>end</B> <B>else</B> <B>begin</B>
594 I := pos(CloseStr, TmpStr);
595 <B>if</B> (I = 0) <B>then</B> <B>begin</B>
596 CommentPend := True;
597 S := SStr + S;
598 <B>end</B> <B>else</B> <B>begin</B>
599 S := S + SStr;
600 AStr := Copy(TmpStr, P1, I-P1+Length(CloseStr));
601 CheckSubstring(AStr);
602 S := S + EStr;
603 System.Delete(TmpStr, P1, I-P1+Length(CloseStr));
604 <B>end</B>;
605 <B>end</B>;
606 <B>end</B> <B>else</B> <B>begin</B>
607 J := pos(<font color=#0000FF>':1'</font>, VS);
608 <B>if</B> (J &gt; 0) <B>then</B>
609 System.Delete(VS, 1, J-1);
610 <B>end</B>;
611 <B>end</B>;
612 <B>end</B> <B>else</B> <B>begin</B>
613 <font color=#FF0000><i>{is it really the beginning of a comment?}</i></font>
614 CloseStr := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1);
615 System.Delete(VS, 1, pos(<font color=#0000FF>';'</font>, VS));
616 SStr := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1);
617 EStr := Copy(VS, pos(<font color=#0000FF>';'</font>, VS)+1, Length(VS));
618 I := pos(CloseStr, TmpStr);
619 <B>if</B> (I &gt; 0) <B>and</B> (I &gt; P1) <B>then</B> <B>begin</B>
620 <font color=#FF0000><i>{ending marker found}</i></font>
621 CommentPend := False;
622 S := S + SStr;
623 AStr := Copy(TmpStr, P1, I-P1+Length(CloseStr));
624 CheckSubstring(AStr);
625 S := S + EStr;
626 System.Delete(TmpStr, P1, I-P1+Length(CloseStr));
627 P1 := 1;
628 CloseStr := <font color=#0000FF>''</font>;
629 SStr := <font color=#0000FF>''</font>;
630 EStr := <font color=#0000FF>''</font>;
631 <B>if</B> (TmpStr = <font color=#0000FF>''</font>) <B>then</B>
632 continue;
633 <B>end</B> <B>else</B> <B>begin</B> <font color=#FF0000><i>{1}</i></font>
634 CommentPend := True;
635 S := S + SStr;
636 <B>if</B> (Length(TmpStr) &gt; 1) <B>then</B> <B>begin</B>
637 AStr := Copy(TmpStr, P1, Length(TmpStr));
638 CheckSubstring(AStr);
639 <B>end</B> <B>else</B>
640 S := S + TmpStr;
641 S := S + EStr;
642 TmpStr := <font color=#0000FF>''</font>;
643 continue;
644 <B>end</B>;
645 <B>end</B>;
646 <B>end</B>;
647
648 <B>if</B> (CommentPend) <B>then</B> <B>begin</B>
649 I := pos(CloseStr, TmpStr);
650 <B>if</B> (I &lt; 1) <B>then</B> <B>begin</B>
651 AStr := Copy(TmpStr, P1, Length(TmpStr));
652 CheckSubstring(AStr);
653 S := S + EStr;
654 TmpStr := <font color=#0000FF>''</font>;
655 continue;
656 <B>end</B> <B>else</B> <B>begin</B> <font color=#FF0000><i>{2}</i></font>
657 CommentPend := False;
658 <B>if</B> (Length(TmpStr) &gt; 1) <B>then</B> <B>begin</B>
659 AStr := Copy(TmpStr, P1, I-P1+Length(CloseStr));
660 CheckSubstring(AStr);
661 <B>end</B> <B>else</B>
662 S := S + TmpStr;
663 S := S + EStr;
664 System.Delete(TmpStr, P1, I-P1+Length(CloseStr));
665 CloseStr := <font color=#0000FF>''</font>;
666 SStr := <font color=#0000FF>''</font>;
667 EStr := <font color=#0000FF>''</font>;
668 <B>if</B> (TmpStr = <font color=#0000FF>''</font>) <B>then</B>
669 continue
670 <B>else</B>
671 P1 := 1;
672 <B>end</B>;
673 <B>end</B> <B>else</B> <B>begin</B>
674 CloseStr := <font color=#0000FF>''</font>;
675 SStr := <font color=#0000FF>''</font>;
676 EStr := <font color=#0000FF>''</font>;
677 <B>end</B>;
678
679 <B>if</B> (TmpStr = <font color=#0000FF>''</font>) <B>then</B>
680 continue;
681
682 P := <B>nil</B>;
683 <B>while</B> (P1 &lt;= Length(TmpStr)) <B>and</B> (pos(TmpStr[P1], FWordDelims) = 0) <B>and</B>
684 (<B>not</B> StringDict.Exists(TmpStr[P1], P)) <B>do</B>
685 Inc(P1);
686 <B>if</B> (Assigned(P)) <B>then</B> <B>begin</B>
687 P2 := P1+1;
688 VS := <B>String</B>(P^);
689 CloseStr := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1);
690 System.Delete(VS, 1, pos(<font color=#0000FF>';'</font>, VS));
691 SStr := Copy(VS, 1, pos(<font color=#0000FF>';'</font>, VS)-1);
692 System.Delete(VS, 1, pos(<font color=#0000FF>';'</font>, VS));
693 EStr := Copy(VS, pos(<font color=#0000FF>';'</font>, VS)+1, Length(VS));
694
695 <B>while</B> (TmpStr[P2] &lt;&gt; CloseStr) <B>and</B> (P2 &lt;= Length(TmpStr)) <B>do</B>
696 Inc(P2);
697 S := S + SStr;
698 AStr := Copy(TmpStr, P1, P2-P1+1);
699 CheckSubString(AStr);
700 S := S + EStr;
701
702 System.Delete(TmpStr, P1, P2);
703 <B>if</B> (TmpStr = <font color=#0000FF>''</font>) <B>then</B>
704 continue
705 <B>else</B>
706 P1 := 1;
707 P := <B>nil</B>;
708 <B>end</B> <B>else</B> <B>if</B> (P1 &lt;= Length(TmpStr)) <B>and</B> (pos(TmpStr[P1], FWordDelims) &gt; 0) <B>then</B> <B>begin</B>
709 <B>if</B> (P1 = 1) <B>then</B> <B>begin</B>
710 S := S + ConvertEmbeddedHTML(TmpStr[1]);
711 System.Delete(TmpStr, 1, 1);
712 P1 := 1;
713 <B>end</B> <B>else</B> <B>begin</B>
714 AStr := Copy(TmpStr, 1, P1-1);
715 <B>if</B> (Length(AStr) &gt; 0) <B>then</B>
716 CheckSubstring(AStr);
717 System.Delete(TmpStr, 1, P1);
718 P1 := 1;
719 <B>end</B>;
720 <B>end</B> <B>else</B> <B>begin</B>
721 AStr := TmpStr;
722 CheckSubString(AStr);
723 TmpStr := <font color=#0000FF>''</font>;
724 <B>end</B>;
725 <B>until</B> (Length(TmpStr) = 0);
726 FOutTextStream.WriteLine(S);
727 <B>end</B>;
728 <B>if</B> (Assigned(FOnProgress)) <B>then</B>
729 FOnProgress(Self, 0);
730
731 Result := True;
732 FOutTextStream.WriteLine(<font color=#0000FF>'&lt;/pre&gt;'</font>);
733 <B>if</B> (FPageFooter.Count &gt; 0) <B>then</B> <B>begin</B>
734 <B>for</B> I := 0 <B>to</B> pred(FPageFooter.Count) <B>do</B>
735 FOutTextStream.WriteLine(FPageFooter[I]);
736 <B>end</B>;
737 <B>finally</B>
738 CommentDict.Free;
739 HTMLDict.Free;
740 KeywordsDict.Free;
741 StringDict.Free;
742
743 FInTextStream.Free;
744 FInTextStream := <B>nil</B>;
745
746 FOutTextStream.Free;
747 FOutTextStream := <B>nil</B>;
748 <B>end</B>;
749 <B>end</B>;
750
751
752 <B>procedure</B> TStStreamToHTML.SetCommentMarkers(Value : TStringList);
753 <B>begin</B>
754 FCommentMarkers.Assign(Value);
755 <B>end</B>;
756
757
758 <B>procedure</B> TStStreamToHTML.SetEmbeddedHTML(Value : TStringList);
759 <B>begin</B>
760 FEmbeddedHTML.Assign(Value);
761 <B>end</B>;
762
763
764 <B>procedure</B> TStStreamToHTML.SetKeywords(Value : TStringList);
765 <B>begin</B>
766 FKeywords.Assign(Value);
767 <B>end</B>;
768
769
770 <B>procedure</B> TStStreamToHTML.SetPageFooter(Value : TStringList);
771 <B>begin</B>
772 FPageFooter.Assign(Value);
773 <B>end</B>;
774
775
776 <B>procedure</B> TStStreamToHTML.SetPageHeader(Value : TStringList);
777 <B>begin</B>
778 FPageHeader.Assign(Value);
779 <B>end</B>;
780
781
782 <B>procedure</B> TStStreamToHTML.SetStringMarkers(Value : TStringList);
783 <B>begin</B>
784 FStringMarkers.Assign(Value);
785 <B>end</B>;
786
787
788
789 <font color=#FF0000><i>(*****************************************************************************)</i></font>
790 <font color=#FF0000><i>(* TStFileToHTML Implementation *)</i></font>
791 <font color=#FF0000><i>(*****************************************************************************)</i></font>
792
793
794 <B>constructor</B> TStFileToHTML.Create(AOwner : TComponent);
795 <B>begin</B>
796 <B>inherited</B> Create(AOwner);
797
798 FCommentMarkers := TStringList.Create;
799 FEmbeddedHTML := TStringList.Create;
800 FKeywords := TStringList.Create;
801 FPageFooter := TStringList.Create;
802 FPageHeader := TStringList.Create;
803 FStringMarkers := TStringList.Create;
804
805 FWordDelims := <font color=#0000FF>',; .()'</font>;
806
807 FInLineTerminator := ltCRLF;
808 FInLineTermChar := #10;
809 FInLineLength := 80;
810
811 <B>with</B> FEmbeddedHTML <B>do</B> <B>begin</B>
812 Add(<font color=#0000FF>'&quot;=&amp;quot;'</font>);
813 Add(<font color=#0000FF>'&amp;=&amp;amp;'</font>);
814 Add(<font color=#0000FF>'&lt;=&amp;lt;'</font>);
815 Add(<font color=#0000FF>'&gt;=&amp;gt;'</font>);
816 Add(<font color=#0000FF>'&iexcl;=&amp;iexcl;'</font>);
817 Add(<font color=#0000FF>'&cent;=&amp;cent;'</font>);
818 Add(<font color=#0000FF>'&pound;=&amp;pound;'</font>);
819 Add(<font color=#0000FF>'&copy;=&amp;copy;'</font>);
820 Add(<font color=#0000FF>'&reg;=&amp;reg;'</font>);
821 Add(<font color=#0000FF>'&plusmn;=&amp;plusmn;'</font>);
822 Add(<font color=#0000FF>'&frac14;=&amp;frac14;'</font>);
823 Add(<font color=#0000FF>'&frac12;=&amp;frac12;'</font>);
824 Add(<font color=#0000FF>'&frac34;=&amp;frac34;'</font>);
825 Add(<font color=#0000FF>'&divide;=&amp;divide;'</font>);
826 <B>end</B>;
827 <B>end</B>;
828
829
830 <B>destructor</B> TStFileToHTML.Destroy;
831 <B>begin</B>
832 FCommentMarkers.Free;
833 FCommentMarkers := <B>nil</B>;
834
835 FEmbeddedHTML.Free;
836 FEmbeddedHTML := <B>nil</B>;
837
838 FKeywords.Free;
839 FKeywords := <B>nil</B>;
840
841 FPageFooter.Free;
842 FPageFooter := <B>nil</B>;
843
844 FPageHeader.Free;
845 FPageHeader := <B>nil</B>;
846
847 FStringMarkers.Free;
848 FStringMarkers := <B>nil</B>;
849
850 FInFile.Free;
851 FInFile := <B>nil</B>;
852
853 FOutFile.Free;
854 FOutFile := <B>nil</B>;
855
856 FStream.Free;
857 FStream := <B>nil</B>;
858
859 <B>inherited</B> Destroy;
860 <B>end</B>;
861
862
863 <B>procedure</B> TStFileToHTML.Execute;
864 <B>begin</B>
865 FStream := TStStreamToHTML.Create;
866 <B>try</B>
867 <B>if</B> (FInFileName = <font color=#0000FF>''</font>) <B>then</B>
868 RaiseStError(EStToHTMLError, stscNoInputFile)
869 <B>else</B> <B>if</B> (FOutFileName = <font color=#0000FF>''</font>) <B>then</B>
870 RaiseStError(EStToHTMLError, stscNoOutputFile)
871 <B>else</B> <B>begin</B>
872 <B>if</B> (Assigned(FInFile)) <B>then</B>
873 FInFile.Free;
874 <B>try</B>
875 FInFile := TFileStream.Create(FInFileName, fmOpenRead <B>or</B> fmShareDenyWrite);
876 <B>except</B>
877 RaiseStError(EStToHTMLError, stscInFileError);
878 Exit;
879 <B>end</B>;
880
881 <B>if</B> (Assigned(FOutFile)) <B>then</B>
882 FOutFile.Free;
883 <B>try</B>
884 FOutFile := TFileStream.Create(FOutFileName, fmCreate);
885 <B>except</B>
886 RaiseStError(EStToHTMLError, stscOutFileError);
887 Exit;
888 <B>end</B>;
889
890 <B>try</B>
891 FStream.InputStream := FInFile;
892 FStream.OutputStream := FOutFile;
893 FStream.CaseSensitive := CaseSensitive;
894 FStream.CommentMarkers := CommentMarkers;
895 FStream.EmbeddedHTML := EmbeddedHTML;
896 FStream.InFixedLineLength := InFixedLineLength;
897 FStream.InLineTermChar := InLineTermChar;
898 FStream.InLineTerminator := InLineTerminator;
899 FStream.Keywords := Keywords;
900 FStream.OnProgress := OnProgress;
901 FStream.PageFooter := PageFooter;
902 FStream.PageHeader := PageHeader;
903 FStream.StringMarkers := StringMarkers;
904 FStream.WordDelimiters := WordDelimiters;
905
906 FStream.GenerateHTML;
907 <B>finally</B>
908 FInFile.Free;
909 FInFile := <B>nil</B>;
910 FOutFile.Free;
911 FOutFile := <B>nil</B>;
912 <B>end</B>;
913 <B>end</B>;
914 <B>finally</B>
915 FStream.Free;
916 FStream := <B>nil</B>;
917 <B>end</B>;
918 <B>end</B>;
919
920
921 <B>procedure</B> TStFileToHTML.SetCommentMarkers(Value : TStringList);
922 <B>begin</B>
923 FCommentMarkers.Assign(Value);
924 <B>end</B>;
925
926
927 <B>procedure</B> TStFileToHTML.SetEmbeddedHTML(Value : TStringList);
928 <B>begin</B>
929 FEmbeddedHTML.Assign(Value);
930 <B>end</B>;
931
932
933
934 <B>procedure</B> TStFileToHTML.SetKeywords(Value : TStringList);
935 <B>begin</B>
936 FKeywords.Assign(Value);
937 <B>end</B>;
938
939
940 <B>procedure</B> TStFileToHTML.SetPageFooter(Value : TStringList);
941 <B>begin</B>
942 FPageFooter.Assign(Value);
943 <B>end</B>;
944
945
946 <B>procedure</B> TStFileToHTML.SetPageHeader(Value : TStringList);
947 <B>begin</B>
948 FPageHeader.Assign(Value);
949 <B>end</B>;
950
951
952 <B>procedure</B> TStFileToHTML.SetStringMarkers(Value : TStringList);
953 <B>begin</B>
954 FStringMarkers.Assign(Value);
955 <B>end</B>;
956
957
958 <B>end</B>.
959 </pre>

  ViewVC Help
Powered by ViewVC 1.1.20