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.2 - (show annotations) (download) (as text)
Sun Oct 30 16:29:51 2005 UTC (18 years, 5 months ago) by h677
Branch: Bdraw
Changes since 1.4.2.1: +10 -12 lines
File MIME type: text/x-pascal
ConvResでの文字列生成の抑制。

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 : 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 Result := 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 (Pos('<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 (Pos('<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 (Pos('<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 (Pos(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 if (AnsiPos('-', PIndex(List[i]).FNo) > 0) then begin
672 st := ChooseString(PIndex(List[i]).FNo, '-', 0);
673 et := ChooseString(PIndex(List[i]).FNo, '-', 1);
674 end else begin
675 st := PIndex(List[i]).FNo;
676 et := PIndex(List[i]).FNo;
677 end;
678 Result := Copy(Result,0, PIndex(List[i]).FIndexFrom - 1) +
679 Format('<a href="%s&%s=%s&%s=%s&%s=%s" target="_blank">',
680 [FullURL, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
681 Copy(Result,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
682 Copy(Result,PIndex(List[i]).FIndexTo,Length(Result));
683 Dispose(PIndex(List[i]));
684 end;
685 List.Free;
686 end;
687
688 function THTMLCreate.ConvertResAnchor(res: string): string;
689 const
690 _HEAD : string = '<a href="../';
691 _TAIL : string = ' target="_blank">';
692 _ST: string = '&st=';
693 _TO: string = '&to=';
694 _STA: string = '&START=';
695 _END: string = '&END=';
696 var
697 i, j, k: Integer;
698 tmp: string;
699 begin
700 Result := '';
701 i := AnsiPos(_HEAD, res);
702 while i <> 0 do begin
703 Result := Result + Copy(res, 1, i -1);
704 Delete(res, 1, i - 1);
705 j := AnsiPos(_TAIL, res);
706 if j = 0 then begin
707 Result := Result + res;
708 Exit;
709 end;
710 tmp := Copy(res, 1, j - 1);
711 Delete(res, 1, j + 16);
712 if (AnsiPos(_ST, tmp) <> 0) and (AnsiPos(_TO, tmp) <> 0) then begin
713 Delete(tmp, 1, AnsiPos(_ST, tmp) + 3);
714 Delete(tmp, AnsiPos(_TO, tmp), Length(tmp));
715 Result := Result + '<a href="#' + tmp + '">';
716 end else if (AnsiPos(_STA, tmp) <> 0) and (AnsiPos(_END, tmp) <> 0) then begin
717 Delete(tmp, 1, AnsiPos(_STA, tmp) + 6);
718 Delete(tmp, AnsiPos(_END, tmp), Length(tmp));
719 Result := Result + '<a href="#' + tmp + '">';
720 end else begin
721 k := LastDelimiter('/', tmp);
722 Delete(tmp, 1, k);
723 if AnsiPos('-', tmp) < AnsiPos('"', tmp) then
724 Delete(tmp, AnsiPos('-', tmp), Length(tmp))
725 else
726 Delete(tmp, AnsiPos('"', tmp), Length(tmp));
727
728 Result := Result + '<a href="#' + tmp + '">';
729 end;
730 i := AnsiPos(_HEAD, res);
731 end;
732 Result := Result + res;
733
734 end;
735
736 //Plugin?????p???辿Board???X???b?h??HTML?????店?直??doc?????鼎???鄭
737 procedure THTMLCreate.CreateUsePluginHTML(html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
738 var
739 i: integer;
740 NewReceiveNo: Integer;
741 boardPlugIn : TBoardPlugIn;
742 UserOptionalStyle: string;
743 begin
744 if ThreadItem <> nil then begin
745 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
746 //===== ?v???O?C???????辿?\??
747 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
748 NewReceiveNo := ThreadItem.NewReceive;
749 // ?t?H???g?但?T?C?Y??????
750 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
751 html.BeginUpdate;
752 try
753 //doc.open;
754 // ?w?b?_
755 //doc.Write( boardPlugIn.GetHeader( DWORD( threadItem ),
756 html.Append( boardPlugIn.GetHeader( DWORD( threadItem ),
757 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
758 // '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ) + #13#10 );
759 //doc.Write('<p id="idSearch"></p>' + #13#10 );
760 html.Add('<p id="idSearch"></p>');
761 for i := 0 to threadItem.Count - 1 do begin
762 // 1 ???K?存?\??
763 if i <> 0 then begin
764 // ?\????????????
765 case GikoSys.ResRange of
766 Ord( grrKoko ):
767 if ThreadItem.Kokomade > (i + 1) then
768 Continue;
769 Ord( grrNew ):
770 if NewReceiveNo > (i + 1) then
771 Continue;
772 10..65535:
773 if (threadItem.Count - i) > GikoSys.ResRange then
774 Continue;
775 end;
776 end;
777
778 // ?V???}?[?N
779 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
780 try
781 if GikoSys.Setting.UseSkin then begin
782 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
783 //doc.Write( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
784 html.Append( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
785 else
786 //doc.Write( '<a name="new"></a>' + #13#10 );
787 html.Append( '<a name="new"></a>' );
788 end else if GikoSys.Setting.UseCSS then begin
789 //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);
790 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>');
791 end else begin
792 //doc.Write('</dl>');
793 html.Append('</dl>');
794 //doc.Write('<a name="new"></a>');
795 html.Append('<a name="new"></a>');
796 //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>');
797 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>');
798 //doc.Write('<dl> + #13#10');
799 html.Append('<dl>');
800 end;
801 except
802 //doc.Write( '<a name="new"></a>' + #13#10);
803 html.Append( '<a name="new"></a>');
804 end;
805 end;
806
807 // ???X
808 //doc.Write( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) + #13#10 );
809 html.Append( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) );
810
811 if ThreadItem.Kokomade = (i + 1) then begin
812 // ???????長?????転
813 try
814 if GikoSys.Setting.UseSkin then begin
815 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
816 //doc.Write( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
817 html.Append( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) )
818 else
819 //doc.Write( '<a name="koko"></a>' + #13#10 );
820 html.Append( '<a name="koko"></a>' );
821 end else if GikoSys.Setting.UseCSS then begin
822 //doc.Write('<a name="koko"></a><div class="koko">?R?R???長?????転</div>' + #13#10 );
823 html.Append('<a name="koko"></a><div class="koko">?R?R???長?????転</div>' );
824 end else begin
825 //doc.Write('</dl>');
826 html.Append('</dl>');
827 //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>');
828 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>');
829 //doc.Write('<dl>' + #13#10 );
830 html.Append('<dl>' );
831 end;
832 except
833 //doc.Write( '<a name="koko"></a>' + #13#10 );
834 html.Append( '<a name="koko"></a>' );
835 end;
836 end;
837 end;
838
839
840 // ?X?L??(?t?b?^)
841 //doc.Write( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) + #13#10 );
842 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
843 finally
844 //doc.Close;
845 html.EndUpdate;
846 end;
847
848 end;
849 end;
850 end;
851
852
853 procedure THTMLCreate.CreateUseSKINHTML(html : TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
854 var
855 i: integer;
856 No: string;
857 CSSFileName: string;
858 NewReceiveNo: Integer;
859 Res: TResRec;
860 UserOptionalStyle: string;
861 SkinHeader: string;
862 SkinNewRes: string;
863 SkinRes: string;
864 strTmp : string;
865 function ReplaceRes( skin: string ): string;
866 begin
867 Result := SkinedRes( skin, Res, No );
868 end;
869 begin
870 if ThreadItem <> nil then begin
871 // ?X?L???g?p
872 if GikoSys.Setting.UseSkin then begin
873 NewReceiveNo := ThreadItem.NewReceive;
874 // ?t?H???g?但?T?C?Y??????
875 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
876 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
877 //doc.open;
878 html.BeginUpdate;
879 try
880 //doc.charset := 'Shift_JIS';
881
882 // ?X?L????????
883 try
884 SkinHeader := LoadFromSkin( GikoSys.GetSkinHeaderFileName, ThreadItem, ThreadItem.Size);
885 if Length( UserOptionalStyle ) > 0 then
886 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
887 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
888 //doc.Write( SkinHeader + #13#10);
889 html.Append( SkinHeader);
890 except
891 end;
892
893 try
894 SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
895 except
896 end;
897
898 try
899 SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
900 except
901 end;
902
903 //doc.Write('<p id="idSearch"></p>' + #13#10);
904 html.Append('<p id="idSearch"></p>');
905 //doc.Write('<a name="top"></a>' + #13#10);
906 html.Append('<a name="top"></a>');
907
908 for i := 0 to ReadList.Count - 1 do begin
909 // 1 ???K?存?\??
910 if i <> 0 then begin
911 // ?\????????????
912 case GikoSys.ResRange of
913 Ord( grrKoko ):
914 if ThreadItem.Kokomade > (i + 1) then
915 Continue;
916 Ord( grrNew ):
917 if NewReceiveNo > (i + 1) then
918 Continue;
919 10..65535:
920 if (threadItem.Count - i) > GikoSys.ResRange then
921 Continue;
922 end;
923 end;
924
925 // ?V???}?[?N
926 if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
927 try
928 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
929 //doc.Write( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10)
930 html.Append( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) )
931 else
932 //doc.Write( '<a name="new"></a>' + #13#10 );
933 html.Append( '<a name="new"></a>' );
934 except
935 //doc.Write( '<a name="new"></a>' + #13#10 );
936 html.Append( '<a name="new"></a>' );
937 end;
938 end;
939
940 if (Trim(ReadList[i]) <> '') then begin
941 No := IntToStr(i + 1);
942
943 Res := DivideStrLine(ReadList[i]);
944 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
945 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
946
947 try
948 if NewReceiveNo <= (i + 1) then
949 // ?V?????X
950 strTmp := ReplaceRes( SkinNewRes )
951 else
952 // ???鱈?????X
953 strTmp := ReplaceRes( SkinRes );
954
955 //doc.Write( strTmp + #13#10 );
956 html.Append( strTmp );
957 except
958 end;
959 end;
960
961 if ThreadItem.Kokomade = (i + 1) then begin
962 // ???????長?????転
963 try
964 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
965 //doc.Write( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
966 html.Append( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) )
967 else
968 //doc.Write( '<a name="koko"></a>' + #13#10 );
969 html.Append( '<a name="koko"></a>' );
970 except
971 //doc.Write( '<a name="koko"></a>' + #13#10 );
972 html.Append( '<a name="koko"></a>' );
973 end;
974 end;
975 end;
976
977 //doc.Write('<a name="bottom"></a>' + #13#10);
978 html.Append('<a name="bottom"></a>' );
979 // ?X?L??(?t?b?^)
980 try
981 //doc.Write( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) + #13#10 );
982 html.Append( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
983 except
984 end;
985 finally
986 //doc.close;
987 html.EndUpdate;
988 end;
989 end;
990 end;
991 end;
992
993 procedure THTMLCreate.CreateUseCSSHTML(html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
994 var
995 i: integer;
996 No: string;
997 CSSFileName: string;
998 NewReceiveNo: Integer;
999 Res: TResRec;
1000 UserOptionalStyle: string;
1001 begin
1002 if ThreadItem <> nil then begin
1003 //doc.open;
1004 html.BeginUpdate;
1005 try
1006 //doc.charset := 'Shift_JIS';
1007 NewReceiveNo := ThreadItem.NewReceive;
1008 // ?t?H???g?但?T?C?Y??????
1009 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1010 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1011 if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1012 //CSS?g?p
1013 html.Append('<html><head>');
1014 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1015 html.Append('<title>' + sTitle + '</title>');
1016 html.Append('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1017 if Length( UserOptionalStyle ) > 0 then
1018 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1019 html.Append('</head>');
1020 html.Append('<body>');
1021 html.Append('<a name="top"></a>');
1022 html.Append('<p id="idSearch"></p>');
1023 html.Append('<div class="title">' + sTitle + '</div>');
1024 for i := 0 to ReadList.Count - 1 do begin
1025 // 1 ???K?存?\??
1026 if i <> 0 then begin
1027 // ?\????????????
1028 case GikoSys.ResRange of
1029 Ord( grrKoko ):
1030 if ThreadItem.Kokomade > (i + 1) then
1031 Continue;
1032 Ord( grrNew ):
1033 if NewReceiveNo > (i + 1) then
1034 Continue;
1035 10..65535:
1036 if (threadItem.Count - i) > GikoSys.ResRange then
1037 Continue;
1038 end;
1039 end;
1040
1041 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1042 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>');
1043 end;
1044
1045 if (Trim(ReadList[i]) <> '') then begin
1046 No := IntToStr(i + 1);
1047 Res := DivideStrLine(ReadList[i]);
1048 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1049 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1050 if Res.FMailTo = '' then
1051 html.Append('<a name="' + No + '"></a>'
1052 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1053 + '<span class="name_label">?添?O?F</span> '
1054 + '<span class="name"><b>' + Res.FName + '</b></span> '
1055 + '<span class="date_label">???e?炭?F</span> '
1056 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1057 + '<div class="mes">' + Res.FBody + ' </div>')
1058 else if GikoSys.Setting.ShowMail then
1059 html.Append('<a name="' + No + '"></a>'
1060 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1061 + '<span class="name_label"> ?添?O?F </span>'
1062 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1063 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1064 + '<span class="date_label"> ???e?炭?F</span>'
1065 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1066 + '<div class="mes">' + Res.FBody + ' </div>')
1067 else
1068 html.Append('<a name="' + No + '"></a>'
1069 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1070 + '<span class="name_label"> ?添?O?F </span>'
1071 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1072 + '<b>' + Res.FName + '</b></a>'
1073 + '<span class="date_label"> ???e?炭?F</span>'
1074 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1075 + '<div class="mes">' + Res.FBody + ' </div>');
1076 end;
1077
1078 if ThreadItem.Kokomade = (i + 1) then begin
1079 html.Append('<a name="koko"></a><div class="koko">?R?R???長?????転</div>');
1080 end;
1081
1082 end;
1083
1084 html.Append('<a name="bottom"></a>');
1085 html.Append('<a name="last"></a>');
1086 html.Append('</body></html>');
1087 end;
1088 finally
1089 html.EndUpdate;
1090 //doc.Close;
1091 end;
1092 end;
1093 end;
1094
1095 procedure THTMLCreate.CreateDefaultHTML (html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
1096 var
1097 i: integer;
1098 No: string;
1099 NewReceiveNo: Integer;
1100 Res: TResRec;
1101 begin
1102 if ThreadItem <> nil then begin
1103 //doc.open;
1104 html.BeginUpdate;
1105 try
1106 //doc.charset := 'Shift_JIS';
1107 NewReceiveNo := ThreadItem.NewReceive;
1108 html.Append('<html><head>');
1109 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1110 html.Append('<title>' + sTitle + '</title></head>');
1111 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1112 html.Append('<a name="top"></a>');
1113 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1114 html.Append('<dl>');
1115 html.Append('<p id="idSearch"></p>');
1116 for i := 0 to ReadList.Count - 1 do begin
1117 // 1 ???K?存?\??
1118 if i <> 0 then begin
1119 // ?\????????????
1120 case GikoSys.ResRange of
1121 Ord( grrKoko ):
1122 if ThreadItem.Kokomade > (i + 1) then
1123 Continue;
1124 Ord( grrNew ):
1125 if NewReceiveNo > (i + 1) then
1126 Continue;
1127 10..65535:
1128 if (threadItem.Count - i) > GikoSys.ResRange then
1129 Continue;
1130 end;
1131 end;
1132
1133 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1134 html.Append('</dl>');
1135 html.Append('<a name="new"></a>');
1136 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>');
1137 html.Append('<dl>');
1138 end;
1139
1140 if (Trim(ReadList[i]) <> '') then begin
1141 No := IntToStr(i + 1);
1142 Res := DivideStrLine(ReadList[i]);
1143 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1144 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1145 if Res.FMailTo = '' then
1146 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>')
1147 else if GikoSys.Setting.ShowMail then
1148 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>')
1149 else
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> ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>');
1151 end;
1152 if ThreadItem.Kokomade = (i + 1) then begin
1153 html.Append('</dl>');
1154 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>');
1155 html.Append('<dl>');
1156 end;
1157 end;
1158 html.Append('</dl>');
1159 html.Append('<a name="bottom"></a>');
1160 html.Append('</body></html>');
1161 finally
1162 //doc.Close;
1163 html.EndUpdate;
1164 end;
1165 end;
1166 end;
1167
1168 procedure THTMLCreate.CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);
1169 var
1170 ReadList: TStringList;
1171 CSSFileName: string;
1172 FileName: string;
1173 Res: TResRec;
1174 html: TStringList;
1175 mStream : TMemoryStream;
1176 {$IFDEF DEBUG}
1177 st, rt: Cardinal;
1178 {$ENDIF}
1179 begin
1180 {$IFDEF DEBUG}
1181 Writeln('Create HTML');
1182 st := GetTickCount;
1183 {$ENDIF}
1184 if ThreadItem <> nil then begin
1185 html := TStringList.Create;
1186 try
1187 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1188 CreateUsePluginHTML(html, ThreadItem, sTitle);
1189 end else begin
1190 ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1191 ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1192 ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1193 ShortDayNames[7] := '?y';
1194
1195 ReadList := TStringList.Create;
1196 try
1197 if ThreadItem.IsLogFile then begin
1198 FileName := ThreadItem.GetThreadFileName;
1199 ReadList.LoadFromFile(FileName);
1200 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1201 GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1202 GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1203 if ThreadItem.Title = '' then begin
1204 Res := DivideStrLine(ReadList[0]);
1205 sTitle := Res.FTitle;
1206 end else
1207 sTitle := ThreadItem.Title
1208 end else begin
1209 sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1210 end;
1211
1212 // ?t?H???g?但?T?C?Y??????
1213 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1214 if GikoSys.Setting.UseSkin then begin
1215 CreateUseSKINHTML(html, ThreadItem, ReadList);
1216 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1217 CreateUseCSSHTML(html, ThreadItem, ReadList, sTitle);
1218 end else begin
1219 CreateDefaultHTML(html, ThreadItem, ReadList, sTitle);
1220 end;
1221 finally
1222 ReadList.Free;
1223 end;
1224 end;
1225 //WebBrowser?????鼎????
1226 mStream := TMemoryStream.Create;
1227 try
1228 html.SaveToStream(mStream);
1229 mStream.Seek(soFromBeginning, 0);
1230 (doc as IPersistStreamInit).Load(TStreamAdapter.Create(mStream));
1231 finally
1232 mStream.Free;
1233 end;
1234 finally
1235 html.Free;
1236 end;
1237 end;
1238 {$IFDEF DEBUG}
1239 rt := GetTickCount - st;
1240 Writeln('Done.');
1241 Writeln(IntToStr(rt) + ' ms');
1242 {$ENDIF}
1243 end;
1244
1245 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1246 var
1247 i: integer;
1248 No: string;
1249 //bufList : TStringList;
1250 ReadList: TStringList;
1251 // SaveList: TStringList;
1252 CSSFileName: string;
1253 BBSID: string;
1254 FileName: string;
1255 Res: TResRec;
1256 boardPlugIn : TBoardPlugIn;
1257
1258 UserOptionalStyle: string;
1259 SkinHeader: string;
1260 SkinRes: string;
1261 tmp, tmp1: string;
1262 function LoadSkin( fileName: string ): string;
1263 begin
1264 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1265 end;
1266 function ReplaceRes( skin: string ): string;
1267 begin
1268 Result := SkinedRes( skin, Res, No );
1269 end;
1270
1271 begin
1272 if ThreadItem <> nil then begin
1273 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1274 html.Clear;
1275 html.BeginUpdate;
1276 //if ThreadItem.IsBoardPlugInAvailable then begin
1277 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1278 //===== ?v???O?C???????辿?\??
1279 //boardPlugIn := ThreadItem.BoardPlugIn;
1280 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1281 // ?t?H???g?但?T?C?Y??????
1282 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1283 try
1284 // ?????R?[?h???v???O?C?????C?邸?辿
1285 // ?w?b?_
1286 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1287 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1288 //?但???Q?????巽?????Q????
1289 if GikoSys.Setting.UseSkin then begin
1290 tmp1 := './' + GikoSys.Setting.CSSFileName;
1291 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1292 tmp1 := CustomStringReplace(tmp1, '\', '/');
1293 tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1294 end else if GikoSys.Setting.UseCSS then begin
1295 tmp1 := './' + CSSFileName;
1296 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1297 tmp1 := CustomStringReplace(tmp1, '\', '/');
1298 tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1299 end;
1300 html.Append( tmp );
1301
1302 for i := 0 to threadItem.Count - 1 do begin
1303
1304 // ???X
1305 html.Append( ConvertResAnchor(boardPlugIn.GetRes( DWORD( threadItem ), i + 1 )) );
1306
1307 end;
1308 // ?X?L??(?t?b?^)
1309 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1310 finally
1311 end;
1312 html.EndUpdate;
1313 //Exit;
1314 end else begin
1315 ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1316 ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1317 ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1318 ShortDayNames[7] := '?y';
1319 BBSID := ThreadItem.ParentBoard.BBSID;
1320 ReadList := TStringList.Create;
1321 try
1322 if ThreadItem.IsLogFile then begin
1323 FileName := ThreadItem.GetThreadFileName;
1324 ReadList.LoadFromFile(FileName);
1325 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1326 GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1327 GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1328 Res := DivideStrLine(ReadList[0]);
1329 //Res.FTitle := CustomStringReplace(Res.FTitle, '???M', ',');
1330 sTitle := Res.FTitle;
1331 end else begin
1332 sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1333 end;
1334 try
1335 // ?t?H???g?但?T?C?Y??????
1336 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1337
1338 if GikoSys.Setting.UseSkin then begin
1339 // ?X?L???g?p
1340 // ?X?L????????
1341 try
1342 SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1343 if Length( UserOptionalStyle ) > 0 then
1344 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1345 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1346 //?但???Q?????巽?????Q????
1347 tmp1 := './' + GikoSys.Setting.CSSFileName;
1348 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1349 tmp1 := CustomStringReplace(tmp1, '\', '/');
1350 SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1351 html.Append( SkinHeader );
1352 except
1353 end;
1354 try
1355 SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1356 except
1357 end;
1358 html.Append('<a name="top"></a>');
1359 for i := 0 to ReadList.Count - 1 do begin
1360 if (Trim(ReadList[i]) <> '') then begin
1361 No := IntToStr(i + 1);
1362
1363 Res := DivideStrLine(ReadList[i]);
1364 Res.FBody := AddAnchorTag(Res.FBody);
1365 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1366
1367 try
1368 html.Append( ReplaceRes( SkinRes ) );
1369 except
1370 end;
1371 end;
1372
1373 end;
1374 html.Append('<a name="bottom"></a>');
1375 // ?X?L??(?t?b?^)
1376 try
1377 html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1378 except
1379 end;
1380 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1381 //CSS?g?p
1382 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1383 html.Append('<html><head>');
1384 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1385 html.Append('<title>' + sTitle + '</title>');
1386 //?但???Q?????巽?????Q????
1387 tmp1 := './' + CSSFileName;
1388 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1389 tmp1 := CustomStringReplace(tmp1, '\', '/');
1390
1391 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1392 if Length( UserOptionalStyle ) > 0 then
1393 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1394 html.Append('</head>');
1395 html.Append('<body>');
1396 html.Append('<a name="top"></a>');
1397 html.Append('<div class="title">' + sTitle + '</div>');
1398 for i := 0 to ReadList.Count - 1 do begin
1399 if (Trim(ReadList[i]) <> '') then begin
1400 No := IntToStr(i + 1);
1401 Res := DivideStrLine(ReadList[i]);
1402 Res.FBody := AddAnchorTag(Res.FBody);
1403 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1404 if Res.FMailTo = '' then
1405 html.Append('<a name="' + No + '"></a>'
1406 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1407 + '<span class="name_label">?添?O?F</span> '
1408 + '<span class="name"><b>' + Res.FName + '</b></span> '
1409 + '<span class="date_label">???e?炭?F</span> '
1410 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1411 + '<div class="mes">' + Res.FBody + ' </div>')
1412 else if GikoSys.Setting.ShowMail then
1413 html.Append('<a name="' + No + '"></a>'
1414 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1415 + '<span class="name_label"> ?添?O?F </span>'
1416 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1417 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1418 + '<span class="date_label"> ???e?炭?F</span>'
1419 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1420 + '<div class="mes">' + Res.FBody + ' </div>')
1421 else
1422 html.Append('<a name="' + No + '"></a>'
1423 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1424 + '<span class="name_label"> ?添?O?F </span>'
1425 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1426 + '<b>' + Res.FName + '</b></a>'
1427 + '<span class="date_label"> ???e?炭?F</span>'
1428 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1429 + '<div class="mes">' + Res.FBody + ' </div>');
1430 end;
1431 end;
1432 html.Append('<a name="bottom"></a>');
1433 html.Append('<a name="last"></a>');
1434 html.Append('</body></html>');
1435 end else begin
1436 //CSS???g?p
1437 html.Append('<html><head>');
1438 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1439 html.Append('<title>' + sTitle + '</title></head>');
1440 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1441 html.Append('<a name="top"></a>');
1442 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1443 html.Append('<dl>');
1444 for i := 0 to ReadList.Count - 1 do begin
1445 if (Trim(ReadList[i]) <> '') then begin
1446 No := IntToStr(i + 1);
1447 Res := DivideStrLine(ReadList[i]);
1448 Res.FBody := AddAnchorTag(Res.FBody);
1449 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1450 if Res.FMailTo = '' then
1451 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>')
1452 else if GikoSys.Setting.ShowMail then
1453 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>')
1454 else
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> ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1456 end;
1457 end;
1458 html.Append('</dl>');
1459 html.Append('<a name="bottom"></a>');
1460 html.Append('</body></html>');
1461 end;
1462 finally
1463 html.EndUpdate;
1464 end;
1465 finally
1466 ReadList.Free;
1467 end;
1468 end;
1469 end;
1470 end;
1471
1472 initialization
1473 HTMLCreater := THTMLCreate.Create;
1474
1475 finalization
1476 if HTMLCreater <> nil then begin
1477 HTMLCreater.Free;
1478 HTMLCreater := nil;
1479 end;
1480
1481 end.

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