Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/HTMLCreate.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4.2.9 - (hide annotations) (download) (as text)
Thu Nov 3 05:13:23 2005 UTC (18 years, 5 months ago) by h677
Branch: Bdraw
Changes since 1.4.2.8: +9 -3 lines
File MIME type: text/x-pascal
カンマの連続に対応

1 h677 1.1 unit HTMLCreate;
2    
3     interface
4    
5     uses
6     Windows, Messages, SysUtils, Classes, {Graphics,} Controls, {Forms,}
7 h677 1.4.2.1 ComCtrls, IniFiles, ShellAPI, Math, GikoSystem, ActiveX,
8 h677 1.1 {$IF Defined(DELPRO) }
9     SHDocVw,
10     MSHTML,
11     {$ELSE}
12     SHDocVw_TLB,
13     MSHTML_TLB,
14     {$IFEND}
15     {HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,}
16     {bmRegExp,} AbonUnit, MojuUtils, Setting,
17     ExternalBoardManager, ExternalBoardPlugInMain{,}
18     {Sort,} ,GikoBayesian;
19    
20     type
21     THTMLCreate = class(TObject)
22     private
23     { Private ?辿?転 }
24 h677 1.4 anchorLen : Integer;
25     pURLCHARs,pURLCHARe : PChar;
26     pANCHORs, pANCHORe : PChar;
27     pCTAGLs, pCTAGLe : PChar;
28     pCTAGUs, pCTAGUe : PChar;
29     pREF_MARKSs : array[0..9] of PChar;
30     pREF_MARKSe : array[0..9] of PChar;
31     constructor Create;
32    
33 h677 1.1 function AddBeProfileLink(AID : string; ANum: Integer):string ;
34 h677 1.4.2.1 procedure CreateUsePluginHTML(html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
35     procedure CreateUseSKINHTML(html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
36     procedure CreateUseCSSHTML(html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
37     procedure CreateDefaultHTML (html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
38 h677 1.2 function ConvertResAnchor(res: string): string;
39 h677 1.4.2.5 procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
40 h677 1.1 public
41     { Public ?辿?転 }
42 h677 1.4 function AddAnchorTag(s: string): string;
43 h677 1.2 function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;
44     function SkinedRes(skin: string; Res: TResRec; No: string): string;
45     function ConvRes(const Body, Bbs, Key, ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;
46 h677 1.4.2.1 procedure CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);
47 h677 1.2 procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
48 h677 1.1 end;
49    
50     var
51     HTMLCreater: THTMLCreate;
52    
53     implementation
54    
55 h677 1.4 const
56     URL_CHAR: string = '0123456789'
57     + 'abcdefghijklmnopqrstuvwxyz'
58     + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
59     + '#$%&()*+,-./:;=?@[]^_`{|}~!''\';
60     ANCHOR_REF = 'href=';
61     CLOSE_TAGAL = '</a>';
62     CLOSE_TAGAU = '</A>';
63     RES_REF = '&gt;&gt;';
64     REF_MARK: array[0..9] of string = ('http://', 'ttp://', 'tp://',
65     'ms-help://','p://', 'https://',
66     'www.', 'ftp://','news://','rtsp://');
67    
68     constructor THTMLCreate.Create;
69     var
70     j : Integer;
71     begin
72     // + 3 ?? 'href="' ('"'???鼎)???????o???G?[?V???????]?T???????邸?辿????
73     anchorLen := Length( ANCHOR_REF ) + 3;
74     pANCHORs := PChar(ANCHOR_REF);
75     pANCHORe := pANCHORs + Length(ANCHOR_REF);
76     pURLCHARs := PChar(URL_CHAR);
77     pURLCHARe := pURLCHARs + Length(URL_CHAR);
78     pCTAGLs := PChar(CLOSE_TAGAL);
79     pCTAGLe := pCTAGLs + 4;
80     pCTAGUs := PChar(CLOSE_TAGAU);
81     pCTAGUe := pCTAGUs + 4;
82     for j := 0 to 9 do begin
83     pREF_MARKSs[j] := PChar(REF_MARK[j]);
84     pREF_MARKSe[j] := pREF_MARKSs[j] + Length(REF_MARK[j]);
85     end;
86     end;
87 h677 1.1 // ?X?L?????????????A?l???u?????辿
88     function THTMLCreate.LoadFromSkin(
89     fileName: string;
90     ThreadItem: TThreadItem;
91     SizeByte: Integer
92     ): string;
93     var
94     Skin: TStringList;
95     begin
96    
97     Skin := TStringList.Create;
98     try
99     if FileExists( fileName ) then begin
100     Skin.LoadFromFile( fileName );
101    
102     // ?但???????????直???纏???A?I?v?V?????_?C?A???O???v???r???[?p try
103     try
104     if ThreadItem.ParentBoard <> nil then
105     if ThreadItem.ParentBoard.ParentCategory <> nil then
106     CustomStringReplace( Skin, '<BBSNAME/>', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
107     CustomStringReplace( Skin, '<THREADURL/>', ThreadItem.URL);
108     except end;
109     CustomStringReplace( Skin, '<BOARDNAME/>', ThreadItem.ParentBoard.Title);
110     CustomStringReplace( Skin, '<BOARDURL/>', ThreadItem.ParentBoard.URL);
111     CustomStringReplace( Skin, '<THREADNAME/>', ThreadItem.Title);
112     CustomStringReplace( Skin, '<SKINPATH/>', GikoSys.Setting.CSSFileName);
113     CustomStringReplace( Skin, '<GETRESCOUNT/>', IntToStr( ThreadItem.Count - ThreadItem.NewResCount ));
114     CustomStringReplace( Skin, '<NEWRESCOUNT/>', IntToStr( ThreadItem.NewResCount ));
115     CustomStringReplace( Skin, '<ALLRESCOUNT/>', IntToStr( ThreadItem.Count ));
116    
117     CustomStringReplace( Skin, '<NEWDATE/>',FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
118     CustomStringReplace( Skin, '<SIZEKB/>', IntToStr( Floor( SizeByte / 1024 ) ));
119     CustomStringReplace( Skin, '<SIZE/>', IntToStr( SizeByte ));
120    
121 h677 1.4.2.1
122 h677 1.1 //----- ?????????存???甜???`?直?叩?????p?B?R?????g?A?E?g?直???????直
123 h677 1.4.2.1 if GikoSys.Setting.UseKatjushaType then begin
124     // ?但???????????直???纏???A?I?v?V?????_?C?A???O???v???r???[?p try
125     try
126     if ThreadItem.ParentBoard <> nil then
127     if ThreadItem.ParentBoard.ParentCategory <> nil then
128     CustomStringReplace( Skin, '&BBSNAME', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
129     CustomStringReplace( Skin, '&THREADURL', ThreadItem.URL);
130     except end;
131     CustomStringReplace( Skin, '&BOARDNAME', ThreadItem.ParentBoard.Title);
132     CustomStringReplace( Skin, '&BOARDURL', ThreadItem.ParentBoard.URL);
133     CustomStringReplace( Skin, '&THREADNAME', ThreadItem.Title);
134     CustomStringReplace( Skin, '&SKINPATH', GikoSys.Setting.CSSFileName);
135     CustomStringReplace( Skin, '&GETRESCOUNT', IntToStr( ThreadItem.NewReceive - 1 ));
136     CustomStringReplace( Skin, '&NEWRESCOUNT', IntToStr( ThreadItem.NewResCount ));
137     CustomStringReplace( Skin, '&ALLRESCOUNT', IntToStr( ThreadItem.AllResCount ));
138    
139     CustomStringReplace( Skin, '&NEWDATE', FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
140     CustomStringReplace( Skin, '&SIZEKB', IntToStr( Floor( SizeByte / 1024 ) ));
141     CustomStringReplace( Skin, '&SIZE', IntToStr( SizeByte ));
142     //----- ???????長
143     end;
144 h677 1.1 end;
145     Result := Skin.Text;
146     finally
147     Skin.Free;
148     end;
149     end;
150    
151     // ???X???l???u?????辿
152     function THTMLCreate.SkinedRes(
153     skin: string;
154     Res: TResRec;
155     No: string
156     ): string;
157     var
158     spamminess : Extended;
159     wordCount : TWordCount;
160     begin
161    
162     wordCount := TWordCount.Create;
163     try
164     spamminess := Floor( GikoSys.SpamParse(
165     Res.FName + '<>' + Res.FMailTo + '<>' + Res.FBody, wordCount ) * 100 );
166    
167     Skin := CustomStringReplace( Skin, '<NUMBER/>',
168     '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
169     Skin := CustomStringReplace( Skin, '<PLAINNUMBER/>', No);
170     Skin := CustomStringReplace( Skin, '<NAME/>', '<b>' + Res.FName + '</b>');
171     Skin := CustomStringReplace( Skin, '<MAILNAME/>',
172     '<a href="mailto:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>');
173     Skin := CustomStringReplace( Skin, '<MAIL/>', Res.FMailTo);
174     Skin := CustomStringReplace( Skin, '<DATE/>', Res.FDateTime);
175     Skin := CustomStringReplace( Skin, '<MESSAGE/>', Res.FBody);
176     Skin := CustomStringReplace( Skin, '<SPAMMINESS/>', FloatToStr( spamminess ) );
177     Skin := CustomStringReplace( Skin, '<NONSPAMMINESS/>', FloatToStr( 100 - spamminess ) );
178    
179     //----- ???甜???`?直?叩?????p?B?R?????g?A?E?g?直???????直
180 h677 1.4.2.1 if GikoSys.Setting.UseKatjushaType then begin
181     Skin := CustomStringReplace( Skin, '&NUMBER',
182     '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
183     Skin := CustomStringReplace( Skin, '&PLAINNUMBER', No);
184     Skin := CustomStringReplace( Skin, '&NAME', '<b>' + Res.FName + '</b>');
185     Skin := CustomStringReplace( Skin, '&MAILNAME',
186     '<a href="mailto:' + Res.FMailTo + '"><b>' + Res.FName + '</b></a>');
187     Skin := CustomStringReplace( Skin, '&MAIL', Res.FMailTo);
188     Skin := CustomStringReplace( Skin, '&DATE', Res.FDateTime);
189     Skin := CustomStringReplace( Skin, '&MESSAGE', Res.FBody);
190     Skin := CustomStringReplace( Skin, '&SPAMMINESS', FloatToStr( spamminess ) );
191     Skin := CustomStringReplace( Skin, '&NONSPAMMINESS', FloatToStr( 100 - spamminess ) );
192     end;
193 h677 1.1 //----- ???????長
194    
195     Result := Skin;
196     finally
197     wordCount.Free;
198     end;
199    
200     end;
201     (*************************************************************************
202     *http://??????????anchor?^?O?t?鼎?????辿?B
203     *************************************************************************)
204     function THTMLCreate.AddAnchorTag(s: string): string;
205     var
206     url: string;
207     href: string;
208     i, j, b: Integer;
209     tmp: Integer;
210     idx, idx2: Integer;
211 h677 1.4 pos : PChar;
212 h677 1.1 pp, pe : PChar;
213     begin
214     Result := '';
215 h677 1.4
216 h677 1.1 while True do begin
217     idx := MaxInt;
218     idx2 := MaxInt;
219 h677 1.4 pp := PChar(s);
220     pe := pp + Length(s);
221    
222 h677 1.1 for j := 0 to 9 do begin
223 h677 1.4 pos := AnsiStrPosEx(pp, pe, pREF_MARKSs[j], pREF_MARKSe[j]);
224     if pos <> nil then begin
225     tmp := pos - pp + 1;
226     idx := Min(tmp, idx);
227     if idx = tmp then idx2 := j; //?????}?[?N?長?????????????????徹??
228     end;
229 h677 1.1 end;
230 h677 1.4
231 h677 1.1 if idx = MaxInt then begin
232     //?????N?????????B
233     Result := Result + s;
234     Break;
235     end;
236    
237 h677 1.4 if (idx > 1) and (idx > anchorLen) and
238     (AnsiStrPosEx(pp + idx - 1 - anchorLen, pp + idx, pANCHORs, pANCHORe) <> nil) then begin
239 h677 1.1 //?哲???????N?^?O???????????辿???徹?????鼎?????V
240 h677 1.4 //</a></A>???T???A?店?????長???????巽???纏?????頂?????長????
241     pos := AnsiStrPosEx(pp + idx, pe, pCTAGLs, pCTAGLe);
242     if pos = nil then
243     pos := AnsiStrPosEx(pp + idx, pe, pCTAGUs, pCTAGUe);
244     if pos = nil then
245     b := Length(REF_MARK[idx2])
246     else
247     b := pos - pp + 1;
248 h677 1.1
249 h677 1.4 Result := Result + Copy(s, 1, idx + b);
250     Delete(s, 1, idx + b);
251 h677 1.1 Continue;
252     end;
253    
254     Result := Result + Copy(s, 1, idx - 1);
255     Delete(s, 1, idx - 1);
256     b := Length( s ) + 1;
257     pp := PChar(s);
258     for i := 1 to b do begin
259     pe := AnsiStrPosEx(pURLCHARs, pURLCHARe, pp, pp + 1);
260    
261     if pe = nil then begin
262     //URL???叩?????????足???I?????A?????????足???????B
263     url := Copy(s, 1, i - 1);
264     case idx2 of
265     1 : href := 'h' + url;
266     2 : href := 'ht' + url;
267     4 : href := 'htt' + url;
268     6 : href := 'http://' + url;
269     else
270     href := url;
271     end;
272    
273     Result := Result + '<a href="' + href + '" target="_blank">' + url + '</a>';
274     Delete(s, 1, i - 1);
275     Break;
276     end;
277     //???????i???辿?B
278     Inc(pp);
279     end;
280     end;
281     end;
282    
283     //?????AAID?F???徹?????辿?炭?tID???????AANum:???X?? AURL?F?泥???X???b?h??URL
284     function THTMLCreate.AddBeProfileLink(AID : string; ANum: Integer):string ;
285     var
286     p : integer;
287     BNum, BMark : string;
288     begin
289     p := AnsiPos('BE:', AnsiUpperCase(AID));
290     if p > 0 then begin
291     BNum := Copy(AID, p, Length(AID));
292     AID := Copy(AID, 1, p - 1);
293     p := AnsiPos('-', BNum);
294     if p > 0 then begin
295     BMark := '?' + Trim(Copy(BNum, p + 1, Length(BNum)));
296     BNum := Copy(BNum, 1, p - 1);
297     end;
298     BNum := Trim(BNum);
299     Result := AID + ' <a href="' + BNum + '/' + IntToStr(ANum)
300     + '" target=_blank>' + BMark + '</a>';
301     end else
302     Result := AID;
303     end;
304 h677 1.4.2.5 procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text, Separator: String);
305     var
306     p : Integer;
307     begin
308     p := Pos(Separator,Text);
309     if (p > 0 ) then begin
310     st := Copy(Text, 1, p - 1);
311     et := Copy(Text, p + Length(Separator), Length(Text));
312     end else begin
313     st := Text;
314     et := Text;
315     end;
316     end;
317    
318 h677 1.1 (*************************************************************************
319     *
320     * from HotZonu
321     *************************************************************************)
322     function THTMLCreate.ConvRes(const Body, Bbs, Key,
323     ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string;
324     DatToHTML: boolean = false): string;
325 h677 1.4.2.5 const
326     GT = '&gt;';
327     SN = '0123456789';
328     FORMAT_LINK = '<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">';
329     var
330     i : integer;
331     s : string;
332     sw: boolean;
333 h677 1.4.2.6 cm: boolean;
334 h677 1.4.2.5 No: string;
335     oc : string;
336     st, et: string;
337     pos, pmin : integer;
338     j : integer;
339     token : array[0..5] of string;
340     ch : string;
341     db : boolean;
342 h677 1.4.2.7 len : integer;
343 h677 1.4.2.8 rink : string;
344 h677 1.4.2.5 begin
345     //s ???{?????S???端???辿
346     s := Body;
347     //???????N???A
348     Result := '';
349     //???????徹?????????S
350     token[0] := GT + GT;
351     token[1] := GT;
352     token[2] := '????';
353     token[3] := '??';
354     token[4] := '<a ';
355     token[5] := '<A ';
356    
357     //
358 h677 1.4.2.7 while Length(s) > 2 do begin
359 h677 1.4.2.5 pmin := Length(s) + 1;
360 h677 1.4.2.7 i := Length(token);
361 h677 1.4.2.8 for j := 0 to 5 do begin
362 h677 1.4.2.5 pos := AnsiPos(token[j], s);
363     if pos <> 0 then begin
364     if pos < pmin then begin
365     //?????長?q?b?g?直?????徹??
366     i := j;
367     //?長?店?l???X?V
368     pmin := pos;
369     end;
370     end;
371     end;
372    
373     //?q?b?g?直?????????????????O???長???????R?s?[
374     Result := Result + Copy(s, 1, pmin - 1);
375     Delete(s, 1, pmin - 1);
376    
377 h677 1.4.2.7 if i = 6 then begin
378 h677 1.4.2.5 //?q?b?g???直
379     end else if (i = 4) or (i = 5) then begin
380     //'<a ' or '<A' ?長?q?b?g '</a>' or '</A>' ???長?R?s?[
381     pmin := AnsiPos('</a>' , s);
382     pos := AnsiPos('</A>' , s);
383     if (pmin <> 0) and (pos <> 0) then begin
384     if (pmin > pos) then begin
385     pmin := pos;
386     end;
387     end else if (pos <> 0) then begin
388     pmin := pos;
389     end;
390 h677 1.4.2.8 rink := Copy(s, 1, pmin + 3);
391     Result := Result + rink;
392 h677 1.4.2.5 Delete(s, 1, pmin + 3);
393 h677 1.4.2.8
394     pmin := Length(rink);
395     i := Length(token);
396     for j := 0 to 3 do begin
397     pos := AnsiPos(token[j], rink);
398     if pos <> 0 then begin
399     if pos < pmin then begin
400     //?????長?q?b?g?直?????徹??
401     i := j;
402     //?長?店?l???X?V
403     pmin := pos;
404     end;
405     end;
406     end;
407     // ???X?A???J?[???????????????巽,?????足?????A???J?[???直???直?造
408     if i <= 3 then begin
409     cm := false;
410     j := 1 ;
411     if (s[j] = ',') or (ZenToHan(Copy(s, j ,2)) = ',') then begin
412     cm := true;
413     db := false;
414     sw := false;
415 h677 1.4.2.9 if (ByteType(s, j) = mbSingleByte) then
416     Inc(j)
417     else
418     Inc(j, 2);
419 h677 1.4.2.8 No := '';
420     len := Length(s);
421     while cm do begin
422     while (j <= len) do begin
423     if (ByteType(s, j) = mbSingleByte) then begin
424     //1byte????
425     ch := s[j];
426     Inc(j);
427     db := false;
428     end else begin
429     //2byte????
430     ch := ZenToHan(Copy(s, j, 2));
431     Inc(j, 2);
432     db := true;
433     end;
434     if System.Pos(ch, SN) > 0 then begin
435     No := No + ch;
436     end else if (ch = '-') then begin
437     if sw then break;
438     if No = '' then cm := false;
439     No := No + ch;
440     sw := true;
441     end else begin
442     break;
443     end;
444     end;
445     //?I?[???長?s???????I?邸???`?F?b?N
446     if j <= len then begin
447     if db then j := j - 2
448     else j := j - 1;
449     end;
450     //?????????????????巽???????鼎
451     if No = '' then begin
452     Result := Result + Copy(s, 1, j - 1);
453     end else begin
454     separateNumber(st, et, No, '-');
455    
456     if not DatToHTML then begin
457     Result := Result + Format(FORMAT_LINK,
458     [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]);
459     end else begin
460     Result := Result + Format('<a href="#%s">', [st]);
461     end;
462     Result := Result + Copy(s, 1, j - 1) + '</a>';
463     end;
464     Delete(s, 1, j - 1);
465 h677 1.4.2.9 j := 1;
466 h677 1.4.2.8 if (s[j] = ',') or (ZenToHan(Copy(s, j ,2)) = ',') then begin
467     cm := true;
468 h677 1.4.2.9 if (ByteType(s, j) = mbSingleByte) then
469     Inc(j)
470     else
471     Inc(j, 2);
472 h677 1.4.2.8 No := '';
473     len := Length(s);
474     end else begin
475     cm := false;
476     end;
477     end;
478     end;
479     end;
480 h677 1.4.2.5 end else begin
481     //?????直?巽???????????p?^?[??
482     j := Length(token[i]) + 1;
483     oc := '';
484     No := '';
485     sw := false;
486 h677 1.4.2.6 db := false;
487 h677 1.4.2.7 len := Length(s);
488     while j <= len do begin
489 h677 1.4.2.5 if (ByteType(s, j) = mbSingleByte) then begin
490     //1byte????
491     ch := s[j];
492     Inc(j);
493     db := false;
494     end else begin
495     //2byte????
496     ch := ZenToHan(Copy(s, j, 2));
497     Inc(j, 2);
498     db := true;
499     end;
500    
501 h677 1.4.2.7 if System.Pos(ch, SN) > 0 then begin
502 h677 1.4.2.5 No := No + ch;
503     end else if (ch = '-') then begin
504     if sw then break;
505     if No = '' then break;
506 h677 1.4.2.8 No := No + ch;
507 h677 1.4.2.5 sw := true;
508     end else begin
509     break;
510     end;
511     end;
512     //?I?[???長?s???????I?邸???`?F?b?N
513 h677 1.4.2.7 if j <= len then begin
514 h677 1.4.2.5 if db then j := j - 2
515     else j := j - 1;
516     end;
517     //?????????????????巽???????鼎
518     if No = '' then begin
519     Result := Result + Copy(s, 1, j - 1);
520     end else begin
521     separateNumber(st, et, No, '-');
522    
523     if not DatToHTML then begin
524 h677 1.4.2.6 Result := Result + Format(FORMAT_LINK,
525 h677 1.4.2.7 [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]);
526 h677 1.4.2.5 end else begin
527 h677 1.4.2.7 Result := Result + Format('<a href="#%s">', [st]);
528 h677 1.4.2.5 end;
529 h677 1.4.2.7 Result := Result + Copy(s, 1, j - 1) + '</a>';
530 h677 1.4.2.5 end;
531     Delete(s, 1, j - 1);
532     end;
533     end;
534 h677 1.4.2.7 Result := Result + s;
535 h677 1.1 end;
536    
537 h677 1.2 function THTMLCreate.ConvertResAnchor(res: string): string;
538     const
539     _HEAD : string = '<a href="../';
540     _TAIL : string = ' target="_blank">';
541     _ST: string = '&st=';
542     _TO: string = '&to=';
543     _STA: string = '&START=';
544     _END: string = '&END=';
545     var
546     i, j, k: Integer;
547     tmp: string;
548     begin
549     Result := '';
550     i := AnsiPos(_HEAD, res);
551     while i <> 0 do begin
552     Result := Result + Copy(res, 1, i -1);
553     Delete(res, 1, i - 1);
554     j := AnsiPos(_TAIL, res);
555     if j = 0 then begin
556     Result := Result + res;
557     Exit;
558     end;
559     tmp := Copy(res, 1, j - 1);
560     Delete(res, 1, j + 16);
561     if (AnsiPos(_ST, tmp) <> 0) and (AnsiPos(_TO, tmp) <> 0) then begin
562     Delete(tmp, 1, AnsiPos(_ST, tmp) + 3);
563     Delete(tmp, AnsiPos(_TO, tmp), Length(tmp));
564     Result := Result + '<a href="#' + tmp + '">';
565     end else if (AnsiPos(_STA, tmp) <> 0) and (AnsiPos(_END, tmp) <> 0) then begin
566     Delete(tmp, 1, AnsiPos(_STA, tmp) + 6);
567     Delete(tmp, AnsiPos(_END, tmp), Length(tmp));
568     Result := Result + '<a href="#' + tmp + '">';
569     end else begin
570     k := LastDelimiter('/', tmp);
571     Delete(tmp, 1, k);
572     if AnsiPos('-', tmp) < AnsiPos('"', tmp) then
573     Delete(tmp, AnsiPos('-', tmp), Length(tmp))
574     else
575     Delete(tmp, AnsiPos('"', tmp), Length(tmp));
576    
577     Result := Result + '<a href="#' + tmp + '">';
578     end;
579     i := AnsiPos(_HEAD, res);
580     end;
581     Result := Result + res;
582    
583     end;
584    
585 h677 1.1 //Plugin?????p???辿Board???X???b?h??HTML?????店?直??doc?????鼎???鄭
586 h677 1.4.2.1 procedure THTMLCreate.CreateUsePluginHTML(html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
587 h677 1.1 var
588     i: integer;
589     NewReceiveNo: Integer;
590     boardPlugIn : TBoardPlugIn;
591     UserOptionalStyle: string;
592     begin
593     if ThreadItem <> nil then begin
594     if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
595     //===== ?v???O?C???????辿?\??
596     boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
597     NewReceiveNo := ThreadItem.NewReceive;
598     // ?t?H???g?但?T?C?Y??????
599     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
600 h677 1.4.2.1 html.BeginUpdate;
601 h677 1.1 try
602     // ?w?b?_
603 h677 1.4.2.1 html.Append( boardPlugIn.GetHeader( DWORD( threadItem ),
604     '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
605     html.Add('<p id="idSearch"></p>');
606 h677 1.1 for i := 0 to threadItem.Count - 1 do begin
607     // 1 ???K?存?\??
608     if i <> 0 then begin
609     // ?\????????????
610     case GikoSys.ResRange of
611     Ord( grrKoko ):
612     if ThreadItem.Kokomade > (i + 1) then
613     Continue;
614     Ord( grrNew ):
615     if NewReceiveNo > (i + 1) then
616     Continue;
617     10..65535:
618     if (threadItem.Count - i) > GikoSys.ResRange then
619     Continue;
620     end;
621     end;
622    
623     // ?V???}?[?N
624     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
625     try
626     if GikoSys.Setting.UseSkin then begin
627     if FileExists( GikoSys.GetSkinNewmarkFileName ) then
628 h677 1.4.2.1 html.Append( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
629 h677 1.1 else
630 h677 1.4.2.1 //doc.Write( '<a name="new"></a>' + #13#10 );
631     html.Append( '<a name="new"></a>' );
632 h677 1.1 end else if GikoSys.Setting.UseCSS then begin
633 h677 1.4.2.1 html.Append('<a name="new"></a><div class="new">?V?????X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
634 h677 1.1 end else begin
635 h677 1.4.2.1 html.Append('</dl>');
636     html.Append('<a name="new"></a>');
637     html.Append('<table width="100%" bgcolor="#3333CC" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#6666FF" valign="middle"><font size="-1" color="#ffffff"><b>?V?????X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
638     html.Append('<dl>');
639 h677 1.1 end;
640     except
641 h677 1.4.2.1 html.Append( '<a name="new"></a>');
642 h677 1.1 end;
643     end;
644    
645     // ???X
646 h677 1.4.2.1 html.Append( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) );
647 h677 1.1
648     if ThreadItem.Kokomade = (i + 1) then begin
649     // ???????長?????転
650     try
651     if GikoSys.Setting.UseSkin then begin
652     if FileExists( GikoSys.GetSkinBookmarkFileName ) then
653 h677 1.4.2.1 html.Append( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) )
654 h677 1.1 else
655 h677 1.4.2.1 html.Append( '<a name="koko"></a>' );
656 h677 1.1 end else if GikoSys.Setting.UseCSS then begin
657 h677 1.4.2.1 html.Append('<a name="koko"></a><div class="koko">?R?R???長?????転</div>' );
658 h677 1.1 end else begin
659 h677 1.4.2.1 html.Append('</dl>');
660     html.Append('<a name="koko"></a><table width="100%" bgcolor="#55AA55" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#77CC77" valign="middle"><font size="-1" color="#ffffff"><b>?R?R???長?????転</b></font></td></tr></table>');
661     html.Append('<dl>' );
662 h677 1.1 end;
663     except
664 h677 1.4.2.1 html.Append( '<a name="koko"></a>' );
665 h677 1.1 end;
666     end;
667     end;
668    
669    
670     // ?X?L??(?t?b?^)
671 h677 1.4.2.1 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
672 h677 1.1 finally
673 h677 1.4.2.1 html.EndUpdate;
674 h677 1.1 end;
675    
676     end;
677     end;
678     end;
679    
680    
681 h677 1.4.2.1 procedure THTMLCreate.CreateUseSKINHTML(html : TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
682 h677 1.1 var
683     i: integer;
684     No: string;
685     CSSFileName: string;
686     NewReceiveNo: Integer;
687     Res: TResRec;
688     UserOptionalStyle: string;
689     SkinHeader: string;
690     SkinNewRes: string;
691     SkinRes: string;
692     strTmp : string;
693 h677 1.4.2.7 threadKey : string;
694 h677 1.1 begin
695     if ThreadItem <> nil then begin
696     // ?X?L???g?p
697     if GikoSys.Setting.UseSkin then begin
698     NewReceiveNo := ThreadItem.NewReceive;
699     // ?t?H???g?但?T?C?Y??????
700     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
701     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
702 h677 1.4.2.7
703     threadKey := ChangeFileExt(ThreadItem.FileName, '');
704 h677 1.4.2.1 html.BeginUpdate;
705 h677 1.1 try
706 h677 1.4.2.1 //doc.charset := 'Shift_JIS';
707 h677 1.1
708     // ?X?L????????
709     try
710     SkinHeader := LoadFromSkin( GikoSys.GetSkinHeaderFileName, ThreadItem, ThreadItem.Size);
711     if Length( UserOptionalStyle ) > 0 then
712     SkinHeader := CustomStringReplace( SkinHeader, '</head>',
713     '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
714 h677 1.4.2.1 html.Append( SkinHeader);
715 h677 1.1 except
716     end;
717    
718     try
719     SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
720     except
721     end;
722    
723     try
724     SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
725     except
726     end;
727    
728 h677 1.4.2.1 html.Append('<p id="idSearch"></p>');
729     html.Append('<a name="top"></a>');
730 h677 1.1
731     for i := 0 to ReadList.Count - 1 do begin
732     // 1 ???K?存?\??
733     if i <> 0 then begin
734     // ?\????????????
735     case GikoSys.ResRange of
736     Ord( grrKoko ):
737     if ThreadItem.Kokomade > (i + 1) then
738     Continue;
739     Ord( grrNew ):
740     if NewReceiveNo > (i + 1) then
741     Continue;
742     10..65535:
743     if (threadItem.Count - i) > GikoSys.ResRange then
744     Continue;
745     end;
746     end;
747     // ?V???}?[?N
748     if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
749     try
750     if FileExists( GikoSys.GetSkinNewmarkFileName ) then
751 h677 1.4.2.1 html.Append( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) )
752 h677 1.1 else
753 h677 1.4.2.1 html.Append( '<a name="new"></a>' );
754 h677 1.1 except
755 h677 1.4.2.1 html.Append( '<a name="new"></a>' );
756 h677 1.1 end;
757     end;
758    
759     if (Trim(ReadList[i]) <> '') then begin
760     No := IntToStr(i + 1);
761    
762 h677 1.3 Res := DivideStrLine(ReadList[i]);
763 h677 1.4.2.7 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, threadKey, 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
764 h677 1.1 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
765    
766     try
767     if NewReceiveNo <= (i + 1) then
768     // ?V?????X
769 h677 1.4.2.7 strTmp := SkinedRes( SkinNewRes, Res, No )
770 h677 1.1 else
771     // ???鱈?????X
772 h677 1.4.2.7 strTmp := SkinedRes( SkinRes, Res, No );
773 h677 1.1
774 h677 1.4.2.1 html.Append( strTmp );
775 h677 1.1 except
776     end;
777     end;
778    
779     if ThreadItem.Kokomade = (i + 1) then begin
780     // ???????長?????転
781     try
782     if FileExists( GikoSys.GetSkinBookmarkFileName ) then
783 h677 1.4.2.1 html.Append( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) )
784 h677 1.1 else
785 h677 1.4.2.1 html.Append( '<a name="koko"></a>' );
786 h677 1.1 except
787 h677 1.4.2.1 html.Append( '<a name="koko"></a>' );
788 h677 1.1 end;
789     end;
790     end;
791    
792 h677 1.4.2.1 html.Append('<a name="bottom"></a>' );
793 h677 1.1 // ?X?L??(?t?b?^)
794     try
795 h677 1.4.2.1 html.Append( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
796 h677 1.1 except
797     end;
798     finally
799 h677 1.4.2.1 html.EndUpdate;
800 h677 1.1 end;
801     end;
802     end;
803     end;
804    
805 h677 1.4.2.1 procedure THTMLCreate.CreateUseCSSHTML(html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
806 h677 1.1 var
807     i: integer;
808     No: string;
809     CSSFileName: string;
810     NewReceiveNo: Integer;
811     Res: TResRec;
812     UserOptionalStyle: string;
813     begin
814     if ThreadItem <> nil then begin
815 h677 1.4.2.1 //doc.open;
816     html.BeginUpdate;
817 h677 1.1 try
818 h677 1.4.2.1 //doc.charset := 'Shift_JIS';
819 h677 1.1 NewReceiveNo := ThreadItem.NewReceive;
820     // ?t?H???g?但?T?C?Y??????
821     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
822     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
823     if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
824     //CSS?g?p
825 h677 1.4.2.1 html.Append('<html><head>');
826     html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
827     html.Append('<title>' + sTitle + '</title>');
828     html.Append('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
829 h677 1.1 if Length( UserOptionalStyle ) > 0 then
830 h677 1.4.2.1 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
831     html.Append('</head>');
832     html.Append('<body>');
833     html.Append('<a name="top"></a>');
834     html.Append('<p id="idSearch"></p>');
835     html.Append('<div class="title">' + sTitle + '</div>');
836 h677 1.1 for i := 0 to ReadList.Count - 1 do begin
837     // 1 ???K?存?\??
838     if i <> 0 then begin
839     // ?\????????????
840     case GikoSys.ResRange of
841     Ord( grrKoko ):
842     if ThreadItem.Kokomade > (i + 1) then
843     Continue;
844     Ord( grrNew ):
845     if NewReceiveNo > (i + 1) then
846     Continue;
847     10..65535:
848     if (threadItem.Count - i) > GikoSys.ResRange then
849     Continue;
850     end;
851     end;
852    
853     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
854 h677 1.4.2.1 html.Append('<a name="new"></a><div class="new">?V?????X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
855 h677 1.1 end;
856    
857     if (Trim(ReadList[i]) <> '') then begin
858     No := IntToStr(i + 1);
859 h677 1.3 Res := DivideStrLine(ReadList[i]);
860 h677 1.1 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
861     Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
862     if Res.FMailTo = '' then
863 h677 1.4.2.1 html.Append('<a name="' + No + '"></a>'
864 h677 1.1 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
865     + '<span class="name_label">?添?O?F</span> '
866     + '<span class="name"><b>' + Res.FName + '</b></span> '
867     + '<span class="date_label">???e?炭?F</span> '
868     + '<span class="date">' + Res.FDateTime+ '</span></div>'
869 h677 1.4.2.1 + '<div class="mes">' + Res.FBody + ' </div>')
870 h677 1.1 else if GikoSys.Setting.ShowMail then
871 h677 1.4.2.1 html.Append('<a name="' + No + '"></a>'
872 h677 1.1 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
873     + '<span class="name_label"> ?添?O?F </span>'
874     + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
875     + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
876     + '<span class="date_label"> ???e?炭?F</span>'
877     + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
878 h677 1.4.2.1 + '<div class="mes">' + Res.FBody + ' </div>')
879 h677 1.1 else
880 h677 1.4.2.1 html.Append('<a name="' + No + '"></a>'
881 h677 1.1 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
882     + '<span class="name_label"> ?添?O?F </span>'
883     + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
884     + '<b>' + Res.FName + '</b></a>'
885     + '<span class="date_label"> ???e?炭?F</span>'
886     + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
887 h677 1.4.2.1 + '<div class="mes">' + Res.FBody + ' </div>');
888 h677 1.1 end;
889    
890     if ThreadItem.Kokomade = (i + 1) then begin
891 h677 1.4.2.1 html.Append('<a name="koko"></a><div class="koko">?R?R???長?????転</div>');
892 h677 1.1 end;
893    
894     end;
895    
896 h677 1.4.2.1 html.Append('<a name="bottom"></a>');
897     html.Append('<a name="last"></a>');
898     html.Append('</body></html>');
899 h677 1.1 end;
900     finally
901 h677 1.4.2.1 html.EndUpdate;
902     //doc.Close;
903 h677 1.1 end;
904     end;
905     end;
906    
907 h677 1.4.2.1 procedure THTMLCreate.CreateDefaultHTML (html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
908 h677 1.1 var
909     i: integer;
910     No: string;
911     NewReceiveNo: Integer;
912     Res: TResRec;
913     begin
914     if ThreadItem <> nil then begin
915 h677 1.4.2.1 //doc.open;
916     html.BeginUpdate;
917 h677 1.1 try
918 h677 1.4.2.1 //doc.charset := 'Shift_JIS';
919 h677 1.1 NewReceiveNo := ThreadItem.NewReceive;
920 h677 1.4.2.1 html.Append('<html><head>');
921     html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
922     html.Append('<title>' + sTitle + '</title></head>');
923     html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
924     html.Append('<a name="top"></a>');
925     html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
926     html.Append('<dl>');
927     html.Append('<p id="idSearch"></p>');
928 h677 1.1 for i := 0 to ReadList.Count - 1 do begin
929     // 1 ???K?存?\??
930     if i <> 0 then begin
931     // ?\????????????
932     case GikoSys.ResRange of
933     Ord( grrKoko ):
934     if ThreadItem.Kokomade > (i + 1) then
935     Continue;
936     Ord( grrNew ):
937     if NewReceiveNo > (i + 1) then
938     Continue;
939     10..65535:
940     if (threadItem.Count - i) > GikoSys.ResRange then
941     Continue;
942     end;
943     end;
944    
945     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
946 h677 1.4.2.1 html.Append('</dl>');
947     html.Append('<a name="new"></a>');
948     html.Append('<table width="100%" bgcolor="#3333CC" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#6666FF" valign="middle"><font size="-1" color="#ffffff"><b>?V?????X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
949     html.Append('<dl>');
950 h677 1.1 end;
951    
952     if (Trim(ReadList[i]) <> '') then begin
953     No := IntToStr(i + 1);
954 h677 1.3 Res := DivideStrLine(ReadList[i]);
955 h677 1.1 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
956     Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
957     if Res.FMailTo = '' then
958 h677 1.4.2.1 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>')
959 h677 1.1 else if GikoSys.Setting.ShowMail then
960 h677 1.4.2.1 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>')
961 h677 1.1 else
962 h677 1.4.2.1 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>');
963 h677 1.1 end;
964     if ThreadItem.Kokomade = (i + 1) then begin
965 h677 1.4.2.1 html.Append('</dl>');
966     html.Append('<a name="koko"></a><table width="100%" bgcolor="#55AA55" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#77CC77" valign="middle"><font size="-1" color="#ffffff"><b>?R?R???長?????転</b></font></td></tr></table>');
967     html.Append('<dl>');
968 h677 1.1 end;
969     end;
970 h677 1.4.2.1 html.Append('</dl>');
971     html.Append('<a name="bottom"></a>');
972     html.Append('</body></html>');
973 h677 1.1 finally
974 h677 1.4.2.1 //doc.Close;
975     html.EndUpdate;
976 h677 1.1 end;
977     end;
978     end;
979    
980 h677 1.4.2.1 procedure THTMLCreate.CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);
981 h677 1.1 var
982     ReadList: TStringList;
983     CSSFileName: string;
984     FileName: string;
985     Res: TResRec;
986 h677 1.4.2.1 html: TStringList;
987     mStream : TMemoryStream;
988 h677 1.4 {$IFDEF DEBUG}
989     st, rt: Cardinal;
990     {$ENDIF}
991 h677 1.1 begin
992 h677 1.4 {$IFDEF DEBUG}
993     Writeln('Create HTML');
994     st := GetTickCount;
995     {$ENDIF}
996 h677 1.1 if ThreadItem <> nil then begin
997 h677 1.4.2.1 html := TStringList.Create;
998     try
999     if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1000     CreateUsePluginHTML(html, ThreadItem, sTitle);
1001     end else begin
1002     ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1003     ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1004     ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1005     ShortDayNames[7] := '?y';
1006 h677 1.1
1007 h677 1.4.2.1 ReadList := TStringList.Create;
1008     try
1009 h677 1.4.2.7 ReadList.BeginUpdate;
1010 h677 1.4.2.1 if ThreadItem.IsLogFile then begin
1011     FileName := ThreadItem.GetThreadFileName;
1012     ReadList.LoadFromFile(FileName);
1013     GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1014     GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1015     GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1016     if ThreadItem.Title = '' then begin
1017     Res := DivideStrLine(ReadList[0]);
1018     sTitle := Res.FTitle;
1019     end else
1020     sTitle := ThreadItem.Title
1021     end else begin
1022     sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1023     end;
1024 h677 1.1
1025 h677 1.4.2.1 // ?t?H???g?但?T?C?Y??????
1026     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1027     if GikoSys.Setting.UseSkin then begin
1028     CreateUseSKINHTML(html, ThreadItem, ReadList);
1029     end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1030     CreateUseCSSHTML(html, ThreadItem, ReadList, sTitle);
1031     end else begin
1032     CreateDefaultHTML(html, ThreadItem, ReadList, sTitle);
1033     end;
1034     finally
1035 h677 1.4.2.7 ReadList.EndUpdate;
1036 h677 1.4.2.1 ReadList.Free;
1037 h677 1.1 end;
1038 h677 1.4.2.1 end;
1039     //WebBrowser?????鼎????
1040     mStream := TMemoryStream.Create;
1041     try
1042     html.SaveToStream(mStream);
1043     mStream.Seek(soFromBeginning, 0);
1044     (doc as IPersistStreamInit).Load(TStreamAdapter.Create(mStream));
1045 h677 1.1 finally
1046 h677 1.4.2.1 mStream.Free;
1047 h677 1.1 end;
1048 h677 1.4.2.1 finally
1049     html.Free;
1050 h677 1.1 end;
1051     end;
1052 h677 1.4 {$IFDEF DEBUG}
1053     rt := GetTickCount - st;
1054     Writeln('Done.');
1055     Writeln(IntToStr(rt) + ' ms');
1056     {$ENDIF}
1057 h677 1.1 end;
1058    
1059 h677 1.2 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1060     var
1061     i: integer;
1062     No: string;
1063     //bufList : TStringList;
1064     ReadList: TStringList;
1065     // SaveList: TStringList;
1066     CSSFileName: string;
1067     BBSID: string;
1068     FileName: string;
1069     Res: TResRec;
1070     boardPlugIn : TBoardPlugIn;
1071    
1072     UserOptionalStyle: string;
1073     SkinHeader: string;
1074     SkinRes: string;
1075     tmp, tmp1: string;
1076     function LoadSkin( fileName: string ): string;
1077     begin
1078     Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1079     end;
1080     function ReplaceRes( skin: string ): string;
1081     begin
1082     Result := SkinedRes( skin, Res, No );
1083     end;
1084    
1085     begin
1086     if ThreadItem <> nil then begin
1087     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1088     html.Clear;
1089     html.BeginUpdate;
1090     //if ThreadItem.IsBoardPlugInAvailable then begin
1091     if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1092     //===== ?v???O?C???????辿?\??
1093     //boardPlugIn := ThreadItem.BoardPlugIn;
1094     boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1095     // ?t?H???g?但?T?C?Y??????
1096     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1097     try
1098     // ?????R?[?h???v???O?C?????C?邸?辿
1099     // ?w?b?_
1100     tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1101     '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1102     //?但???Q?????巽?????Q????
1103     if GikoSys.Setting.UseSkin then begin
1104     tmp1 := './' + GikoSys.Setting.CSSFileName;
1105     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1106     tmp1 := CustomStringReplace(tmp1, '\', '/');
1107     tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1108     end else if GikoSys.Setting.UseCSS then begin
1109     tmp1 := './' + CSSFileName;
1110     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1111     tmp1 := CustomStringReplace(tmp1, '\', '/');
1112     tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1113     end;
1114     html.Append( tmp );
1115    
1116     for i := 0 to threadItem.Count - 1 do begin
1117    
1118     // ???X
1119     html.Append( ConvertResAnchor(boardPlugIn.GetRes( DWORD( threadItem ), i + 1 )) );
1120    
1121     end;
1122     // ?X?L??(?t?b?^)
1123     html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1124     finally
1125     end;
1126     html.EndUpdate;
1127     //Exit;
1128     end else begin
1129     ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1130     ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1131     ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1132     ShortDayNames[7] := '?y';
1133     BBSID := ThreadItem.ParentBoard.BBSID;
1134     ReadList := TStringList.Create;
1135     try
1136     if ThreadItem.IsLogFile then begin
1137     FileName := ThreadItem.GetThreadFileName;
1138     ReadList.LoadFromFile(FileName);
1139     GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1140     GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1141     GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1142 h677 1.3 Res := DivideStrLine(ReadList[0]);
1143 h677 1.2 //Res.FTitle := CustomStringReplace(Res.FTitle, '???M', ',');
1144     sTitle := Res.FTitle;
1145     end else begin
1146     sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1147     end;
1148     try
1149     // ?t?H???g?但?T?C?Y??????
1150     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1151    
1152     if GikoSys.Setting.UseSkin then begin
1153     // ?X?L???g?p
1154     // ?X?L????????
1155     try
1156     SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1157     if Length( UserOptionalStyle ) > 0 then
1158     SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1159     '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1160     //?但???Q?????巽?????Q????
1161     tmp1 := './' + GikoSys.Setting.CSSFileName;
1162     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1163     tmp1 := CustomStringReplace(tmp1, '\', '/');
1164     SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1165     html.Append( SkinHeader );
1166     except
1167     end;
1168     try
1169     SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1170     except
1171     end;
1172     html.Append('<a name="top"></a>');
1173     for i := 0 to ReadList.Count - 1 do begin
1174     if (Trim(ReadList[i]) <> '') then begin
1175     No := IntToStr(i + 1);
1176    
1177 h677 1.3 Res := DivideStrLine(ReadList[i]);
1178 h677 1.2 Res.FBody := AddAnchorTag(Res.FBody);
1179     Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1180    
1181     try
1182     html.Append( ReplaceRes( SkinRes ) );
1183     except
1184     end;
1185     end;
1186    
1187     end;
1188     html.Append('<a name="bottom"></a>');
1189     // ?X?L??(?t?b?^)
1190     try
1191     html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1192     except
1193     end;
1194     end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1195     //CSS?g?p
1196     //CSSFileName := GetAppDir + CSS_FILE_NAME;
1197     html.Append('<html><head>');
1198     html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1199     html.Append('<title>' + sTitle + '</title>');
1200     //?但???Q?????巽?????Q????
1201     tmp1 := './' + CSSFileName;
1202     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1203     tmp1 := CustomStringReplace(tmp1, '\', '/');
1204    
1205     html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1206     if Length( UserOptionalStyle ) > 0 then
1207     html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1208     html.Append('</head>');
1209     html.Append('<body>');
1210     html.Append('<a name="top"></a>');
1211     html.Append('<div class="title">' + sTitle + '</div>');
1212     for i := 0 to ReadList.Count - 1 do begin
1213     if (Trim(ReadList[i]) <> '') then begin
1214     No := IntToStr(i + 1);
1215 h677 1.3 Res := DivideStrLine(ReadList[i]);
1216 h677 1.2 Res.FBody := AddAnchorTag(Res.FBody);
1217     Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1218     if Res.FMailTo = '' then
1219     html.Append('<a name="' + No + '"></a>'
1220     + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1221     + '<span class="name_label">?添?O?F</span> '
1222     + '<span class="name"><b>' + Res.FName + '</b></span> '
1223     + '<span class="date_label">???e?炭?F</span> '
1224     + '<span class="date">' + Res.FDateTime+ '</span></div>'
1225     + '<div class="mes">' + Res.FBody + ' </div>')
1226     else if GikoSys.Setting.ShowMail then
1227     html.Append('<a name="' + No + '"></a>'
1228     + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1229     + '<span class="name_label"> ?添?O?F </span>'
1230     + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1231     + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1232     + '<span class="date_label"> ???e?炭?F</span>'
1233     + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1234     + '<div class="mes">' + Res.FBody + ' </div>')
1235     else
1236     html.Append('<a name="' + No + '"></a>'
1237     + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1238     + '<span class="name_label"> ?添?O?F </span>'
1239     + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1240     + '<b>' + Res.FName + '</b></a>'
1241     + '<span class="date_label"> ???e?炭?F</span>'
1242     + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1243     + '<div class="mes">' + Res.FBody + ' </div>');
1244     end;
1245     end;
1246     html.Append('<a name="bottom"></a>');
1247     html.Append('<a name="last"></a>');
1248     html.Append('</body></html>');
1249     end else begin
1250     //CSS???g?p
1251     html.Append('<html><head>');
1252     html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1253     html.Append('<title>' + sTitle + '</title></head>');
1254     html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1255     html.Append('<a name="top"></a>');
1256     html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1257     html.Append('<dl>');
1258     for i := 0 to ReadList.Count - 1 do begin
1259     if (Trim(ReadList[i]) <> '') then begin
1260     No := IntToStr(i + 1);
1261 h677 1.3 Res := DivideStrLine(ReadList[i]);
1262 h677 1.2 Res.FBody := AddAnchorTag(Res.FBody);
1263     Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1264     if Res.FMailTo = '' then
1265     html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1266     else if GikoSys.Setting.ShowMail then
1267     html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1268     else
1269     html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1270     end;
1271     end;
1272     html.Append('</dl>');
1273     html.Append('<a name="bottom"></a>');
1274     html.Append('</body></html>');
1275     end;
1276     finally
1277     html.EndUpdate;
1278     end;
1279     finally
1280     ReadList.Free;
1281     end;
1282     end;
1283     end;
1284     end;
1285    
1286 h677 1.1 initialization
1287     HTMLCreater := THTMLCreate.Create;
1288    
1289     finalization
1290     if HTMLCreater <> nil then begin
1291     HTMLCreater.Free;
1292     HTMLCreater := nil;
1293     end;
1294    
1295     end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26