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

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