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.8 - (hide annotations) (download) (as text)
Mon Nov 14 16:19:19 2005 UTC (18 years, 5 months ago) by h677
Branch: MAIN
CVS Tags: v1_51_0_620, v1_51_0_618, v1_51_0_619
Changes since 1.7: +206 -1 lines
File MIME type: text/x-pascal
GikoFormの整理

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

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