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.35 - (show annotations) (download) (as text)
Wed Feb 14 15:12:06 2007 UTC (17 years, 2 months ago) by h677
Branch: MAIN
CVS Tags: v1_56_0_700, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, v1_55_1_697, v1_56_0_699, v1_56_0_698
Branch point for: Bb55, bRESPOPUP, bListSU
Changes since 1.34: +29 -56 lines
File MIME type: text/x-pascal
新NGワードの試みを終了。

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

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