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.4.2.1 - (show annotations) (download) (as text)
Sun Oct 30 04:34:37 2005 UTC (18 years, 5 months ago) by h677
Branch: Bdraw
Changes since 1.4: +219 -159 lines
File MIME type: text/x-pascal
WebBrowserへの書き込みを直接ではなく、メモリストリーム経由に変更。
かちゅ〜しゃ用のスキンの使用をオプションに変更

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

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