Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/HTMLCreate.pas

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


Revision 1.10 - (show annotations) (download) (as text)
Sun Dec 4 08:51:08 2005 UTC (18 years, 4 months ago) by h677
Branch: MAIN
CVS Tags: v1_51_0_624
Changes since 1.9: +50 -63 lines
File MIME type: text/x-pascal
HTML作成時の余分な改行コードを削除

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

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