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.25 - (show annotations) (download) (as text)
Sun Feb 26 04:12:25 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_52_0_649
Changes since 1.24: +4 -10 lines
File MIME type: text/x-pascal
バッファリングを少し修正

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

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