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.3 - (show annotations) (download) (as text)
Mon Oct 31 15:42:55 2005 UTC (18 years, 5 months ago) by h677
Branch: Bdraw
Changes since 1.4.2.2: +21 -24 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="' ('"'ツづつで、)ツて個づ?て堋バツδ環エツーツシツδ?δ督づ可余ツ裕ツて堕篠敖ね敖で。ツづゥツね敖づ?/span>
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 // ツスツキツδ督て堕禿?づ敖債楪づ敖、ツ値ツて堕置ツ翰?ね?づゥ
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 // ツづ「ツて債で?ツね敖で楪尭卍てセツね伉でサツづ?、ツオツプツシツδ?δ督ダツイツアツδ債グツて堋プツδ個ビツδ?ーツ用 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 //----- ツて?て債つ?ツで堋つクツで?ツでシツてδ〜ツてセツづ。ツ古敖翰?用ツ。ツコツδ?δ督トツアツウツトツてセツづ?で閉て?てセ
123 if GikoSys.Setting.UseKatjushaType then begin
124 // ツづ「ツて債で?ツね敖で楪尭卍てセツね伉でサツづ?、ツオツプツシツδ?δ督ダツイツアツδ債グツて堋プツδ個ビツδ?ーツ用 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 // ツδ個スツて堋値ツて堕置ツ翰?ね?づゥ
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 //----- ツで?ツでシツてδ〜ツてセツづ。ツ古敖翰?用ツ。ツコツδ?δ督トツアツウツトツてセツづ?で閉て?てセ
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://ツて堋頁崢篠堋稜?て疎nchorツタツグツ付ツで、ツづ可ね?づゥツ。
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; //ツづ?て堋マツーツクツてケツ闇卍づ?で?ツで?ツづ?ね敖で?ツて堕頁ーツ打?/span>
228 end;
229 end;
230
231 if idx = MaxInt then begin
232 //ツδ環δ督クツで楪滅つね伉て?。
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 //ツ看ッツづ可δ環δ督クツタツグツで楪づつね伉づ?ね伉づゥツづ?でーツね伉て?で、ツづ債δ?ツシ
240 //</a></A>ツて堕探ツね?、ツ焦ケツ頁崢篠堋てケツ固?ツづつで?ツづァツて個でサツて卍づ篠惰コツ頁崢篠堋てケツ個淞最?/span>
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ツで崢づ。ツて個ね伉頁崢篠堋板ュツ固?ツ!ツて?で?ツ、ツ頁崢篠堋で楪て個つュツて個づ?ね敖。
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 //ツ案卍頁崢篠堋進ツづ淞づゥツ。
278 Inc(pp);
279 end;
280 end;
281 end;
282
283 //ツ闇卍青板、AIDツ:ツ妥篠焦ーツて?て個づゥツ禿コツ付IDツ頁崢篠堋稜?、ANum:ツδ個スツ氾 AURLツ:ツで・ツて堋スツδ個ッツドツて啅RL
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 = 'ツ0ツ1ツ2ツ3ツ4ツ5ツ6ツ7ツ8ツ9ツ−';
322 FORMAT_LINK = '<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">';
323 var
324 i : integer;
325 s,r : string;
326 b : TMbcsByteType;
327 sw: boolean;
328 sp: integer;
329 No: string;
330 sx: string;
331 List: TList;
332 oc : string;
333 st, et: string;
334 chk : boolean;
335 al : boolean;
336 procedure Add(IndexFrom, IndexTo: integer; const No: string);
337 var
338 FIndex : PIndex;
339 begin
340 New(FIndex);
341 FIndex.FIndexFrom := IndexFrom;
342 FIndex.FIndexTo := IndexTo;
343 FIndex.FNo := No;
344 List.Add(FIndex);
345 end;
346 procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
347 var
348 p : Integer;
349 begin
350 p := Pos(Separator, Text);
351 if (p > 0 ) then begin
352 st := Copy(Text, 1, p - 1);
353 et := Copy(Text, p + Length(Separator), Length(Text));
354 end else begin
355 st := Text;
356 et := Text;
357 end;
358 end;
359 begin
360 { v1.0 b2 - 03 }
361 s := Body;
362 r := Body;
363 i := 1;
364 sw := False;
365 No := '';
366 List:= TList.Create;
367 oc := '';
368 sp := 0;
369 chk := False;
370 al := False;
371 while true do begin
372 b := ByteType(s, i);
373 case b of
374 mbSingleByte : begin
375 if (not sw) and (Copy(s,i,8) = GT + GT) then begin
376 if (Pos('<A HREF', oc) = 0) then begin
377 sw := True;
378 sp := i;
379 i := i + 7;
380 oc:='';
381 chk := True;
382 end;
383 end else
384 if (not sw) and (Copy(s,i,8) = GT + GT) then begin
385 if (Pos('<A HREF', oc) = 1) then begin
386 i := i + 7;
387 oc:='';
388 chk := True;
389 end;
390 end else
391 if (not sw) and (Copy(s,i,4) = GT) then begin
392 if (Pos('<A HREF', oc) = 0) then begin
393 sw := True;
394 sp := i;
395 i := i + 3;
396 oc:='';
397 chk := True;
398 end;
399 end else
400 if ((not sw) and (Copy(s,i,1) = ',')) or
401 ((not sw) and (Copy(s,i,1) = '=')) then begin
402 if ((not Chk) and (oc = '</A>')) or
403 ((Chk) and (oc = '')) or
404 ((not Chk) and (al)) then
405 begin
406 sw := True;
407 sp := i;
408 //i := i + 1;
409 oc:='';
410 end;
411 end else
412 if (sw) then begin
413 sx := Copy(s,i,1);
414 if (AnsiPos(sx, SN) > 0) then begin
415 No := No + sx;
416 end else begin
417 if (No <> '') and (No <> '-') then begin
418 Add(sp, i, No);
419 al := True;
420 end;
421 sw := False;
422 //
423 i := i - 1;
424 //
425 No := '';
426 oc:='';
427 //chk := False;
428 end;
429 end else begin
430 if Copy(s,i,1) = '<' then begin
431 oc := '<';
432 end else begin
433 oc := oc + AnsiUpperCase(Copy(s,i,1));
434 end;
435 chk := False;
436 al := False;
437 end;
438 end;
439 mbLeadByte : begin
440 if (not sw) and (Copy(s,i,4) = 'ツ????#39;) then begin
441 sw := True;
442 sp := i;
443 i := i + 3;
444 chk := True;
445 end else
446 if (not sw) and (Copy(s,i,2) = 'ツ??#39;) then begin
447 sw := True;
448 sp := i;
449 i := i + 1;
450 chk := True;
451 end else
452 if (sw) then begin
453 sx := Copy(s,i,2);
454 if (AnsiPos(sx, ZN) > 0) then begin
455 No := No + ZenToHan(sx);
456 end else begin
457 if (No <> '') and (No <> '-') and (No <> 'ツ−') then begin
458 Add(sp, i, No);
459 end;
460 sw := False;
461 i := i - 1;
462 No := '';
463 end;
464 end else begin
465 oc := '';
466 chk := False;
467 end;
468 al := False;
469 end;
470 end;
471 inc(i);
472 if (i > Length(Body)) then begin
473 if (sw) then begin
474 if (No <> '') then Add(sp, i, No);
475 end;
476 Break;
477 end;
478 end;
479 for i := List.Count - 1 downto 0 do begin
480 separateNumber(st, et, PIndex(List[i]).FNo, '-');
481 if not DatToHTML then
482 r := Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
483 Format(FORMAT_LINK, [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
484 Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
485 Copy(r,PIndex(List[i]).FIndexTo,Length(r))
486 else
487 r := Copy(r,0, PIndex(List[i]).FIndexFrom - 1) +
488 Format('<a href="#%s">', [st]) +
489 Copy(r,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
490 Copy(r,PIndex(List[i]).FIndexTo,Length(r));
491
492 Dispose(PIndex(List[i]));
493 end;
494 List.Free;
495 Result := r;
496 end;
497
498 function THTMLCreate.ConvRes(
499 const Body, Bbs, Key, ParamBBS, ParamKey,
500 ParamStart, ParamTo, ParamNoFirst,
501 ParamTrue, FullURL : string
502 ): string;
503 type
504 PIndex = ^TIndex;
505 TIndex = record
506 FIndexFrom : integer;
507 FIndexTo : integer;
508 FNo : string;
509 end;
510 const
511 GT = '&gt;';
512 SN = '0123456789-';
513 ZN = 'ツ0ツ1ツ2ツ3ツ4ツ5ツ6ツ7ツ8ツ9ツ−';
514 var
515 i : integer;
516 s : string;
517 b : TMbcsByteType;
518 sw: boolean;
519 sp: integer;
520 No: string;
521 sx: string;
522 List: TList;
523 oc : string;
524 st, et: string;
525 chk : boolean;
526 al : boolean;
527 procedure Add(IndexFrom, IndexTo: integer; const No: string);
528 var
529 FIndex : PIndex;
530 begin
531 New(FIndex);
532 FIndex.FIndexFrom := IndexFrom;
533 FIndex.FIndexTo := IndexTo;
534 FIndex.FNo := No;
535 List.Add(FIndex);
536 end;
537 function ChooseString(const Text, Separator: string; Index: integer): string;
538 var
539 S : string;
540 i, p : integer;
541 begin
542 S := Text;
543 for i := 0 to Index - 1 do begin
544 if (AnsiPos(Separator, S) = 0) then S := ''
545 else S := Copy(S, AnsiPos(Separator, S) + Length(Separator), Length(S));
546 end;
547 p := AnsiPos(Separator, S);
548 if (p > 0) then Result := Copy(S, 1, p - 1) else Result := S;
549 end;
550 begin
551 { v1.0 b2 - 03 }
552 s := Body;
553 Result := Body;
554 i := 1;
555 sw := False;
556 No := '';
557 List:= TList.Create;
558 oc := '';
559 sp := 0;
560 chk := False;
561 al := False;
562 while true do begin
563 b := ByteType(s, i);
564 case b of
565 mbSingleByte : begin
566 if (not sw) and (Copy(s,i,8) = GT + GT) then begin
567 if (Pos('<A HREF', AnsiUpperCase(oc)) = 0) then begin
568 sw := True;
569 sp := i;
570 i := i + 7;
571 oc:='';
572 chk := True;
573 end;
574 end else
575 if (not sw) and (Copy(s,i,8) = GT + GT) then begin
576 if (Pos('<A HREF', AnsiUpperCase(oc)) = 1) then begin
577 i := i + 7;
578 oc:='';
579 chk := True;
580 end;
581 end else
582 if (not sw) and (Copy(s,i,4) = GT) then begin
583 if (Pos('<A HREF', AnsiUpperCase(oc)) = 0) then begin
584 sw := True;
585 sp := i;
586 i := i + 3;
587 oc:='';
588 chk := True;
589 end;
590 end else
591 if ((not sw) and (Copy(s,i,1) = ',')) or
592 ((not sw) and (Copy(s,i,1) = '=')) then begin
593 if ((not Chk) and (AnsiLowerCase(oc) = '</a>')) or
594 ((Chk) and (oc = '')) or
595 ((not Chk) and (al)) then
596 begin
597 sw := True;
598 sp := i;
599 //i := i + 1;
600 oc:='';
601 end;
602 end else
603 if (sw) then begin
604 sx := Copy(s,i,1);
605 if (Pos(sx, SN) > 0) then begin
606 No := No + sx;
607 end else begin
608 if (No <> '') and (No <> '-') then begin
609 Add(sp, i, No);
610 al := True;
611 end;
612 sw := False;
613 //
614 i := i - 1;
615 //
616 No := '';
617 oc:='';
618 //chk := False;
619 end;
620 end else begin
621 if Copy(s,i,1) = '<' then oc := '';
622 oc := oc + Copy(s,i,1);
623 chk := False;
624 al := False;
625 end;
626 end;
627 mbLeadByte : begin
628 if (not sw) and (Copy(s,i,4) = 'ツ????#39;) then begin
629 sw := True;
630 sp := i;
631 i := i + 3;
632 chk := True;
633 end else
634 if (not sw) and (Copy(s,i,2) = 'ツ??#39;) then begin
635 sw := True;
636 sp := i;
637 i := i + 1;
638 chk := True;
639 end else
640 if (sw) then begin
641 sx := Copy(s,i,2);
642 if (AnsiPos(sx, ZN) > 0) then begin
643 No := No + ZenToHan(sx);
644 end else begin
645 if (No <> '') and (No <> '-') and (No <> 'ツ−') then begin
646 Add(sp, i, No);
647 end;
648 sw := False;
649 i := i - 1;
650 No := '';
651 end;
652 end else begin
653 oc := '';
654 chk := False;
655 end;
656 al := False;
657 end;
658 end;
659 inc(i);
660 if (i > Length(Body)) then begin
661 if (sw) then begin
662 if (No <> '') then Add(sp, i, No);
663 end;
664 Break;
665 end;
666 end;
667 for i := List.Count - 1 downto 0 do begin
668 if (AnsiPos('-', PIndex(List[i]).FNo) > 0) then begin
669 st := ChooseString(PIndex(List[i]).FNo, '-', 0);
670 et := ChooseString(PIndex(List[i]).FNo, '-', 1);
671 end else begin
672 st := PIndex(List[i]).FNo;
673 et := PIndex(List[i]).FNo;
674 end;
675 Result := Copy(Result,0, PIndex(List[i]).FIndexFrom - 1) +
676 Format('<a href="%s&%s=%s&%s=%s&%s=%s" target="_blank">',
677 [FullURL, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]) +
678 Copy(Result,PIndex(List[i]).FIndexFrom, PIndex(List[i]).FIndexTo - PIndex(List[i]).FIndexFrom) + '</A>' +
679 Copy(Result,PIndex(List[i]).FIndexTo,Length(Result));
680 Dispose(PIndex(List[i]));
681 end;
682 List.Free;
683 end;
684
685 function THTMLCreate.ConvertResAnchor(res: string): string;
686 const
687 _HEAD : string = '<a href="../';
688 _TAIL : string = ' target="_blank">';
689 _ST: string = '&st=';
690 _TO: string = '&to=';
691 _STA: string = '&START=';
692 _END: string = '&END=';
693 var
694 i, j, k: Integer;
695 tmp: string;
696 begin
697 Result := '';
698 i := AnsiPos(_HEAD, res);
699 while i <> 0 do begin
700 Result := Result + Copy(res, 1, i -1);
701 Delete(res, 1, i - 1);
702 j := AnsiPos(_TAIL, res);
703 if j = 0 then begin
704 Result := Result + res;
705 Exit;
706 end;
707 tmp := Copy(res, 1, j - 1);
708 Delete(res, 1, j + 16);
709 if (AnsiPos(_ST, tmp) <> 0) and (AnsiPos(_TO, tmp) <> 0) then begin
710 Delete(tmp, 1, AnsiPos(_ST, tmp) + 3);
711 Delete(tmp, AnsiPos(_TO, tmp), Length(tmp));
712 Result := Result + '<a href="#' + tmp + '">';
713 end else if (AnsiPos(_STA, tmp) <> 0) and (AnsiPos(_END, tmp) <> 0) then begin
714 Delete(tmp, 1, AnsiPos(_STA, tmp) + 6);
715 Delete(tmp, AnsiPos(_END, tmp), Length(tmp));
716 Result := Result + '<a href="#' + tmp + '">';
717 end else begin
718 k := LastDelimiter('/', tmp);
719 Delete(tmp, 1, k);
720 if AnsiPos('-', tmp) < AnsiPos('"', tmp) then
721 Delete(tmp, AnsiPos('-', tmp), Length(tmp))
722 else
723 Delete(tmp, AnsiPos('"', tmp), Length(tmp));
724
725 Result := Result + '<a href="#' + tmp + '">';
726 end;
727 i := AnsiPos(_HEAD, res);
728 end;
729 Result := Result + res;
730
731 end;
732
733 //Pluginツて堕猟伉用ツね?づゥBoardツて堋スツδ個ッツドツて唏TMLツて堕再崢税ケツてセツづ?ocツづ可渉堕で、ツ債楪で「
734 procedure THTMLCreate.CreateUsePluginHTML(html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
735 var
736 i: integer;
737 NewReceiveNo: Integer;
738 boardPlugIn : TBoardPlugIn;
739 UserOptionalStyle: string;
740 begin
741 if ThreadItem <> nil then begin
742 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
743 //===== ツプツδ可グツイツδ督づ可て?づゥツ表ツ芝?/span>
744 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
745 NewReceiveNo := ThreadItem.NewReceive;
746 // ツフツォツδ督トツづ「ツサツイツズツて堋静敖墜?/span>
747 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
748 html.BeginUpdate;
749 try
750 //doc.open;
751 // ツヘツッツダ
752 //doc.Write( boardPlugIn.GetHeader( DWORD( threadItem ),
753 html.Append( boardPlugIn.GetHeader( DWORD( threadItem ),
754 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
755 // '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ) + #13#10 );
756 //doc.Write('<p id="idSearch"></p>' + #13#10 );
757 html.Add('<p id="idSearch"></p>');
758 for i := 0 to threadItem.Count - 1 do begin
759 // 1 ツづ債必ツつクツ表ツ芝?/span>
760 if i <> 0 then begin
761 // ツ表ツ芝堋氾債暗債て堕固板墜?/span>
762 case GikoSys.ResRange of
763 Ord( grrKoko ):
764 if ThreadItem.Kokomade > (i + 1) then
765 Continue;
766 Ord( grrNew ):
767 if NewReceiveNo > (i + 1) then
768 Continue;
769 10..65535:
770 if (threadItem.Count - i) > GikoSys.ResRange then
771 Continue;
772 end;
773 end;
774
775 // ツ新ツ陳?マツーツク
776 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
777 try
778 if GikoSys.Setting.UseSkin then begin
779 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
780 //doc.Write( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
781 html.Append( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
782 else
783 //doc.Write( '<a name="new"></a>' + #13#10 );
784 html.Append( '<a name="new"></a>' );
785 end else if GikoSys.Setting.UseCSS then begin
786 //doc.Write('<a name="new"></a><div class="new">ツ新ツ陳?δ個ス <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>' + #13#10);
787 html.Append('<a name="new"></a><div class="new">ツ新ツ陳?δ個ス <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
788 end else begin
789 //doc.Write('</dl>');
790 html.Append('</dl>');
791 //doc.Write('<a name="new"></a>');
792 html.Append('<a name="new"></a>');
793 //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>ツ新ツ陳?δ個ス ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
794 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>ツ新ツ陳?δ個ス ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
795 //doc.Write('<dl> + #13#10');
796 html.Append('<dl>');
797 end;
798 except
799 //doc.Write( '<a name="new"></a>' + #13#10);
800 html.Append( '<a name="new"></a>');
801 end;
802 end;
803
804 // ツδ個ス
805 //doc.Write( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) + #13#10 );
806 html.Append( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ) );
807
808 if ThreadItem.Kokomade = (i + 1) then begin
809 // ツて?て?づ慊てケツ禿?で?でセ
810 try
811 if GikoSys.Setting.UseSkin then begin
812 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
813 //doc.Write( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
814 html.Append( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) )
815 else
816 //doc.Write( '<a name="koko"></a>' + #13#10 );
817 html.Append( '<a name="koko"></a>' );
818 end else if GikoSys.Setting.UseCSS then begin
819 //doc.Write('<a name="koko"></a><div class="koko">ツコツコツづ慊てケツ禿?で?でセ</div>' + #13#10 );
820 html.Append('<a name="koko"></a><div class="koko">ツコツコツづ慊てケツ禿?で?でセ</div>' );
821 end else begin
822 //doc.Write('</dl>');
823 html.Append('</dl>');
824 //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>ツコツコツづ慊てケツ禿?で?でセ</b></font></td></tr></table>');
825 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>ツコツコツづ慊てケツ禿?で?でセ</b></font></td></tr></table>');
826 //doc.Write('<dl>' + #13#10 );
827 html.Append('<dl>' );
828 end;
829 except
830 //doc.Write( '<a name="koko"></a>' + #13#10 );
831 html.Append( '<a name="koko"></a>' );
832 end;
833 end;
834 end;
835
836
837 // ツスツキツδ?ツフツッツタ)
838 //doc.Write( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) + #13#10 );
839 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
840 finally
841 //doc.Close;
842 html.EndUpdate;
843 end;
844
845 end;
846 end;
847 end;
848
849
850 procedure THTMLCreate.CreateUseSKINHTML(html : TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
851 var
852 i: integer;
853 No: string;
854 CSSFileName: string;
855 NewReceiveNo: Integer;
856 Res: TResRec;
857 UserOptionalStyle: string;
858 SkinHeader: string;
859 SkinNewRes: string;
860 SkinRes: string;
861 strTmp : string;
862 function ReplaceRes( skin: string ): string;
863 begin
864 Result := SkinedRes( skin, Res, No );
865 end;
866 begin
867 if ThreadItem <> nil then begin
868 // ツスツキツδ督使ツ用
869 if GikoSys.Setting.UseSkin then begin
870 NewReceiveNo := ThreadItem.NewReceive;
871 // ツフツォツδ督トツづ「ツサツイツズツて堋静敖墜?/span>
872 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
873 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
874 //doc.open;
875 html.BeginUpdate;
876 try
877 //doc.charset := 'Shift_JIS';
878
879 // ツスツキツδ督て堋静敖墜?/span>
880 try
881 SkinHeader := LoadFromSkin( GikoSys.GetSkinHeaderFileName, ThreadItem, ThreadItem.Size);
882 if Length( UserOptionalStyle ) > 0 then
883 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
884 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
885 //doc.Write( SkinHeader + #13#10);
886 html.Append( SkinHeader);
887 except
888 end;
889
890 try
891 SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
892 except
893 end;
894
895 try
896 SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
897 except
898 end;
899
900 //doc.Write('<p id="idSearch"></p>' + #13#10);
901 html.Append('<p id="idSearch"></p>');
902 //doc.Write('<a name="top"></a>' + #13#10);
903 html.Append('<a name="top"></a>');
904
905 for i := 0 to ReadList.Count - 1 do begin
906 // 1 ツづ債必ツつクツ表ツ芝?/span>
907 if i <> 0 then begin
908 // ツ表ツ芝堋氾債暗債て堕固板墜?/span>
909 case GikoSys.ResRange of
910 Ord( grrKoko ):
911 if ThreadItem.Kokomade > (i + 1) then
912 Continue;
913 Ord( grrNew ):
914 if NewReceiveNo > (i + 1) then
915 Continue;
916 10..65535:
917 if (threadItem.Count - i) > GikoSys.ResRange then
918 Continue;
919 end;
920 end;
921
922 // ツ新ツ陳?マツーツク
923 if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
924 try
925 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
926 //doc.Write( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10)
927 html.Append( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ) )
928 else
929 //doc.Write( '<a name="new"></a>' + #13#10 );
930 html.Append( '<a name="new"></a>' );
931 except
932 //doc.Write( '<a name="new"></a>' + #13#10 );
933 html.Append( '<a name="new"></a>' );
934 end;
935 end;
936
937 if (Trim(ReadList[i]) <> '') then begin
938 No := IntToStr(i + 1);
939
940 Res := DivideStrLine(ReadList[i]);
941 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
942 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
943
944 try
945 if NewReceiveNo <= (i + 1) then
946 // ツ新ツ陳?δ個ス
947 strTmp := ReplaceRes( SkinNewRes )
948 else
949 // ツ墜伉湘ュツて堋δ個ス
950 strTmp := ReplaceRes( SkinRes );
951
952 //doc.Write( strTmp + #13#10 );
953 html.Append( strTmp );
954 except
955 end;
956 end;
957
958 if ThreadItem.Kokomade = (i + 1) then begin
959 // ツて?て?づ慊てケツ禿?で?でセ
960 try
961 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
962 //doc.Write( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
963 html.Append( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) )
964 else
965 //doc.Write( '<a name="koko"></a>' + #13#10 );
966 html.Append( '<a name="koko"></a>' );
967 except
968 //doc.Write( '<a name="koko"></a>' + #13#10 );
969 html.Append( '<a name="koko"></a>' );
970 end;
971 end;
972 end;
973
974 //doc.Write('<a name="bottom"></a>' + #13#10);
975 html.Append('<a name="bottom"></a>' );
976 // ツスツキツδ?ツフツッツタ)
977 try
978 //doc.Write( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) + #13#10 );
979 html.Append( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
980 except
981 end;
982 finally
983 //doc.close;
984 html.EndUpdate;
985 end;
986 end;
987 end;
988 end;
989
990 procedure THTMLCreate.CreateUseCSSHTML(html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
991 var
992 i: integer;
993 No: string;
994 CSSFileName: string;
995 NewReceiveNo: Integer;
996 Res: TResRec;
997 UserOptionalStyle: string;
998 begin
999 if ThreadItem <> nil then begin
1000 //doc.open;
1001 html.BeginUpdate;
1002 try
1003 //doc.charset := 'Shift_JIS';
1004 NewReceiveNo := ThreadItem.NewReceive;
1005 // ツフツォツδ督トツづ「ツサツイツズツて堋静敖墜?/span>
1006 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1007 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1008 if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1009 //CSSツ使ツ用
1010 html.Append('<html><head>');
1011 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1012 html.Append('<title>' + sTitle + '</title>');
1013 html.Append('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1014 if Length( UserOptionalStyle ) > 0 then
1015 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1016 html.Append('</head>');
1017 html.Append('<body>');
1018 html.Append('<a name="top"></a>');
1019 html.Append('<p id="idSearch"></p>');
1020 html.Append('<div class="title">' + sTitle + '</div>');
1021 for i := 0 to ReadList.Count - 1 do begin
1022 // 1 ツづ債必ツつクツ表ツ芝?/span>
1023 if i <> 0 then begin
1024 // ツ表ツ芝堋氾債暗債て堕固板墜?/span>
1025 case GikoSys.ResRange of
1026 Ord( grrKoko ):
1027 if ThreadItem.Kokomade > (i + 1) then
1028 Continue;
1029 Ord( grrNew ):
1030 if NewReceiveNo > (i + 1) then
1031 Continue;
1032 10..65535:
1033 if (threadItem.Count - i) > GikoSys.ResRange then
1034 Continue;
1035 end;
1036 end;
1037
1038 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1039 html.Append('<a name="new"></a><div class="new">ツ新ツ陳?δ個ス <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1040 end;
1041
1042 if (Trim(ReadList[i]) <> '') then begin
1043 No := IntToStr(i + 1);
1044 Res := DivideStrLine(ReadList[i]);
1045 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1046 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1047 if Res.FMailTo = '' then
1048 html.Append('<a name="' + No + '"></a>'
1049 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1050 + '<span class="name_label">ツ滅コツ前ツ:</span> '
1051 + '<span class="name"><b>' + Res.FName + '</b></span> '
1052 + '<span class="date_label">ツ督環稿ツ禿コツ:</span> '
1053 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1054 + '<div class="mes">' + Res.FBody + ' </div>')
1055 else if GikoSys.Setting.ShowMail then
1056 html.Append('<a name="' + No + '"></a>'
1057 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1058 + '<span class="name_label"> ツ滅コツ前ツ: </span>'
1059 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1060 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1061 + '<span class="date_label"> ツ督環稿ツ禿コツ:</span>'
1062 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1063 + '<div class="mes">' + Res.FBody + ' </div>')
1064 else
1065 html.Append('<a name="' + No + '"></a>'
1066 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1067 + '<span class="name_label"> ツ滅コツ前ツ: </span>'
1068 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1069 + '<b>' + Res.FName + '</b></a>'
1070 + '<span class="date_label"> ツ督環稿ツ禿コツ:</span>'
1071 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1072 + '<div class="mes">' + Res.FBody + ' </div>');
1073 end;
1074
1075 if ThreadItem.Kokomade = (i + 1) then begin
1076 html.Append('<a name="koko"></a><div class="koko">ツコツコツづ慊てケツ禿?で?でセ</div>');
1077 end;
1078
1079 end;
1080
1081 html.Append('<a name="bottom"></a>');
1082 html.Append('<a name="last"></a>');
1083 html.Append('</body></html>');
1084 end;
1085 finally
1086 html.EndUpdate;
1087 //doc.Close;
1088 end;
1089 end;
1090 end;
1091
1092 procedure THTMLCreate.CreateDefaultHTML (html: TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
1093 var
1094 i: integer;
1095 No: string;
1096 NewReceiveNo: Integer;
1097 Res: TResRec;
1098 begin
1099 if ThreadItem <> nil then begin
1100 //doc.open;
1101 html.BeginUpdate;
1102 try
1103 //doc.charset := 'Shift_JIS';
1104 NewReceiveNo := ThreadItem.NewReceive;
1105 html.Append('<html><head>');
1106 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1107 html.Append('<title>' + sTitle + '</title></head>');
1108 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1109 html.Append('<a name="top"></a>');
1110 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1111 html.Append('<dl>');
1112 html.Append('<p id="idSearch"></p>');
1113 for i := 0 to ReadList.Count - 1 do begin
1114 // 1 ツづ債必ツつクツ表ツ芝?/span>
1115 if i <> 0 then begin
1116 // ツ表ツ芝堋氾債暗債て堕固板墜?/span>
1117 case GikoSys.ResRange of
1118 Ord( grrKoko ):
1119 if ThreadItem.Kokomade > (i + 1) then
1120 Continue;
1121 Ord( grrNew ):
1122 if NewReceiveNo > (i + 1) then
1123 Continue;
1124 10..65535:
1125 if (threadItem.Count - i) > GikoSys.ResRange then
1126 Continue;
1127 end;
1128 end;
1129
1130 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1131 html.Append('</dl>');
1132 html.Append('<a name="new"></a>');
1133 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>ツ新ツ陳?δ個ス ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
1134 html.Append('<dl>');
1135 end;
1136
1137 if (Trim(ReadList[i]) <> '') then begin
1138 No := IntToStr(i + 1);
1139 Res := DivideStrLine(ReadList[i]);
1140 Res.FBody := ConvRes(AddAnchorTag(Res.FBody), ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true');
1141 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1142 if Res.FMailTo = '' then
1143 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ツ滅コツ前ツ:<font color="forestgreen"><b> ' + Res.FName + ' </b></font> ツ督環稿ツ禿コツ: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>')
1144 else if GikoSys.Setting.ShowMail then
1145 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ツ滅コツ前ツ:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] ツ督環稿ツ禿コツ: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>')
1146 else
1147 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ツ滅コツ前ツ:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> ツ督環稿ツ禿コツ: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>');
1148 end;
1149 if ThreadItem.Kokomade = (i + 1) then begin
1150 html.Append('</dl>');
1151 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>ツコツコツづ慊てケツ禿?で?でセ</b></font></td></tr></table>');
1152 html.Append('<dl>');
1153 end;
1154 end;
1155 html.Append('</dl>');
1156 html.Append('<a name="bottom"></a>');
1157 html.Append('</body></html>');
1158 finally
1159 //doc.Close;
1160 html.EndUpdate;
1161 end;
1162 end;
1163 end;
1164
1165 procedure THTMLCreate.CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);
1166 var
1167 ReadList: TStringList;
1168 CSSFileName: string;
1169 FileName: string;
1170 Res: TResRec;
1171 html: TStringList;
1172 mStream : TMemoryStream;
1173 {$IFDEF DEBUG}
1174 st, rt: Cardinal;
1175 {$ENDIF}
1176 begin
1177 {$IFDEF DEBUG}
1178 Writeln('Create HTML');
1179 st := GetTickCount;
1180 {$ENDIF}
1181 if ThreadItem <> nil then begin
1182 html := TStringList.Create;
1183 try
1184 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1185 CreateUsePluginHTML(html, ThreadItem, sTitle);
1186 end else begin
1187 ShortDayNames[1] := 'ツ禿コ'; ShortDayNames[2] := 'ツ個?#39;;
1188 ShortDayNames[3] := 'ツ嘉?#39;; ShortDayNames[4] := 'ツ青?#39;;
1189 ShortDayNames[5] := 'ツ滅?#39;; ShortDayNames[6] := 'ツ暁?#39;;
1190 ShortDayNames[7] := 'ツ土';
1191
1192 ReadList := TStringList.Create;
1193 try
1194 if ThreadItem.IsLogFile then begin
1195 FileName := ThreadItem.GetThreadFileName;
1196 ReadList.LoadFromFile(FileName);
1197 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1198 GikoSys.FAbon.Execute(ReadList); // ツつ?ツづ堋〜ツで?てセツづ?/span>
1199 GikoSys.FSelectResFilter.Execute(ReadList); //ツδ個スツて堋フツィツδ仰タツδ環δ督グツて堕ね?づゥ
1200 if ThreadItem.Title = '' then begin
1201 Res := DivideStrLine(ReadList[0]);
1202 sTitle := Res.FTitle;
1203 end else
1204 sTitle := ThreadItem.Title
1205 end else begin
1206 sTitle := CustomStringReplace(ThreadItem.Title, 'ツ?猟`', ',');
1207 end;
1208
1209 // ツフツォツδ督トツづ「ツサツイツズツて堋静敖墜?/span>
1210 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1211 if GikoSys.Setting.UseSkin then begin
1212 CreateUseSKINHTML(html, ThreadItem, ReadList);
1213 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1214 CreateUseCSSHTML(html, ThreadItem, ReadList, sTitle);
1215 end else begin
1216 CreateDefaultHTML(html, ThreadItem, ReadList, sTitle);
1217 end;
1218 finally
1219 ReadList.Free;
1220 end;
1221 end;
1222 //WebBrowserツづ可渉堕で、ツ債楪づ?/span>
1223 mStream := TMemoryStream.Create;
1224 try
1225 html.SaveToStream(mStream);
1226 mStream.Seek(soFromBeginning, 0);
1227 (doc as IPersistStreamInit).Load(TStreamAdapter.Create(mStream));
1228 finally
1229 mStream.Free;
1230 end;
1231 finally
1232 html.Free;
1233 end;
1234 end;
1235 {$IFDEF DEBUG}
1236 rt := GetTickCount - st;
1237 Writeln('Done.');
1238 Writeln(IntToStr(rt) + ' ms');
1239 {$ENDIF}
1240 end;
1241
1242 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1243 var
1244 i: integer;
1245 No: string;
1246 //bufList : TStringList;
1247 ReadList: TStringList;
1248 // SaveList: TStringList;
1249 CSSFileName: string;
1250 BBSID: string;
1251 FileName: string;
1252 Res: TResRec;
1253 boardPlugIn : TBoardPlugIn;
1254
1255 UserOptionalStyle: string;
1256 SkinHeader: string;
1257 SkinRes: string;
1258 tmp, tmp1: string;
1259 function LoadSkin( fileName: string ): string;
1260 begin
1261 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1262 end;
1263 function ReplaceRes( skin: string ): string;
1264 begin
1265 Result := SkinedRes( skin, Res, No );
1266 end;
1267
1268 begin
1269 if ThreadItem <> nil then begin
1270 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1271 html.Clear;
1272 html.BeginUpdate;
1273 //if ThreadItem.IsBoardPlugInAvailable then begin
1274 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1275 //===== ツプツδ可グツイツδ督づ可て?づゥツ表ツ芝?/span>
1276 //boardPlugIn := ThreadItem.BoardPlugIn;
1277 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1278 // ツフツォツδ督トツづ「ツサツイツズツて堋静敖墜?/span>
1279 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1280 try
1281 // ツ頁崢篠堋コツーツドツづ債プツδ可グツイツδ督づ可任ツで。ツづゥ
1282 // ツヘツッツダ
1283 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1284 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1285 //ツ静「ツ妥篠参ツ焼?で?ツづァツ堕環妥篠参ツ焼?づ?/span>
1286 if GikoSys.Setting.UseSkin then begin
1287 tmp1 := './' + GikoSys.Setting.CSSFileName;
1288 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1289 tmp1 := CustomStringReplace(tmp1, '\', '/');
1290 tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1291 end else if GikoSys.Setting.UseCSS then begin
1292 tmp1 := './' + CSSFileName;
1293 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1294 tmp1 := CustomStringReplace(tmp1, '\', '/');
1295 tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1296 end;
1297 html.Append( tmp );
1298
1299 for i := 0 to threadItem.Count - 1 do begin
1300
1301 // ツδ個ス
1302 html.Append( ConvertResAnchor(boardPlugIn.GetRes( DWORD( threadItem ), i + 1 )) );
1303
1304 end;
1305 // ツスツキツδ?ツフツッツタ)
1306 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1307 finally
1308 end;
1309 html.EndUpdate;
1310 //Exit;
1311 end else begin
1312 ShortDayNames[1] := 'ツ禿コ'; ShortDayNames[2] := 'ツ個?#39;;
1313 ShortDayNames[3] := 'ツ嘉?#39;; ShortDayNames[4] := 'ツ青?#39;;
1314 ShortDayNames[5] := 'ツ滅?#39;; ShortDayNames[6] := 'ツ暁?#39;;
1315 ShortDayNames[7] := 'ツ土';
1316 BBSID := ThreadItem.ParentBoard.BBSID;
1317 ReadList := TStringList.Create;
1318 try
1319 if ThreadItem.IsLogFile then begin
1320 FileName := ThreadItem.GetThreadFileName;
1321 ReadList.LoadFromFile(FileName);
1322 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1323 GikoSys.FAbon.Execute(ReadList); // ツつ?ツづ堋〜ツで?てセツづ?/span>
1324 GikoSys.FSelectResFilter.Execute(ReadList); //ツδ個スツて堋フツィツδ仰タツδ環δ督グツて堕ね?づゥ
1325 Res := DivideStrLine(ReadList[0]);
1326 //Res.FTitle := CustomStringReplace(Res.FTitle, 'ツ?猟`', ',');
1327 sTitle := Res.FTitle;
1328 end else begin
1329 sTitle := CustomStringReplace(ThreadItem.Title, 'ツ?猟`', ',');
1330 end;
1331 try
1332 // ツフツォツδ督トツづ「ツサツイツズツて堋静敖墜?/span>
1333 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1334
1335 if GikoSys.Setting.UseSkin then begin
1336 // ツスツキツδ督使ツ用
1337 // ツスツキツδ督て堋静敖墜?/span>
1338 try
1339 SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1340 if Length( UserOptionalStyle ) > 0 then
1341 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1342 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1343 //ツ静「ツ妥篠参ツ焼?で?ツづァツ堕環妥篠参ツ焼?づ?/span>
1344 tmp1 := './' + GikoSys.Setting.CSSFileName;
1345 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1346 tmp1 := CustomStringReplace(tmp1, '\', '/');
1347 SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1348 html.Append( SkinHeader );
1349 except
1350 end;
1351 try
1352 SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1353 except
1354 end;
1355 html.Append('<a name="top"></a>');
1356 for i := 0 to ReadList.Count - 1 do begin
1357 if (Trim(ReadList[i]) <> '') then begin
1358 No := IntToStr(i + 1);
1359
1360 Res := DivideStrLine(ReadList[i]);
1361 Res.FBody := AddAnchorTag(Res.FBody);
1362 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1363
1364 try
1365 html.Append( ReplaceRes( SkinRes ) );
1366 except
1367 end;
1368 end;
1369
1370 end;
1371 html.Append('<a name="bottom"></a>');
1372 // ツスツキツδ?ツフツッツタ)
1373 try
1374 html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1375 except
1376 end;
1377 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1378 //CSSツ使ツ用
1379 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1380 html.Append('<html><head>');
1381 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1382 html.Append('<title>' + sTitle + '</title>');
1383 //ツ静「ツ妥篠参ツ焼?で?ツづァツ堕環妥篠参ツ焼?づ?/span>
1384 tmp1 := './' + CSSFileName;
1385 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1386 tmp1 := CustomStringReplace(tmp1, '\', '/');
1387
1388 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1389 if Length( UserOptionalStyle ) > 0 then
1390 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1391 html.Append('</head>');
1392 html.Append('<body>');
1393 html.Append('<a name="top"></a>');
1394 html.Append('<div class="title">' + sTitle + '</div>');
1395 for i := 0 to ReadList.Count - 1 do begin
1396 if (Trim(ReadList[i]) <> '') then begin
1397 No := IntToStr(i + 1);
1398 Res := DivideStrLine(ReadList[i]);
1399 Res.FBody := AddAnchorTag(Res.FBody);
1400 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1401 if Res.FMailTo = '' then
1402 html.Append('<a name="' + No + '"></a>'
1403 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1404 + '<span class="name_label">ツ滅コツ前ツ:</span> '
1405 + '<span class="name"><b>' + Res.FName + '</b></span> '
1406 + '<span class="date_label">ツ督環稿ツ禿コツ:</span> '
1407 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1408 + '<div class="mes">' + Res.FBody + ' </div>')
1409 else if GikoSys.Setting.ShowMail then
1410 html.Append('<a name="' + No + '"></a>'
1411 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1412 + '<span class="name_label"> ツ滅コツ前ツ: </span>'
1413 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1414 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1415 + '<span class="date_label"> ツ督環稿ツ禿コツ:</span>'
1416 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1417 + '<div class="mes">' + Res.FBody + ' </div>')
1418 else
1419 html.Append('<a name="' + No + '"></a>'
1420 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1421 + '<span class="name_label"> ツ滅コツ前ツ: </span>'
1422 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1423 + '<b>' + Res.FName + '</b></a>'
1424 + '<span class="date_label"> ツ督環稿ツ禿コツ:</span>'
1425 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1426 + '<div class="mes">' + Res.FBody + ' </div>');
1427 end;
1428 end;
1429 html.Append('<a name="bottom"></a>');
1430 html.Append('<a name="last"></a>');
1431 html.Append('</body></html>');
1432 end else begin
1433 //CSSツ版?使ツ用
1434 html.Append('<html><head>');
1435 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1436 html.Append('<title>' + sTitle + '</title></head>');
1437 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1438 html.Append('<a name="top"></a>');
1439 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1440 html.Append('<dl>');
1441 for i := 0 to ReadList.Count - 1 do begin
1442 if (Trim(ReadList[i]) <> '') then begin
1443 No := IntToStr(i + 1);
1444 Res := DivideStrLine(ReadList[i]);
1445 Res.FBody := AddAnchorTag(Res.FBody);
1446 Res.FBody := ConvertResAnchor(ConvRes(Res.FBody, ThreadItem.ParentBoard.BBSID, ChangeFileExt(ThreadItem.FileName, ''), 'bbs', 'key', 'st', 'to', 'nofirst', 'true', true));
1447 if Res.FMailTo = '' then
1448 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ツ滅コツ前ツ:<font color="forestgreen"><b> ' + Res.FName + ' </b></font> ツ督環稿ツ禿コツ: ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1449 else if GikoSys.Setting.ShowMail then
1450 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ツ滅コツ前ツ:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] ツ督環稿ツ禿コツ: ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1451 else
1452 html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ツ滅コツ前ツ:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> ツ督環稿ツ禿コツ: ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1453 end;
1454 end;
1455 html.Append('</dl>');
1456 html.Append('<a name="bottom"></a>');
1457 html.Append('</body></html>');
1458 end;
1459 finally
1460 html.EndUpdate;
1461 end;
1462 finally
1463 ReadList.Free;
1464 end;
1465 end;
1466 end;
1467 end;
1468
1469 initialization
1470 HTMLCreater := THTMLCreate.Create;
1471
1472 finalization
1473 if HTMLCreater <> nil then begin
1474 HTMLCreater.Free;
1475 HTMLCreater := nil;
1476 end;
1477
1478 end.

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