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

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