Develop and Download Open Source Software

ギコナビ(避難所版)

Browse CVS Repository

/[OSDN]/gikonavigoeson/gikonavi/HTMLCreate.pas

Contents of /gikonavigoeson/gikonavi/HTMLCreate.pas

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

Revision 1.44 - (show annotations) (download) (as text)
Mon Oct 5 14:23:13 2009 UTC (14 years, 5 months ago) by h677
Branch: MAIN
CVS Tags: v1_63_1_819, v1_62_0_812, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_62_0_803, v1_62_0_802, v1_62_0_809, v1_62_0_810, v1_62_0_811, v1_62_1_813, v1_61_0_800, v1_61_1_801, HEAD
Branch point for: Bb62, Bb63, Bb61
Changes since 1.43: +16 -4 lines
File MIME type: text/x-pascal 
refs #17840
HTML化した際に、レスアンカーのタグ内で、ダブルクォートが２つつながる不具合の修正
1 unit HTMLCreate;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, {Graphics,} Controls, {Forms,}
7 ComCtrls, IniFiles, ShellAPI, Math, GikoSystem,
8 {$IF Defined(DELPRO) }
9 SHDocVw,
10 MSHTML,
11 {$ELSE}
12 SHDocVw_TLB,
13 MSHTML_TLB,
14 {$IFEND}
15 {HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,}
16 {bmRegExp,} AbonUnit, MojuUtils, Setting,
17 ExternalBoardManager, ExternalBoardPlugInMain{,}
18 {Sort,} ,GikoBayesian, {HintWindow,} ActiveX, ResPopupBrowser;
19
20 type
21
22 PResLinkRec = ^TResLinkRec;
23 TResLinkRec = record
24 FBbs: string;
25 FKey : string;
26 end;
27
28 TBufferedWebBrowser = class(TStringList)
29 private
30 //! ?吾??莨若??????????/span>
31 FBrowser: TWebBrowser;
32 //! 篏?茵??障?с???????????泣?ゃ??/span>
33 FBuffSize: Integer;
34 //! ???????吟??HTMLDocument2?ゃ?潟?帥???с?若?鴻??篆??????? open????close??????/span>
35 FBrowserDoc: OleVariant;
36 public
37 constructor Create(Browser: TWebBrowser; BuffSize: Integer);
38 destructor Destory;
39 procedure Open;
40 procedure Close;
41 procedure Flush;
42 function Add(const S: string): Integer; override;
43 end;
44 THTMLCreate = class(TObject)
45 private
46 { Private 絎ｈ? }
47 anchorLen : Integer;
48 pURLCHARs,pURLCHARe : PChar;
49 pANCHORs, pANCHORe : PChar;
50 pCTAGLs, pCTAGLe : PChar;
51 pCTAGUs, pCTAGUe : PChar;
52 pREF_MARKSs : array[0..9] of PChar;
53 pREF_MARKSe : array[0..9] of PChar;
54 constructor Create;
55
56 function AddBeProfileLink(AID : string; ANum: Integer):string ;
57 procedure CreateUsePluginHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
58 procedure CreateUseSKINHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList);
59 procedure CreateUseCSSHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
60 procedure CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
61 procedure ConvertResAnchor(PRes: PResRec);
62 procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
63 function checkComma(const s : String; var j : Integer) : boolean;
64 function addResAnchor(PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
65 var s : String; j : Integer; const No: String) : string;
66 function appendResAnchor(PAddRes: PResRec; PResLink : PResLinkRec;
67 dat : boolean; var s : String) : string;
68 function getNumberString(const str: String;var index :Integer; var dbCharlen: Boolean;
69 sLen :Integer): String;
70 function isOutsideRange(item: TThreadItem; index: Integer ): Boolean;
71 function getKeywordLink(item: TThreadItem): String;
72 function GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
73 public
74 { Public 絎ｈ? }
75 procedure AddAnchorTag(PRes: PResRec);
76 function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;
77 function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;
78 procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;
79 procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
80 procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
81 //???鴻???????≪?????????
82 procedure SetResPopupText(Hint :TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
83 //???潟??????絖??????????鴻???????≪????????RL?????????
84 class function GetRespopupURL(AText, AThreadURL : string): string;
85 //??絎????????鴻???鴻???潟???????SS?????＜?ゃ?????潟???若??篏???
86 class procedure SkinorCSSFilesCopy(path: string);
87 //dat鐚?茵??????鴻????茹ｃ????
88 class procedure DivideStrLine(Line: string; PRes: PResRec);
89 //HTML???????潟???帥?違?????ゃ????
90 class function DeleteLink(const s: string): string;
91 //HTML???????ｃ??┗????????絖?????舟??????
92 class function RepHtml(const s: string): string;
93 //???鴻?????ｃ?帥?????????ャ?主??TML??篏???????
94 class function CreatePreviewHTML(const Title: string; const No: string;
95 const Mail: string; const Namae: string; const Body: string ) : string;
96 end;
97
98 var
99 HTMLCreater: THTMLCreate;
100
101 implementation
102
103 uses
104 Trip;
105
106 const
107 URL_CHAR: string = '0123456789'
108 + 'abcdefghijklmnopqrstuvwxyz'
109 + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
110 + '#$%&()*+,-./:;=?@[]^_`{|}~!''\';
111 ANCHOR_REF = 'href=';
112 CLOSE_TAGAL = '</a>';
113 CLOSE_TAGAU = '</A>';
114 RES_REF = '&gt;&gt;';
115 REF_MARK: array[0..9] of string = ('http://', 'ttp://', 'tp://',
116 'ms-help://','p://', 'https://',
117 'www.', 'ftp://','news://','rtsp://');
118
119 constructor THTMLCreate.Create;
120 var
121 j : Integer;
122 begin
123 // + 3 ? 'href="' ('"'?ゃ??)?????????????若?激?с?潟???茖???????????????
124 anchorLen := Length( ANCHOR_REF ) + 3;
125 pANCHORs := PChar(ANCHOR_REF);
126 pANCHORe := pANCHORs + Length(ANCHOR_REF);
127 pURLCHARs := PChar(URL_CHAR);
128 pURLCHARe := pURLCHARs + Length(URL_CHAR);
129 pCTAGLs := PChar(CLOSE_TAGAL);
130 pCTAGLe := pCTAGLs + 4;
131 pCTAGUs := PChar(CLOSE_TAGAU);
132 pCTAGUe := pCTAGUs + 4;
133 for j := 0 to 9 do begin
134 pREF_MARKSs[j] := PChar(REF_MARK[j]);
135 pREF_MARKSe[j] := pREF_MARKSs[j] + Length(REF_MARK[j]);
136 end;
137 end;
138 // ?鴻???潟??茯??粋昭?帥???ゃ??臀??????
139 function THTMLCreate.LoadFromSkin(
140 fileName: string;
141 ThreadItem: TThreadItem;
142 SizeByte: Integer
143 ): string;
144 var
145 Skin: TStringList;
146 begin
147
148 Skin := TStringList.Create;
149 try
150 if FileExists( fileName ) then begin
151 Skin.LoadFromFile( fileName );
152
153 // ???????????????????????????激?с?潟???ゃ?≪???違?????????ャ?主? try
154 try
155 if ThreadItem.ParentBoard <> nil then
156 if ThreadItem.ParentBoard.ParentCategory <> nil then
157 CustomStringReplace( Skin, '<BBSNAME/>', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
158 CustomStringReplace( Skin, '<THREADURL/>', ThreadItem.URL);
159 except end;
160 CustomStringReplace( Skin, '<BOARDNAME/>', ThreadItem.ParentBoard.Title);
161 CustomStringReplace( Skin, '<BOARDURL/>', ThreadItem.ParentBoard.URL);
162 CustomStringReplace( Skin, '<THREADNAME/>', ThreadItem.Title);
163 CustomStringReplace( Skin, '<SKINPATH/>', GikoSys.Setting.CSSFileName);
164 CustomStringReplace( Skin, '<GETRESCOUNT/>', IntToStr( ThreadItem.Count - ThreadItem.NewResCount ));
165 CustomStringReplace( Skin, '<NEWRESCOUNT/>', IntToStr( ThreadItem.NewResCount ));
166 CustomStringReplace( Skin, '<ALLRESCOUNT/>', IntToStr( ThreadItem.Count ));
167
168 CustomStringReplace( Skin, '<NEWDATE/>',FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
169 CustomStringReplace( Skin, '<SIZEKB/>', IntToStr( Floor( SizeByte / 1024 ) ));
170 CustomStringReplace( Skin, '<SIZE/>', IntToStr( SizeByte ));
171
172 //----- ?????????????＜????????篋????????潟?＜?潟???≪??????????????
173 // ???????????????????????????激?с?潟???ゃ?≪???違?????????ャ?主? try
174 if GikoSys.Setting.UseKatjushaType then begin
175 try
176 if ThreadItem.ParentBoard <> nil then
177 if ThreadItem.ParentBoard.ParentCategory <> nil then
178 CustomStringReplace( Skin, '&BBSNAME', ThreadItem.ParentBoard.ParentCategory.ParenTBBS.Title);
179 CustomStringReplace( Skin, '&THREADURL', ThreadItem.URL);
180 except end;
181 CustomStringReplace( Skin, '&BOARDNAME', ThreadItem.ParentBoard.Title);
182 CustomStringReplace( Skin, '&BOARDURL', ThreadItem.ParentBoard.URL);
183 CustomStringReplace( Skin, '&THREADNAME', ThreadItem.Title);
184 CustomStringReplace( Skin, '&SKINPATH', GikoSys.Setting.CSSFileName);
185 CustomStringReplace( Skin, '&GETRESCOUNT', IntToStr( ThreadItem.NewReceive - 1 ));
186 CustomStringReplace( Skin, '&NEWRESCOUNT', IntToStr( ThreadItem.NewResCount ));
187 CustomStringReplace( Skin, '&ALLRESCOUNT', IntToStr( ThreadItem.AllResCount ));
188
189 CustomStringReplace( Skin, '&NEWDATE', FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate));
190 CustomStringReplace( Skin, '&SIZEKB', IntToStr( Floor( SizeByte / 1024 ) ));
191 CustomStringReplace( Skin, '&SIZE', IntToStr( SizeByte ));
192 end
193 //----- ?????障??/span>
194 end;
195 Result := Skin.Text;
196 finally
197 Skin.Free;
198 end;
199 end;
200
201 // ???鴻???ゃ??臀??????
202 function THTMLCreate.SkinedRes(
203 const skin: string;
204 PRes: PResRec;
205 const No: string
206 ): string;
207 const
208 FORMT_NAME = '<b>%s</b>';
209 FORMT_NUM = '<a href="menu:%s" name="%s">%s</a>';
210 FORMT_MAILNAME = '<a href="mailto:%s"><b>%s</b></a>';
211 var
212 spamminess : Extended;
213 {$IFDEF SPAM_FILTER_ENABLED}
214 wordCount : TWordCount;
215 {$ENDIF}
216 begin
217 {$IFDEF SPAM_FILTER_ENABLED}
218 wordCount := TWordCount.Create;
219 try
220 spamminess := Floor( GikoSys.SpamParse(
221 Res.FName + '<>' + Res.FMailTo + '<>' + Res.FBody, wordCount ) * 100 );
222 {$ELSE}
223 spamminess := 0;
224 {$ENDIF}
225 Result := CustomStringReplace( skin, '<SPAMMINESS/>', FloatToStr( spamminess ) );
226 Result := CustomStringReplace( Result, '<NONSPAMMINESS/>', FloatToStr( 100 - spamminess ) );
227 Result := CustomStringReplace( Result, '<MAIL/>', PRes.FMailTo);
228 Result := CustomStringReplace( Result, '<DATE/>', PRes.FDateTime);
229 Result := CustomStringReplace( Result, '<PLAINNUMBER/>', No);
230 Result := CustomStringReplace( Result, '<NAME/>',
231 Format(FORMT_NAME, [PRes.FName]));
232 Result := CustomStringReplace( Result, '<NUMBER/>',
233 Format(FORMT_NUM, [No, No, No]));
234 Result := CustomStringReplace( Result, '<MAILNAME/>',
235 Format(FORMT_MAILNAME,[PRes.FMailTo, PRes.FName]));
236 Result := CustomStringReplace( Result, '<MESSAGE/>', PRes.FBody);
237
238 //----- ???＜????????篋????????潟?＜?潟???≪??????????????
239 if GikoSys.Setting.UseKatjushaType then begin
240 Result := CustomStringReplace( Result, '&NUMBER',
241 '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
242 Result := CustomStringReplace( Result, '&PLAINNUMBER', No);
243 Result := CustomStringReplace( Result, '&NAME', '<b>' + PRes.FName + '</b>');
244 Result := CustomStringReplace( Result, '&MAILNAME',
245 '<a href="mailto:' + PRes.FMailTo + '"><b>' + PRes.FName + '</b></a>');
246 Result := CustomStringReplace( Result, '&MAIL', PRes.FMailTo);
247 Result := CustomStringReplace( Result, '&DATE', PRes.FDateTime);
248 Result := CustomStringReplace( Result, '&MESSAGE', PRes.FBody);
249 Result := CustomStringReplace( Result, '&SPAMMINESS', FloatToStr( spamminess ) );
250 Result := CustomStringReplace( Result, '&NONSPAMMINESS', FloatToStr( 100 - spamminess ) );
251 end;
252 //----- ?????障??/span>
253 {$IFDEF SPAM_FILTER_ENABLED}
254 finally
255 wordCount.Free;
256 end;
257 {$ENDIF}
258
259 end;
260 (*************************************************************************
261 *http://????絖?????anchor?帥?遺???????????
262 *************************************************************************)
263 procedure THTMLCreate.AddAnchorTag(PRes: PResRec);
264 const
265 _HEAD : array[0..9] of String =
266 ('', 'h', 'ht', '', 'htt', '', 'http://', '', '', '');
267 var
268 url: string;
269 href: string;
270 i, j, b: Integer;
271 tmp: Integer;
272 idx, idx2: Integer;
273 pos : PChar;
274 pp, pe : PChar;
275 s : String;
276 len : Integer;
277 begin
278 s := PRes.FBody;
279 PRes.FBody := '';
280
281 //while True do begin
282 repeat
283 idx := MaxInt;
284 idx2 := MaxInt;
285 pp := PChar(s);
286 pe := pp + Length(s);
287
288 for j := 0 to 9 do begin
289 pos := AnsiStrPosEx(pp, pe, pREF_MARKSs[j], pREF_MARKSe[j]);
290 if pos <> nil then begin
291 tmp := pos - pp + 1;
292 idx := Min(tmp, idx);
293 if idx = tmp then idx2 := j; //???????若???у??ｃ?????ｃ??????篆?絖?
294 end;
295 end;
296
297 if idx = MaxInt then begin
298 //???潟?????＜??????
299 len := Length(PRes.FBody);
300 SetLength(PRes.FBody, Length(s) + len);
301 Move(pp^, PRes.FBody[len + 1], Length(s));
302 end else begin
303 if (idx > anchorLen) and
304 (AnsiStrPosEx(pp + idx - 1 - anchorLen, pp + idx, pANCHORs, pANCHORe) <> nil) then begin
305 //?≪?????潟???帥?違???ゃ?????????ｃ?純????????????/span>
306 //</a></A>???≪????絨??絖??ц??ゃ???????????医ぇ??絖??ф?膣?/span>
307 pos := AnsiStrPosEx(pp + idx, pe, pCTAGLs, pCTAGLe);
308 if pos = nil then
309 pos := AnsiStrPosEx(pp + idx, pe, pCTAGUs, pCTAGUe);
310 if pos = nil then
311 b := Length(REF_MARK[idx2])
312 else
313 b := pos - (pp + idx) + 1;
314
315 len := Length(PRes.FBody);
316 SetLength(PRes.FBody, len + idx + b );
317 Move(pp^, PRes.FBody[len + 1], idx + b);
318 Delete(s, 1, idx + b);
319 end else begin
320 pp := PChar(s);
321 len := Length(PRes.FBody);
322 SetLength(PRes.FBody, len + idx - 1);
323 Move(pp^, PRes.FBody[len + 1], idx - 1);
324
325 Delete(s, 1, idx - 1);
326 b := Length( s ) + 1;
327 pp := PChar(s);
328 for i := 1 to b do begin
329 //鐚????ゃ????絖???RL??戎????????絖?????
330 if (AnsiStrPosEx(pURLCHARs, pURLCHARe, pp, pp + 1) = nil) then begin
331 url := Copy(s, 1, i - 1);
332 Delete(s, 1, i - 1);
333 href := Format('%s%s', [_HEAD[idx2], url]);
334 PRes.FBody
335 := Format('%s<a href="%s" target="_blank">%s</a>', [PRes.FBody, href, url]);
336 Break;
337 end;
338 //筝???絖??蚊??????
339 Inc(pp);
340 end;
341 end;
342 end;
343 until idx = MaxInt;
344 end;
345
346 //綣??違??AID鐚?絲乗院???????ヤ?ID??絖?????ANum:???合? AURL鐚??????鴻????????RL
347 function THTMLCreate.AddBeProfileLink(AID : string; ANum: Integer):string ;
348 const
349 BE_MARK : string = 'BE:';
350 var
351 p : integer;
352 BNum, BMark : string;
353 begin
354 p := AnsiPos(BE_MARK, AnsiUpperCase(AID));
355 if p > 0 then begin
356 BNum := Copy(AID, p, Length(AID));
357 AID := Copy(AID, 1, p - 1);
358 p := AnsiPos('-', BNum);
359 if p > 0 then begin
360 BMark := '?' + Trim(Copy(BNum, p + 1, Length(BNum)));
361 BNum := Copy(BNum, 1, p - 1);
362 end;
363 BNum := Trim(BNum);
364 Result := AID + ' <a href="' + BNum + '/' + IntToStr(ANum)
365 + '" target=_blank>' + BMark + '</a>';
366 end else
367 Result := AID;
368 end;
369 //! ???鴻?≪?潟???若?????合??垩?????蚊????
370 // Text = '1-9' -> st = '1'; et = '9'
371 // Text = '10' -> st = '10'; et = '10'
372 procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text:String; const Separator: String);
373 var
374 p : Integer;
375 begin
376 p := Pos(Separator,Text);
377 if (p > 0 ) then begin
378 st := Copy(Text, 1, p - 1);
379 et := Copy(Text, p + Length(Separator), Length(Text));
380 end else begin
381 st := Text;
382 et := Text;
383 end;
384 end;
385 //! ???鴻?≪?潟???若???????????????合??垩????絖???????緇?????
386 function THTMLCreate.getNumberString(
387 const str: String;
388 var index :Integer; var dbCharlen: Boolean; sLen :Integer)
389 : String;
390 const
391 SN = '0123456789';
392 var
393 ch : String;
394 sw : Boolean;
395 begin
396 Result := '';
397 sw := False;
398 while (index <= sLen) do begin
399 if (ByteType(str, index) = mbSingleByte) then begin
400 //1byte??絖?
401 ch := str[index];
402 Inc(index);
403 dbCharlen := false;
404 end else begin
405 //2byte??絖?
406 ch := ZenToHan(Copy(str, index, 2));
407 Inc(index, 2);
408 dbCharlen := true;
409 end;
410
411 if System.Pos(ch, SN) > 0 then begin
412 Result := Result + ch;
413 end else if (ch = '-') then begin
414 if sw then break;
415 if Result = '' then break;
416 Result := Result + ch;
417 sw := true;
418 end else begin
419 break;
420 end;
421 end;
422 end;
423
424 procedure THTMLCreate.ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false);
425 const
426 GT = '&gt;';
427 //罎?膣√?莟＜????絖?????/span>
428 TOKEN : array[0..5] of string = (GT+GT, GT, '鐚?鐚?', '鐚?', '<a ', '<A ');
429 var
430 i : integer;
431 s : string;
432 No: string;
433 pos, pmin : integer;
434 j : integer;
435 db : boolean;
436 rink : string;
437 begin
438 //s ?????????????ャ????
439 s := PRes.FBody;
440 //腟???????????/span>
441 PRes.FBody := '';
442
443 //
444 while Length(s) > 2 do begin
445 pmin := Length(s) + 1;
446 i := Length(token);
447 for j := 0 to 5 do begin
448 pos := AnsiPos(TOKEN[j], s);
449 if pos <> 0 then begin
450 if pos < pmin then begin
451 //?????с????????????篆?絖?
452 i := j;
453 //??絨?ゃ???贋??/span>
454 pmin := pos;
455 end;
456 end;
457 end;
458
459 //????????????絖???????ゆ?????障?х??????潟????/span>
460 PRes.FBody := PRes.FBody + Copy(s, 1, pmin - 1);
461 Delete(s, 1, pmin - 1);
462
463 if i = 6 then begin
464 //??????????
465 end else if (i = 4) or (i = 5) then begin
466 //'<a ' or '<A' ?с?????? '</a>' or '</A>' ?障?с?潟????/span>
467 pmin := AnsiPos('</a>' , s);
468 pos := AnsiPos('</A>' , s);
469 if (pmin <> 0) and (pos <> 0) then begin
470 if (pmin > pos) then begin
471 pmin := pos;
472 end;
473 end else if (pos <> 0) then begin
474 pmin := pos;
475 end;
476 rink := Copy(s, 1, pmin + 3);
477 PRes.FBody := PRes.FBody + rink;
478 Delete(s, 1, pmin + 3);
479
480 pmin := Length(rink);
481 i := Length(TOKEN);
482 for j := 0 to 3 do begin
483 pos := AnsiPos(TOKEN[j], rink);
484 if pos <> 0 then begin
485 if pos < pmin then begin
486 //?????с????????????篆?絖?
487 i := j;
488 //??絨?ゃ???贋??/span>
489 pmin := pos;
490 end;
491 end;
492 end;
493 // ???鴻?≪?潟???若?????障??????????,??膓???????≪?潟???若???????宴??
494 if i <= 3 then begin
495 appendResAnchor(PRes, PResLink, DatToHTML, s );
496 end;
497 end else begin
498 //篏???????荀??ゃ???ｃ?????帥?若??/span>
499 j := Length(TOKEN[i]) + 1;
500 db := false;
501 No := getNumberString(s, j, db, Length(s) );
502 //腟?腴??障?ц??ｃ?????篋??????с????/span>
503 if j <= Length(s) then begin
504 if db then j := j - 2
505 else j := j - 1;
506 end;
507 addResAnchor(PRes, PResLink, DatToHTML, s, j, No);
508
509 // , ??膓?????????鴻?≪?潟???若??????????????
510 appendResAnchor(PRes, PResLink, DatToHTML, s );
511 end;
512 end;
513 if Length(s) > 0 then begin
514 PRes.FBody := PRes.FBody + s;
515 end;
516 end;
517 function THTMLCreate.checkComma(
518 const s : String;
519 var j : Integer
520 ) : boolean;
521 var
522 bType : TMbcsByteType;
523 begin
524 Result := false;
525 if (Length(s) > 0) then begin
526 bType := ByteType(s, j);
527 if ((bType = mbSingleByte) and (s[j] = ',') or
528 ((bType = mbLeadByte) and (ZenToHan(Copy(s, j ,2)) = ','))) then begin
529 Result := true;
530 if (bType = mbSingleByte) then
531 Inc(j)
532 else
533 Inc(j, 2);
534 end;
535 end;
536 end;
537 function THTMLCreate.appendResAnchor(
538 PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
539 var s : String) : string;
540 var
541 No{, ch, oc}: String;
542 len, j : Integer;
543 cm, {sw,} db : Boolean;
544
545 begin
546 No := '';
547 j := 1;
548 cm := checkComma(s, j);
549 len := Length(s);
550 while cm do begin
551 db := false;
552 No := getNumberString(s, j, db, len );
553
554 //腟?腴??障?ц??ｃ?????篋??????с????/span>
555 if j <= len then begin
556 if db then j := j - 2
557 else j := j - 1;
558 end;
559 addResAnchor(PAddRes, PResLink, dat, s, j, No);
560 j := 1;
561 len := Length(s);
562 cm := checkComma(s, j);
563 end;
564 end;
565
566 function THTMLCreate.addResAnchor(
567 PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
568 var s : String; j : Integer; const No: String) : string;
569 const
570 FORMAT_LINK = '<a href="../test/read.cgi?bbs=%s&key=%s&st=%s&to=%s&nofirst=true" target="_blank">';
571 var
572 st,et : string;
573 begin
574
575 //篏????医???荀??ゃ????????????
576 if No = '' then begin
577 PAddRes.FBody := PAddRes.FBody + Copy(s, 1, j - 1);
578 end else begin
579 separateNumber(st, et, No, '-');
580
581 if not dat then begin
582 PAddRes.FBody := PAddRes.FBody +
583 Format(FORMAT_LINK, [PResLink.FBbs, PResLink.FKey, st, et]);
584 end else begin
585 PAddRes.FBody := PAddRes.FBody + Format('<a href="#%s">', [st]);
586 end;
587 PAddRes.FBody := PAddRes.FBody + Copy(s, 1, j - 1) + '</a>';
588 end;
589 Delete(s, 1, j - 1);
590 end;
591
592
593 procedure THTMLCreate.ConvertResAnchor(PRes: PResRec);
594 const
595 _HEAD : string = '<a href="../';
596 _TAIL : string = ' target="_blank">';
597 _ST: string = '&st=';
598 _TO: string = '&to=';
599 _STA: string = '&START=';
600 _END: string = '&END=';
601 var
602 i, j, k: Integer;
603 hpos, qpos : Integer;
604 tmp: string;
605 res: string;
606 begin
607 res := PRes.FBody;
608 PRes.FBody := '';
609 i := AnsiPos(_HEAD, res);
610 while i <> 0 do begin
611 PRes.FBody := PRes.FBody + Copy(res, 1, i -1);
612 Delete(res, 1, i - 1);
613 j := AnsiPos(_TAIL, res);
614 if j = 0 then begin
615 PRes.FBody := PRes.FBody + res;
616 Exit;
617 end;
618 tmp := Copy(res, 1, j - 1);
619 Delete(res, 1, j + 16);
620 if (AnsiPos(_ST, tmp) <> 0) and (AnsiPos(_TO, tmp) <> 0) then begin
621 Delete(tmp, 1, AnsiPos(_ST, tmp) + 3);
622 Delete(tmp, AnsiPos(_TO, tmp), Length(tmp));
623 PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
624 end else if (AnsiPos(_STA, tmp) <> 0) and (AnsiPos(_END, tmp) <> 0) then begin
625 Delete(tmp, 1, AnsiPos(_STA, tmp) + 6);
626 Delete(tmp, AnsiPos(_END, tmp), Length(tmp));
627 PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
628 end else begin
629 k := LastDelimiter('/', tmp);
630 Delete(tmp, 1, k);
631 hpos := AnsiPos('-', tmp);
632 qpos := AnsiPos('"', tmp);
633 if ( (hpos > 0) and (qpos > 0) ) then begin
634 if ( qpos < hpos ) then begin
635 Delete(tmp, qpos, Length(tmp));
636 end else begin
637 Delete(tmp, hpos, Length(tmp));
638 end;
639 end else begin
640 if ( qpos > 0 ) then begin
641 Delete(tmp, qpos, Length(tmp));
642 end else if ( qpos > 0 ) then begin
643 Delete(tmp, hpos, Length(tmp));
644 end;
645 end;
646
647 PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
648 end;
649 i := AnsiPos(_HEAD, res);
650 end;
651 PRes.FBody := PRes.FBody + res;
652
653 end;
654 //Plugin??????????Board???鴻????????TML??篏???????oc???吾??莨若??
655 procedure THTMLCreate.CreateUsePluginHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
656 var
657 i: integer;
658 NewReceiveNo: Integer;
659 boardPlugIn : TBoardPlugIn;
660 UserOptionalStyle: string;
661 begin
662 //===== ?????違?ゃ?潟??????茵?ず
663 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
664 NewReceiveNo := ThreadItem.NewReceive;
665 // ?????潟?????泣?ゃ?冴??┃絎?
666 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
667 html.add(boardPlugIn.GetHeader( DWORD( threadItem ),
668 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
669 html.Add('<p id="idSearch"></p>');
670 html.Flush;
671
672 for i := 0 to threadItem.Count - 1 do begin
673 // 1 ?????茵?ず
674 if i <> 0 then begin
675 // 茵?ず膀??蚊????絎?
676 if (isOutsideRange(ThreadItem, i)) then begin
677 Continue;
678 end;
679 end;
680
681 // ?亥?????若??/span>
682 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
683 try
684 if GikoSys.Setting.UseSkin then begin
685 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
686 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
687 else
688 html.Add( '<a name="new"></a>');
689 end else if GikoSys.Setting.UseCSS then begin
690 html.Add('<a name="new"></a><div class="new">?亥????? <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
691 end else begin
692 html.Add('</dl>');
693 html.Add('<a name="new"></a>');
694 html.Add('<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>');
695 html.Add('<dl>');
696 end;
697 except
698 html.Add( '<a name="new"></a>');
699 end;
700 end;
701
702 // ????/span>
703 html.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ));
704
705 if ThreadItem.Kokomade = (i + 1) then begin
706 // ?????障?ц?????
707 try
708 if GikoSys.Setting.UseSkin then begin
709 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
710 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
711 else
712 html.Add( '<a name="koko"></a>');
713 end else if GikoSys.Setting.UseCSS then begin
714 html.Add('<a name="koko"></a><div class="koko">?潟?潟?障?ц?????</div>');
715 end else begin
716 html.Add('</dl>');
717 html.Add('<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>');
718 html.Add('<dl>');
719 end;
720 except
721 html.Add('<a name="koko"></a>');
722 end;
723 end;
724 end;
725
726
727 // ?鴻??????????
728 html.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ));
729 end;
730
731
732 procedure THTMLCreate.CreateUseSKINHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList);
733 const
734 KOKO_TAG = '<a name="koko"></a>';
735 NEW_TAG = '<a name="new"></a>';
736 var
737 i: integer;
738 NewReceiveNo: Integer;
739 Res: TResRec;
740 UserOptionalStyle: string;
741 SkinHeader: string;
742 SkinNewRes: string;
743 SkinRes: string;
744 ThreadName : string;
745 ResLink :TResLinkRec;
746 begin
747 NewReceiveNo := ThreadItem.NewReceive;
748 // ?????潟?????泣?ゃ?冴??┃絎?
749 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
750 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
751 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
752 ResLink.FKey := ThreadName;
753 // ?鴻???潟??┃絎?
754 try
755 SkinHeader := LoadFromSkin( GikoSys.GetSkinHeaderFileName, ThreadItem, ThreadItem.Size);
756 if Length( UserOptionalStyle ) > 0 then
757 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
758 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
759 html.Add( SkinHeader );
760 except
761 end;
762
763 SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
764 SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
765
766 html.Add('<p id="idSearch"></p>'#13#10'<a name="top"></a>');
767 html.Flush;
768
769 for i := 0 to ReadList.Count - 1 do begin
770 // 1 ?????茵?ず
771 if i <> 0 then begin
772 // 茵?ず膀??蚊????絎?
773 if (isOutsideRange(ThreadItem, i)) then begin
774 Continue;
775 end;
776 end;
777
778 // ?亥?????若??/span>
779 if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
780 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
781 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
782 else
783 html.Add( NEW_TAG );
784 end;
785
786 if (Trim(ReadList[i]) <> '') then begin
787 DivideStrLine(ReadList[i], @Res);
788 AddAnchorTag(@Res);
789 ConvRes(@Res, @ResLink);
790 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
791
792 if NewReceiveNo <= (i + 1) then
793 // ?亥??????/span>
794 html.Add(SkinedRes(SkinNewRes, @Res, IntToStr(i + 1)))
795 else
796 // ??絽吾??????/span>
797 html.Add(SkinedRes(SkinRes, @Res, IntToStr(i + 1)));
798 end;
799
800 if ThreadItem.Kokomade = (i + 1) then begin
801 // ?????障?ц?????
802 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
803 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
804 else
805 html.Add( KOKO_TAG );
806 end;
807 end;
808 html.Add(getKeywordLink(ThreadItem));
809 html.Add('<a name="bottom"></a>');
810 // ?鴻??????????
811 html.Add( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
812 end;
813
814 procedure THTMLCreate.CreateUseCSSHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
815 const
816 FORMAT_NOMAIL = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
817 + '<span class="name_label"> ????鐚? </span> <span class="name"><b>%s</b></span>'
818 + '<span class="date_label"> ??腮炊?ワ?</span> <span class="date">%s</span></div>'
819 + '<div class="mes">%s</div>';
820
821 FORMAT_SHOWMAIL = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
822 + '<span class="name_label"> ????鐚? </span><a class="name_mail" href="mailto:%s">'
823 + '<b>%s</b></a><span class="mail"> [%s]</span><span class="date_label"> ??腮炊?ワ?</span>'
824 + '<span class="date"> %s</span></div><div class="mes">%s</div>';
825
826 FORMAT_NOSHOW = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
827 + '<span class="name_label"> ????鐚? </span><a class="name_mail" href="mailto:%s">'
828 + '<b>%s</b></a><span class="date_label"> ??腮炊?ワ?</span><span class="date"> %s</span></div>'
829 + '<div class="mes">%s</div>';
830 var
831 i: integer;
832 No: string;
833 CSSFileName: string;
834 NewReceiveNo: Integer;
835 Res: TResRec;
836 UserOptionalStyle: string;
837 ThreadName :String;
838 ResLink :TResLinkRec;
839 begin
840 NewReceiveNo := ThreadItem.NewReceive;
841 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
842 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
843 ResLink.FKey := ThreadName;
844 // ?????潟?????泣?ゃ?冴??┃絎?
845 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
846 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
847 if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
848 //CSS篏睡??/span>
849 html.Add('<html><head>');
850 html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
851 html.Add('<title>' + sTitle + '</title>');
852 html.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
853 if Length( UserOptionalStyle ) > 0 then
854 html.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
855 html.Add('</head>'#13#10'<body>');
856 html.Add('<a name="top"></a>'#13#10'<p id="idSearch"></p>');
857 html.Add('<div class="title">' + sTitle + '</div>');
858 html.Flush;
859 for i := 0 to ReadList.Count - 1 do begin
860 // 1 ?????茵?ず
861 if i <> 0 then begin
862 // 茵?ず膀??蚊????絎?
863 if (isOutsideRange(ThreadItem, i)) then begin
864 Continue;
865 end;
866 end;
867
868 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
869 html.Add('<a name="new"></a><div class="new">?亥????? <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
870 end;
871
872 if (Trim(ReadList[i]) <> '') then begin
873 No := IntToStr(i + 1);
874 DivideStrLine(ReadList[i], @Res);
875 AddAnchorTag(@Res);
876 ConvRes(@Res, @ResLink);
877 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
878 if Res.FMailTo = '' then
879 html.Add(Format(FORMAT_NOMAIL, [No, No, No, Res.FName, Res.FDateTime, Res.FBody]))
880 else if GikoSys.Setting.ShowMail then
881 html.Add(Format(FORMAT_SHOWMAIL, [No, No, No, Res.FMailTo, Res.FName, Res.FMailTo, Res.FDateTime, Res.FBody]))
882 else
883 html.Add(Format(FORMAT_NOSHOW, [No, No, No, Res.FMailTo, Res.FName, Res.FDateTime, Res.FBody]));
884 end;
885 if ThreadItem.Kokomade = (i + 1) then begin
886 html.Add('<a name="koko"></a><div class="koko">?潟?潟?障?ц?????</div>');
887 end;
888
889 end;
890 html.Add(getKeywordLink(ThreadItem));
891 html.Add('<a name="bottom"></a>');
892 html.Add('<a name="last"></a>');
893 html.Add('</body></html>');
894 end;
895 end;
896
897 procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
898 var
899 i: integer;
900 NewReceiveNo: Integer;
901 ThreadName: String;
902 ResLink : TResLinkRec;
903 begin
904 NewReceiveNo := ThreadItem.NewReceive;
905 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
906 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
907 ResLink.FKey := ThreadName;
908 html.Add('<html><head>');
909 html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
910 html.Add('<title>' + sTitle + '</title></head>');
911 html.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
912 html.Add('<a name="top"></a>');
913 html.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
914 html.Add('<dl>');
915 html.Add('<p id="idSearch"></p>');
916 html.Flush;
917 for i := 0 to ReadList.Count - 1 do begin
918 // 1 ?????茵?ず
919 if i <> 0 then begin
920 // 茵?ず膀??蚊????絎?
921 if (isOutsideRange(ThreadItem, i)) then begin
922 Continue;
923 end;
924 end;
925
926 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
927 html.Add('</dl>');
928 html.Add('<a name="new"></a>');
929 html.Add('<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>');
930 html.Add('<dl>');
931 end;
932
933 if (Trim(ReadList[i]) <> '') then begin
934 html.Add(GetResString(i, ReadList[i], @ResLink));
935 end;
936 if ThreadItem.Kokomade = (i + 1) then begin
937 html.Add('</dl>');
938 html.Add('<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>');
939 html.Add('<dl>');
940 end;
941 end;
942 html.Add(getKeywordLink(ThreadItem));
943 html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
944 end;
945 function THTMLCreate.GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
946 var
947 No : String;
948 Res: TResRec;
949 begin
950 No := IntToStr(index + 1);
951 DivideStrLine(Line, @Res);
952 Res.FBody := DeleteLink(Res.FBody);
953 AddAnchorTag(@Res);
954 ConvRes(@Res, PResLink);
955 Res.FDateTime := AddBeProfileLink(Res.FDateTime, index + 1);
956 if Res.FMailTo = '' then
957 Result := '<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>'#13#10
958 else if GikoSys.Setting.ShowMail then
959 Result := '<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>'#13#10
960 else
961 Result := '<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>'#13#10;
962 end;
963 procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
964 var
965 ReadList: TStringList;
966 CSSFileName: string;
967 FileName: string;
968 Res: TResRec;
969 body : TBufferedWebBrowser;
970 {$IFDEF DEBUG}
971 st, rt: Cardinal;
972 {$ENDIF}
973 begin
974 {$IFDEF DEBUG}
975 Writeln('Create HTML');
976 st := GetTickCount;
977 {$ENDIF}
978 if ThreadItem <> nil then begin
979 body := TBufferedWebBrowser.Create(Browser, 100);
980 try
981 body.Open;
982 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
983 CreateUsePluginHTML(body, ThreadItem, sTitle);
984 end else begin
985 ShortDayNames[1] := '??#39;; ShortDayNames[2] := '??';
986 ShortDayNames[3] := '??#39;; ShortDayNames[4] := '羂?#39;;
987 ShortDayNames[5] := '??#39;; ShortDayNames[6] := '??';
988 ShortDayNames[7] := '??';
989
990 ReadList := TStringList.Create;
991 try
992 if ThreadItem.IsLogFile then begin
993 ReadList.BeginUpdate;
994 FileName := ThreadItem.GetThreadFileName;
995 ReadList.LoadFromFile(FileName);
996 ReadList.EndUpdate;
997 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
998 GikoSys.FAbon.Execute(ReadList); // ???若????????/span>
999 GikoSys.FSelectResFilter.Execute(ReadList); //???鴻?????ｃ???帥???潟?違??????
1000 if ThreadItem.Title = '' then begin
1001 DivideStrLine(ReadList[0], @Res);
1002 sTitle := Res.FTitle;
1003 end else
1004 sTitle := ThreadItem.Title
1005 end else begin
1006 sTitle := CustomStringReplace(ThreadItem.Title, '鐚?鐔?', ',');
1007 end;
1008 // ?????潟?????泣?ゃ?冴??┃絎?
1009 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1010 if GikoSys.Setting.UseSkin then begin
1011 CreateUseSKINHTML(body, ThreadItem, ReadList);
1012 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1013 CreateUseCSSHTML(body, ThreadItem, ReadList, sTitle);
1014 end else begin
1015 CreateDefaultHTML(body, ThreadItem, ReadList, sTitle);
1016 end;
1017 finally
1018 ReadList.Free;
1019 end;
1020 end;
1021 finally
1022 body.Close;
1023 body.Free;
1024 end;
1025 end;
1026 {$IFDEF DEBUG}
1027 rt := GetTickCount - st;
1028 Writeln('Done.');
1029 Writeln(IntToStr(rt) + ' ms');
1030 {$ENDIF}
1031 end;
1032
1033 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1034 var
1035 i: integer;
1036 No: string;
1037 //bufList : TStringList;
1038 ReadList: TStringList;
1039 // SaveList: TStringList;
1040 CSSFileName: string;
1041 BBSID: string;
1042 FileName: string;
1043 Res: TResRec;
1044 boardPlugIn : TBoardPlugIn;
1045
1046 UserOptionalStyle: string;
1047 SkinHeader: string;
1048 SkinRes: string;
1049 tmp, tmp1: string;
1050 ThreadName: String;
1051 ResLink : TResLinkRec;
1052 function LoadSkin( fileName: string ): string;
1053 begin
1054 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1055 end;
1056 function ReplaceRes( skin: string ): string;
1057 begin
1058 Result := SkinedRes( skin, @Res, No );
1059 end;
1060
1061 begin
1062 if ThreadItem <> nil then begin
1063 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1064 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1065 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1066 ResLink.FKey := ThreadName;
1067 html.Clear;
1068 html.BeginUpdate;
1069 //if ThreadItem.IsBoardPlugInAvailable then begin
1070 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1071 //===== ?????違?ゃ?潟??????茵?ず
1072 //boardPlugIn := ThreadItem.BoardPlugIn;
1073 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1074 // ?????潟?????泣?ゃ?冴??┃絎?
1075 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1076 try
1077 // ??絖??潟?若?????????違?ゃ?潟??算????
1078 // ??????
1079 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1080 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1081 //腟九????с?????後????с??/span>
1082 if GikoSys.Setting.UseSkin then begin
1083 tmp1 := './' + GikoSys.Setting.CSSFileName;
1084 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1085 tmp1 := CustomStringReplace(tmp1, '\', '/');
1086 tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1087 end else if GikoSys.Setting.UseCSS then begin
1088 tmp1 := './' + CSSFileName;
1089 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1090 tmp1 := CustomStringReplace(tmp1, '\', '/');
1091 tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1092 end;
1093 html.Append( tmp );
1094
1095 for i := 0 to threadItem.Count - 1 do begin
1096
1097 // ????/span>
1098 Res.FBody := boardPlugIn.GetRes( DWORD( threadItem ), i + 1 );
1099 ConvertResAnchor(@Res);
1100 html.Append( Res.FBody );
1101
1102 end;
1103 // ?鴻??????????
1104 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1105 finally
1106 end;
1107 html.EndUpdate;
1108 //Exit;
1109 end else begin
1110 ShortDayNames[1] := '??#39;; ShortDayNames[2] := '??';
1111 ShortDayNames[3] := '??#39;; ShortDayNames[4] := '羂?#39;;
1112 ShortDayNames[5] := '??#39;; ShortDayNames[6] := '??';
1113 ShortDayNames[7] := '??';
1114 BBSID := ThreadItem.ParentBoard.BBSID;
1115 ReadList := TStringList.Create;
1116 try
1117 if ThreadItem.IsLogFile then begin
1118 FileName := ThreadItem.GetThreadFileName;
1119 ReadList.LoadFromFile(FileName);
1120 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1121 GikoSys.FAbon.Execute(ReadList); // ???若????????/span>
1122 GikoSys.FSelectResFilter.Execute(ReadList); //???鴻?????ｃ???帥???潟?違??????
1123 DivideStrLine(ReadList[0], @Res);
1124 //Res.FTitle := CustomStringReplace(Res.FTitle, '鐚?鐔?', ',');
1125 sTitle := Res.FTitle;
1126 end else begin
1127 sTitle := CustomStringReplace(ThreadItem.Title, '鐚?鐔?', ',');
1128 end;
1129 try
1130 // ?????潟?????泣?ゃ?冴??┃絎?
1131 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1132
1133 if GikoSys.Setting.UseSkin then begin
1134 // ?鴻???割戎??/span>
1135 // ?鴻???潟??┃絎?
1136 try
1137 SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1138 if Length( UserOptionalStyle ) > 0 then
1139 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1140 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1141 //腟九????с?????後????с??/span>
1142 tmp1 := './' + GikoSys.Setting.CSSFileName;
1143 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1144 tmp1 := CustomStringReplace(tmp1, '\', '/');
1145 SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1146 html.Append( SkinHeader );
1147 except
1148 end;
1149 try
1150 SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1151 except
1152 end;
1153 html.Append('<a name="top"></a>');
1154 for i := 0 to ReadList.Count - 1 do begin
1155 if (Trim(ReadList[i]) <> '') then begin
1156 No := IntToStr(i + 1);
1157
1158 DivideStrLine(ReadList[i], @Res);
1159 AddAnchorTag(@Res);
1160 ConvRes(@Res, @ResLink, true);
1161 ConvertResAnchor(@Res);
1162
1163 try
1164 html.Append( ReplaceRes( SkinRes ) );
1165 except
1166 end;
1167 end;
1168
1169 end;
1170 html.Append('<a name="bottom"></a>');
1171 // ?鴻??????????
1172 try
1173 html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1174 except
1175 end;
1176 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1177 //CSS篏睡??/span>
1178 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1179 html.Append('<html><head>');
1180 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1181 html.Append('<title>' + sTitle + '</title>');
1182 //腟九????с?????後????с??/span>
1183 tmp1 := './' + CSSFileName;
1184 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1185 tmp1 := CustomStringReplace(tmp1, '\', '/');
1186
1187 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1188 if Length( UserOptionalStyle ) > 0 then
1189 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1190 html.Append('</head>');
1191 html.Append('<body>');
1192 html.Append('<a name="top"></a>');
1193 html.Append('<div class="title">' + sTitle + '</div>');
1194 for i := 0 to ReadList.Count - 1 do begin
1195 if (Trim(ReadList[i]) <> '') then begin
1196 No := IntToStr(i + 1);
1197 DivideStrLine(ReadList[i], @Res);
1198 AddAnchorTag(@Res);
1199 ConvRes(@Res, @ResLink, true);
1200 ConvertResAnchor(@Res);
1201 if Res.FMailTo = '' then
1202 html.Append('<a name="' + No + '"></a>'
1203 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1204 + '<span class="name_label">????鐚?</span> '
1205 + '<span class="name"><b>' + Res.FName + '</b></span> '
1206 + '<span class="date_label">??腮炊?ワ?</span> '
1207 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1208 + '<div class="mes">' + Res.FBody + ' </div>')
1209 else if GikoSys.Setting.ShowMail then
1210 html.Append('<a name="' + No + '"></a>'
1211 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1212 + '<span class="name_label"> ????鐚? </span>'
1213 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1214 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1215 + '<span class="date_label"> ??腮炊?ワ?</span>'
1216 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1217 + '<div class="mes">' + Res.FBody + ' </div>')
1218 else
1219 html.Append('<a name="' + No + '"></a>'
1220 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1221 + '<span class="name_label"> ????鐚? </span>'
1222 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1223 + '<b>' + Res.FName + '</b></a>'
1224 + '<span class="date_label"> ??腮炊?ワ?</span>'
1225 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1226 + '<div class="mes">' + Res.FBody + ' </div>');
1227 end;
1228 end;
1229 html.Append('<a name="bottom"></a>');
1230 html.Append('<a name="last"></a>');
1231 html.Append('</body></html>');
1232 end else begin
1233 //CSS??篏睡??/span>
1234 html.Append('<html><head>');
1235 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1236 html.Append('<title>' + sTitle + '</title></head>');
1237 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1238 html.Append('<a name="top"></a>');
1239 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1240 html.Append('<dl>');
1241 for i := 0 to ReadList.Count - 1 do begin
1242 if (Trim(ReadList[i]) <> '') then begin
1243 No := IntToStr(i + 1);
1244 DivideStrLine(ReadList[i], @Res);
1245 AddAnchorTag(@Res);
1246 ConvRes(@Res, @ResLink, true);
1247 ConvertResAnchor(@Res);
1248 if Res.FMailTo = '' then
1249 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>')
1250 else if GikoSys.Setting.ShowMail then
1251 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>')
1252 else
1253 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>');
1254 end;
1255 end;
1256 html.Append('</dl>');
1257 html.Append('<a name="bottom"></a>');
1258 html.Append('</body></html>');
1259 end;
1260 finally
1261 html.EndUpdate;
1262 end;
1263 finally
1264 ReadList.Free;
1265 end;
1266 end;
1267 end;
1268 end;
1269
1270 procedure THTMLCreate.SetResPopupText(Hint : TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
1271 var
1272 i: Integer;
1273 tmp: string;
1274 FileName: string;
1275 Line: Integer;
1276
1277 wkInt: Integer;
1278
1279 boardPlugIn : TBoardPlugIn;
1280 Html: TStringList;
1281 ResLink : TResLinkRec;
1282 begin
1283
1284 Html := TStringList.Create;
1285 try
1286 if StNum > ToNum then begin
1287 wkInt := StNum;
1288 StNum := ToNum;
1289 ToNum := wkInt;
1290 end;
1291
1292 //??紊?0???鴻?障?ц；腓?/span>
1293 if StNum + MAX_POPUP_RES < ToNum then
1294 ToNum := StNum + MAX_POPUP_RES;
1295
1296 Hint.Title := '';
1297 Hint.RawDocument := '';
1298 Hint.Thread := nil;
1299
1300 //?帥?ゃ????；腓?/span>
1301 if Title then
1302 if ThreadItem <> nil then
1303 Hint.Title := ThreadItem.Title;
1304
1305 if ThreadItem <> nil then begin
1306 Hint.Thread := ThreadItem;
1307 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1308 ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
1309 //if ThreadItem.IsBoardPlugInAvailable then begin
1310 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1311 //===== ?????違?ゃ?潟??????茵?ず
1312 //boardPlugIn := ThreadItem.BoardPlugIn;
1313 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1314
1315 // ?????潟?????泣?ゃ?冴??┃絎?
1316 // ??絖??潟?若?????????違?ゃ?潟??算????
1317 for i := StNum to ToNum do begin
1318 Line := i;
1319 //?????э??＜??????????at??就綣?э?茵?茯??粋昭?????逸愁鐔ワ愁????茯??????????????ｃ??
1320 tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
1321 if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1322 Html.Add(GetResString(Line-1, tmp, @ResLink));
1323 end;
1324 end;
1325 end else begin
1326 for i := StNum to ToNum do begin
1327 Line := i;
1328 FileName := ThreadItem.FilePath;
1329 tmp := GikoSys.ReadThreadFile(FileName, Line);
1330 if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1331 Html.Add(GetResString(Line-1, tmp, @ResLink));
1332 end;
1333 end;
1334 end;
1335 if (Html.Count > 0) then begin
1336 Hint.RawDocument := '<DL>' + Html.Text + '</DL>';
1337 end;
1338 end;
1339 finally
1340 Html.Free;
1341 end;
1342 end;
1343
1344 //???潟??????絖??????????鴻???????≪????????RL?????????
1345 class function THTMLCreate.GetRespopupURL(AText, AThreadURL : string): string;
1346 var
1347 wkInt: Integer;
1348 begin
1349 Result := '';
1350 if Pos('about:blank..', AText) = 1 then begin
1351 wkInt := LastDelimiter( '/', AThreadURL );
1352 if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin
1353 // Thread.URL ? PATH_INFO 羝＜??
1354 Result := Copy( AThreadURL, 1, LastDelimiter( '/', AThreadURL ) );
1355 wkInt := LastDelimiter( '/', AText );
1356 if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then
1357 // Text ?? PATH_INFO 羝＜??
1358 Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt )
1359 else
1360 // Text ? QUERY_STRING 羝＜??
1361 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt );
1362 end else begin
1363 // Thread.URL ? QUERY_STRING 羝＜??
1364 Result := Copy( AThreadURL, 1, LastDelimiter( '?', AThreadURL ) );
1365 wkInt := LastDelimiter( '/', AText );
1366 if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then begin
1367 // Text ? PATH_INFO 羝＜??
1368 // URL ???帥?????若??莇潟????????? Text ???????眼????
1369 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1370 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1371 Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt );
1372 end else begin
1373 // Text ?? QUERY_STRING 羝＜??
1374 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt )
1375 end;
1376 end;
1377 end else if Pos('about:blank/bbs/', AText) = 1 then begin
1378 //????????BBS???紊????後?/span>
1379 AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/');
1380 Result := GetRespopupURL(AText, AThreadURL);
1381 end else begin
1382 Result := AText;
1383 end;
1384
1385 end;
1386 //??絎????????鴻???鴻???潟???????SS?????＜?ゃ?????潟???若??篏???
1387 class procedure THTMLCreate.SkinorCSSFilesCopy(path: string);
1388 var
1389 tmp, tmpD, tmpF: string;
1390 current: string;
1391 dirs: TStringList;
1392 files: TStringList;
1393 i, j: Integer;
1394 begin
1395 if GikoSys.Setting.UseSkin then begin
1396 current := ExtractFilePath(GikoSys.GetSkinDir);
1397 tmp := GikoSys.Setting.CSSFileName;
1398 end else if GikoSys.Setting.UseCSS then begin
1399 current := ExtractFilePath(GikoSys.GetStyleSheetDir);
1400 tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName);
1401 end else begin
1402 Exit;
1403 end;
1404 dirs := TStringList.Create;
1405 try
1406 dirs.Add(tmp);
1407 if tmp <> current then begin
1408 GikoSys.GetDirectoryList(current, '*.*', dirs, true);
1409 for i := 0 to dirs.Count - 1 do begin
1410 files := TStringList.Create;
1411 try
1412 files.BeginUpdate;
1413 gikoSys.GetFileList(dirs[i], '*.*', files, true);
1414 files.EndUpdate;
1415 tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path);
1416 if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then
1417 ForceDirectories(tmpD);
1418
1419 if(dirs[i] = tmp) and (dirs[i] <> current) then begin
1420 for j := 0 to files.Count - 1 do begin
1421 tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path);
1422 if not FileExists(tmpF) then begin
1423 CopyFile(PChar(files[j]), PChar(tmpF),True);
1424 end;
1425 end;
1426 end;
1427 finally
1428 files.Free;
1429 end;
1430 end;
1431 end else begin
1432 tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path);
1433 if not DirectoryExists(tmpD) then
1434 ForceDirectories(tmpD);
1435 tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName
1436 , GikoSys.GetConfigDir, path);
1437 if not FileExists(tmpF) then begin
1438 CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName)
1439 , PChar(tmpF), True);
1440 end;
1441 end;
1442 finally
1443 dirs.Free;
1444 end;
1445 end;
1446 {!
1447 \brief dat???＜?ゃ????????ゃ?潟????茹?/span>
1448 \param Line dat???＜?ゃ????罕??????? 1 茵?
1449 \return ???号????/span>
1450 }
1451 class procedure THTMLCreate.DivideStrLine(Line: string; PRes: PResRec);
1452 const
1453 delimiter = '<>';
1454 var
1455 pds, pde : PChar;
1456 pss, pse : PChar;
1457 ppos : PChar;
1458 begin
1459 //?阪?
1460 PRes.FType := glt2chNew;
1461
1462 pss := PChar(Line);
1463 pse := pss + Length(Line);
1464 pds := PChar(delimiter);
1465 pde := pds + Length(delimiter);
1466
1467 ppos := AnsiStrPosEx(pss, pse, pds, pde);
1468 if (ppos = nil) then begin
1469 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
1470 Line := CustomStringReplace(Line, ',', '<>');
1471 Line := CustomStringReplace(Line, '鐚?鐔?', ',');
1472 end;
1473 //Trim??????????????羂?????????by??????
1474 PRes.FName := MojuUtils.RemoveToken(Line, delimiter);
1475 PRes.FMailTo := MojuUtils.RemoveToken(Line, delimiter);
1476 PRes.FDateTime := MojuUtils.RemoveToken(Line, delimiter);
1477 PRes.FBody := MojuUtils.RemoveToken(Line, delimiter);
1478 //鐚??＜????????????????????????????????ゅ??茹?腥榊?純???ャ?ｃ?????????у???ゃ????
1479 //篁???ｲ腓堺?帥?с?????壕???????純???????????????????????????
1480 PRes.FBody := TrimLeft(PRes.FBody);
1481 //腥冴?????馹???莎激??????????腥榊?純??荐??????
1482 if PRes.FBody = '' then
1483 PRes.FBody := '&nbsp;';
1484
1485 PRes.FTitle := MojuUtils.RemoveToken(Line, delimiter);
1486 end;
1487
1488 {!
1489 \brief HTML ?????≪?潟???若?帥?違??????/span>
1490 \param s ???????? HTML
1491 \return ?≪?潟???若?帥?違?????ゃ?????? HTML
1492 }
1493 class function THTMLCreate.DeleteLink(const s: string): string;
1494 var
1495 s1: string;
1496 mark: string;
1497 idx: Integer;
1498 begin
1499 mark := '<a href="';
1500 Result := '';
1501 s1 := s;
1502 idx := AnsiPos(mark, s1);
1503 while idx <> 0 do begin
1504 Result := Result + Copy(s1, 1, idx - 1);
1505 Delete(s1, 1, idx);
1506 // ?帥?違?????潟?????≪??
1507 idx := AnsiPos('">', s1);
1508 if idx <> 0 then begin
1509 Delete(s1, 1, idx + 1);
1510 end;
1511 // </a> ?障??/span>
1512 idx := AnsiPos('</a>', s1);
1513 if idx <> 0 then begin
1514 Result := Result + Copy(s1, 1, idx - 1);
1515 Delete(s1, 1, idx + 3);
1516 end;
1517 idx := AnsiPos(mark, s1);
1518 end;
1519
1520 Result := Result + s1;
1521 end;
1522 {
1523 \brief HTML??????????舟??
1524 \param s ??????????絖???
1525 \return HTML??nnerText??????????????????絖???
1526 }
1527 class function THTMLCreate.RepHtml(const s: string): string;
1528 begin
1529 // s := StringReplace(s, '&', '&amp;', [rfReplaceAll]);
1530 Result := s;
1531 Result := CustomStringReplace(Result, '<', '&lt;');
1532 Result := CustomStringReplace(Result, '>', '&gt;');
1533 // s := StringReplace(s, ' ', '&nbsp;', [rfReplaceAll]); //篁?罕?紊??眼??????&nbsp;篏睡?????/span>
1534 Result := CustomStringReplace(Result, '"', '&quot;');
1535 end;
1536 {
1537 \brief ???鴻?????ｃ?帥?с?????????ャ?主??TML篏???
1538 \param Title ?鴻???????帥?ゃ????/span>
1539 \param No ???合???/span>
1540 \param Mail ?＜?若???
1541 \param Name ????罨?
1542 \param Body ????
1543 \return ???????ャ?主??TML
1544 }
1545 class function THTMLCreate.CreatePreviewHTML(
1546 const Title: string;
1547 const No: string;
1548 const Mail: string;
1549 const Namae: string;
1550 const Body: string
1551 ) : string;
1552 var
1553 posTrip : Integer;
1554 tripOrigin : string;
1555 NameWithTrip: string;
1556 DateTime: string;
1557 begin
1558 Result := '<HTML><HEAD>'#13#10
1559 + '<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">'#13#10
1560 + '<TITLE>' + title + '</TITLE>'#13#10
1561 + '</HEAD>'#13#10
1562 + '<BODY text="#000000" bgcolor="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">'#13#10
1563 + '<FONT COLOR="#FF0000">' + title + '</FONT>'#13#10
1564 + '<DL>'#13#10;
1565
1566 DateTime := FormatDateTime('yyyy/mm/dd(aaa) hh:nn', Now());
1567
1568 NameWithTrip := Namae;
1569 posTrip := AnsiPos( '#', Namae );
1570 if posTrip > 0 then begin
1571 tripOrigin := Copy( Namae, posTrip + 1, Length( Namae ) );
1572 NameWithTrip := Copy( Namae, 1, posTrip - 1 ) + '</B> ??' +
1573 get_2ch_trip( PChar( tripOrigin ) ) + '<B>';
1574 end;
1575 if Mail = '' then begin
1576 Result := Result + '<DT>' + No + ' 鐚? <FONT color="forestgreen"><B>' + NameWithTrip
1577 + '</B></FONT> 鐚? ' + DateTime+ '<BR><DD>' + Body + '<BR><BR><BR>' + #13#10
1578 end else begin
1579 Result := Result + '<DT>' + No + ' 鐚? <A href="mailto:' + Mail + '"><B>' + NameWithTrip
1580 + '</B></A> [' + Mail + ']鐚? ' + DateTime+ '<BR><DD>' + Body + '<BR><BR><BR>' + #13#10;
1581 end;
1582 Result := Result + '</BODY></HTML>';
1583
1584 end;
1585 {
1586 \brief 茵?ず膀??峨????合??垸?ゅ?????
1587 \param item 茵?ず?鴻??????
1588 \param index ???合???/span>
1589 \return ture:茵?ず膀??峨? false:茵?ず膀??峨??
1590 }
1591 function THTMLCreate.isOutsideRange( item: TThreadItem; index: Integer ): Boolean;
1592 begin
1593 Result := False;
1594 // 茵?ず膀??蚊????絎?
1595 case GikoSys.ResRange of
1596 Ord( grrKoko ):
1597 if item.Kokomade > (index + 1) then
1598 Result := True;
1599 Ord( grrNew ):
1600 if item.NewReceive > (index + 1) then
1601 Result := True;
1602 10..65535:
1603 if (GikoSys.Setting.HeadResCount) < (index + 1) then begin
1604 if (item.Count - index) > GikoSys.ResRange then begin
1605 Result := True;
1606 end;
1607 end;
1608 end;
1609 end;
1610 constructor TBufferedWebBrowser.Create(Browser: TWebBrowser; BuffSize: Integer);
1611 begin
1612 inherited Create;
1613 Self.Sorted := False;
1614 if (Browser = nil) then
1615 Raise Exception.Create('Browser is NULL');
1616 FBrowser := Browser;
1617
1618 // ???????＜????茵??違??
1619 if (BuffSize < 0) then begin
1620 FBuffSize := 100;
1621 end else begin
1622 FBuffSize := BuffSize;
1623 end;
1624 Self.Capacity := FBuffSize + 10;
1625 end;
1626 procedure TBufferedWebBrowser.Open;
1627 begin
1628 FBrowserDoc := FBrowser.ControlInterface.Document;
1629 FBrowserDoc.open;
1630 FBrowserDoc.charset := 'Shift_JIS';
1631 end;
1632 procedure TBufferedWebBrowser.Close;
1633 begin
1634 Self.Flush;
1635 try
1636 FBrowserDoc.Close;
1637 except
1638 end;
1639 FBrowser := nil;
1640 end;
1641 function TBufferedWebBrowser.Add(const S: string): Integer;
1642 begin
1643 Result := inherited Add(TrimRight(s));
1644 if (Self.Count > FBuffSize) then begin
1645 FBrowserDoc.Write(Self.Text);
1646 Self.Clear;
1647 end;
1648 end;
1649 procedure TBufferedWebBrowser.Flush ;
1650 begin
1651 if (Self.Count > 0) then begin
1652 FBrowserDoc.Write(Self.Text);
1653 Self.Clear;
1654 end;
1655 end;
1656 destructor TBufferedWebBrowser.Destory;
1657 begin
1658 try
1659 if (FBrowserDoc <> 0) then begin
1660 FBrowserDoc.close;
1661 FBrowserDoc := 0;
1662 end;
1663 except
1664 end;
1665 inherited;
1666 end;
1667 //! ?∫?ｃ???若???若?????潟???阪??
1668 function THTMLCreate.getKeywordLink(item: TThreadItem): String;
1669 const
1670 PARA_URL = 'http://p2.2ch.io/getf.cgi?';
1671 begin
1672 Result := '';
1673 if (GikoSys.Setting.AddKeywordLink) and (item.ParentBoard.Is2ch) then begin
1674 Result := '<p><span id="keyword"><a href="' + PARA_URL
1675 + item.URL + '" target="_blank">?∫?ｃ???若???若??</a></span></p>';
1676 end;
1677 end;
1678 initialization
1679 HTMLCreater := THTMLCreate.Create;
1680
1681 finalization
1682 if HTMLCreater <> nil then begin
1683 FreeAndNil(HTMLCreater);
1684 end;
1685
1686 end.
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help