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.26 - (show annotations) (download) (as text)
Sun Feb 26 16:40:52 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_52_0_650
Changes since 1.25: +209 -234 lines
File MIME type: text/x-pascal
DAT中にnullがあっても切れないように修正。
取得済みのスレッドへのJumpを修正。
入力アシストのフォーム位置保存。

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 html.add(boardPlugIn.GetHeader( DWORD( threadItem ),
809 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
810 html.Add('<p id="idSearch"></p>');
811
812 for i := 0 to threadItem.Count - 1 do begin
813 // 1 ?????茵?ず
814 if i <> 0 then begin
815 // 茵?ず膀??蚊????絎?
816 case GikoSys.ResRange of
817 Ord( grrKoko ):
818 if ThreadItem.Kokomade > (i + 1) then
819 Continue;
820 Ord( grrNew ):
821 if NewReceiveNo > (i + 1) then
822 Continue;
823 10..65535:
824 if (threadItem.Count - i) > GikoSys.ResRange then
825 Continue;
826 end;
827 end;
828
829 // ?亥?????若??/span>
830 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
831 try
832 if GikoSys.Setting.UseSkin then begin
833 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
834 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
835 else
836 html.Add( '<a name="new"></a>');
837 end else if GikoSys.Setting.UseCSS then begin
838 html.Add('<a name="new"></a><div class="new">?亥????? <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
839 end else begin
840 html.Add('</dl>');
841 html.Add('<a name="new"></a>');
842 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>');
843 html.Add('<dl>');
844 end;
845 except
846 html.Add( '<a name="new"></a>');
847 end;
848 end;
849
850 // ????/span>
851 html.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ));
852
853 if ThreadItem.Kokomade = (i + 1) then begin
854 // ?????障?ц?????
855 try
856 if GikoSys.Setting.UseSkin then begin
857 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
858 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
859 else
860 html.Add( '<a name="koko"></a>');
861 end else if GikoSys.Setting.UseCSS then begin
862 html.Add('<a name="koko"></a><div class="koko">?潟?潟?障?ц?????</div>');
863 end else begin
864 html.Add('</dl>');
865 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>');
866 html.Add('<dl>');
867 end;
868 except
869 html.Add('<a name="koko"></a>');
870 end;
871 end;
872 end;
873
874
875 // ?鴻??????????
876 html.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ));
877 end;
878
879
880 procedure THTMLCreate.CreateUseSKINHTML(html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
881 const
882 KOKO_TAG = '<a name="koko"></a>';
883 NEW_TAG = '<a name="new"></a>';
884 var
885 i: integer;
886 NewReceiveNo: Integer;
887 Res: TResRec;
888 UserOptionalStyle: string;
889 SkinHeader: string;
890 SkinNewRes: string;
891 SkinRes: string;
892 ThreadName : string;
893 ResLink :TResLinkRec;
894 begin
895 NewReceiveNo := ThreadItem.NewReceive;
896 // ?????潟?????泣?ゃ?冴??┃絎?
897 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
898 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
899 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
900 ResLink.FKey := ThreadName;
901 // ?鴻???潟??┃絎?
902 try
903 SkinHeader := LoadFromSkin( GikoSys.GetSkinHeaderFileName, ThreadItem, ThreadItem.Size);
904 if Length( UserOptionalStyle ) > 0 then
905 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
906 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
907 html.Add( SkinHeader );
908 except
909 end;
910
911 SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
912 SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
913
914 html.Add('<p id="idSearch"></p>'#13#10'<a name="top"></a>');
915
916 for i := 0 to ReadList.Count - 1 do begin
917 // 1 ?????茵?ず
918 if i <> 0 then begin
919 // 茵?ず膀??蚊????絎?
920 case GikoSys.ResRange of
921 Ord( grrKoko ):
922 if ThreadItem.Kokomade > (i + 1) then
923 Continue;
924 Ord( grrNew ):
925 if NewReceiveNo > (i + 1) then
926 Continue;
927 10..65535:
928 if (threadItem.Count - i) > GikoSys.ResRange then
929 Continue;
930 end;
931 end;
932
933 // ?亥?????若??/span>
934 if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
935 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
936 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
937 else
938 html.Add( NEW_TAG );
939 end;
940
941 if (Trim(ReadList[i]) <> '') then begin
942 DivideStrLine(ReadList[i], @Res);
943 AddAnchorTag(@Res);
944 ConvRes(@Res, @ResLink);
945 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
946
947 if NewReceiveNo <= (i + 1) then
948 // ?亥??????/span>
949 html.Add(SkinedRes(SkinNewRes, @Res, IntToStr(i + 1)))
950 else
951 // ??絽吾??????/span>
952 html.Add(SkinedRes(SkinRes, @Res, IntToStr(i + 1)));
953 end;
954
955 if ThreadItem.Kokomade = (i + 1) then begin
956 // ?????障?ц?????
957 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
958 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
959 else
960 html.Add( KOKO_TAG );
961 end;
962 end;
963
964 html.Add('<a name="bottom"></a>');
965 // ?鴻??????????
966 html.Add( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
967 end;
968
969 procedure THTMLCreate.CreateUseCSSHTML(html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
970 const
971 FORMAT_NOMAIL = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
972 + '<span class="name_label"> ????鐚? </span> <span class="name"><b>%s</b></span>'
973 + '<span class="date_label"> ??腮炊?ワ?</span> <span class="date">%s</span></div>'
974 + '<div class="mes">%s</div>';
975
976 FORMAT_SHOWMAIL = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
977 + '<span class="name_label"> ????鐚? </span><a class="name_mail" href="mailto:%s">'
978 + '<b>%s</b></a><span class="mail"> [%s]</span><span class="date_label"> ??腮炊?ワ?</span>'
979 + '<span class="date"> %s</span></div><div class="mes">%s</div>';
980
981 FORMAT_NOSHOW = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
982 + '<span class="name_label"> ????鐚? </span><a class="name_mail" href="mailto:%s">'
983 + '<b>%s</b></a><span class="date_label"> ??腮炊?ワ?</span><span class="date"> %s</span></div>'
984 + '<div class="mes">%s</div>';
985 var
986 i: integer;
987 No: string;
988 CSSFileName: string;
989 NewReceiveNo: Integer;
990 Res: TResRec;
991 UserOptionalStyle: string;
992 ThreadName :String;
993 ResLink :TResLinkRec;
994 begin
995 NewReceiveNo := ThreadItem.NewReceive;
996 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
997 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
998 ResLink.FKey := ThreadName;
999 // ?????潟?????泣?ゃ?冴??┃絎?
1000 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1001 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1002 if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1003 //CSS篏睡??/span>
1004 html.Add('<html><head>');
1005 html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1006 html.Add('<title>' + sTitle + '</title>');
1007 html.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1008 if Length( UserOptionalStyle ) > 0 then
1009 html.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1010 html.Add('</head>'#13#10'<body>');
1011 html.Add('<a name="top"></a>'#13#10'<p id="idSearch"></p>');
1012 html.Add('<div class="title">' + sTitle + '</div>');
1013 for i := 0 to ReadList.Count - 1 do begin
1014 // 1 ?????茵?ず
1015 if i <> 0 then begin
1016 // 茵?ず膀??蚊????絎?
1017 case GikoSys.ResRange of
1018 Ord( grrKoko ):
1019 if ThreadItem.Kokomade > (i + 1) then
1020 Continue;
1021 Ord( grrNew ):
1022 if NewReceiveNo > (i + 1) then
1023 Continue;
1024 10..65535:
1025 if (threadItem.Count - i) > GikoSys.ResRange then
1026 Continue;
1027 end;
1028 end;
1029
1030 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1031 html.Add('<a name="new"></a><div class="new">?亥????? <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1032 end;
1033
1034 if (Trim(ReadList[i]) <> '') then begin
1035 No := IntToStr(i + 1);
1036 DivideStrLine(ReadList[i], @Res);
1037 AddAnchorTag(@Res);
1038 ConvRes(@Res, @ResLink);
1039 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1040 if Res.FMailTo = '' then
1041 html.Add(Format(FORMAT_NOMAIL, [No, No, No, Res.FName, Res.FDateTime, Res.FBody]))
1042 else if GikoSys.Setting.ShowMail then
1043 html.Add(Format(FORMAT_SHOWMAIL, [No, No, No, Res.FMailTo, Res.FName, Res.FMailTo, Res.FDateTime, Res.FBody]))
1044 else
1045 html.Add(Format(FORMAT_NOSHOW, [No, No, No, Res.FMailTo, Res.FName, Res.FDateTime, Res.FBody]));
1046 end;
1047
1048 if ThreadItem.Kokomade = (i + 1) then begin
1049 html.Add('<a name="koko"></a><div class="koko">?潟?潟?障?ц?????</div>');
1050 end;
1051
1052 end;
1053
1054 html.Add('<a name="bottom"></a>');
1055 html.Add('<a name="last"></a>');
1056 html.Add('</body></html>');
1057 end;
1058 end;
1059
1060 procedure THTMLCreate.CreateDefaultHTML (html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
1061 var
1062 i: integer;
1063 No: string;
1064 NewReceiveNo: Integer;
1065 Res: TResRec;
1066 ThreadName: String;
1067 ResLink : TResLinkRec;
1068 begin
1069 NewReceiveNo := ThreadItem.NewReceive;
1070 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1071 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1072 ResLink.FKey := ThreadName;
1073 html.Add('<html><head>');
1074 html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1075 html.Add('<title>' + sTitle + '</title></head>');
1076 html.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1077 html.Add('<a name="top"></a>');
1078 html.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1079 html.Add('<dl>');
1080 html.Add('<p id="idSearch"></p>');
1081 for i := 0 to ReadList.Count - 1 do begin
1082 // 1 ?????茵?ず
1083 if i <> 0 then begin
1084 // 茵?ず膀??蚊????絎?
1085 case GikoSys.ResRange of
1086 Ord( grrKoko ):
1087 if ThreadItem.Kokomade > (i + 1) then
1088 Continue;
1089 Ord( grrNew ):
1090 if NewReceiveNo > (i + 1) then
1091 Continue;
1092 10..65535:
1093 if (threadItem.Count - i) > GikoSys.ResRange then
1094 Continue;
1095 end;
1096 end;
1097
1098 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1099 html.Add('</dl>');
1100 html.Add('<a name="new"></a>');
1101 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>');
1102 html.Add('<dl>');
1103 end;
1104
1105 if (Trim(ReadList[i]) <> '') then begin
1106 No := IntToStr(i + 1);
1107 DivideStrLine(ReadList[i], @Res);
1108 AddAnchorTag(@Res);
1109 ConvRes(@Res, @ResLink);
1110 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1111 if Res.FMailTo = '' then
1112 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)
1113 else if GikoSys.Setting.ShowMail then
1114 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)
1115 else
1116 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);
1117 end;
1118 if ThreadItem.Kokomade = (i + 1) then begin
1119 html.Add('</dl>');
1120 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>');
1121 html.Add('<dl>');
1122 end;
1123 end;
1124 html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
1125 end;
1126
1127 procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
1128 var
1129 ReadList: TStringList;
1130 CSSFileName: string;
1131 FileName: string;
1132 Res: TResRec;
1133 body : TBufferedWebBrowser;
1134 {$IFDEF DEBUG}
1135 st, rt: Cardinal;
1136 {$ENDIF}
1137 begin
1138 {$IFDEF DEBUG}
1139 Writeln('Create HTML');
1140 st := GetTickCount;
1141 {$ENDIF}
1142 if ThreadItem <> nil then begin
1143 body := TBufferedWebBrowser.Create(Browser, 100);
1144 try
1145 body.Open;
1146 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1147 CreateUsePluginHTML(body, ThreadItem, sTitle);
1148 end else begin
1149 ShortDayNames[1] := '??#39;; ShortDayNames[2] := '??';
1150 ShortDayNames[3] := '??#39;; ShortDayNames[4] := '羂?#39;;
1151 ShortDayNames[5] := '??#39;; ShortDayNames[6] := '??';
1152 ShortDayNames[7] := '??';
1153
1154 ReadList := TStringList.Create;
1155 try
1156 if ThreadItem.IsLogFile then begin
1157 ReadList.BeginUpdate;
1158 FileName := ThreadItem.GetThreadFileName;
1159 ReadList.LoadFromFile(FileName);
1160 ReadList.EndUpdate;
1161 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1162 GikoSys.FAbon.Execute(ReadList); // ???若????????/span>
1163 GikoSys.FSelectResFilter.Execute(ReadList); //???鴻?????c???帥???潟?違??????
1164 if ThreadItem.Title = '' then begin
1165 DivideStrLine(ReadList[0], @Res);
1166 sTitle := Res.FTitle;
1167 end else
1168 sTitle := ThreadItem.Title
1169 end else begin
1170 sTitle := CustomStringReplace(ThreadItem.Title, '鐚?鐔?', ',');
1171 end;
1172 // ?????潟?????泣?ゃ?冴??┃絎?
1173 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1174 if GikoSys.Setting.UseSkin then begin
1175 CreateUseSKINHTML(body, ThreadItem, ReadList);
1176 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1177 CreateUseCSSHTML(body, ThreadItem, ReadList, sTitle);
1178 end else begin
1179 CreateDefaultHTML(body, ThreadItem, ReadList, sTitle);
1180 end;
1181 finally
1182 ReadList.Free;
1183 end;
1184 end;
1185 finally
1186 body.Close;
1187 body.Free;
1188 end;
1189 end;
1190 {$IFDEF DEBUG}
1191 rt := GetTickCount - st;
1192 Writeln('Done.');
1193 Writeln(IntToStr(rt) + ' ms');
1194 {$ENDIF}
1195 end;
1196
1197 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1198 var
1199 i: integer;
1200 No: string;
1201 //bufList : TStringList;
1202 ReadList: TStringList;
1203 // SaveList: TStringList;
1204 CSSFileName: string;
1205 BBSID: string;
1206 FileName: string;
1207 Res: TResRec;
1208 boardPlugIn : TBoardPlugIn;
1209
1210 UserOptionalStyle: string;
1211 SkinHeader: string;
1212 SkinRes: string;
1213 tmp, tmp1: string;
1214 ThreadName: String;
1215 ResLink : TResLinkRec;
1216 function LoadSkin( fileName: string ): string;
1217 begin
1218 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1219 end;
1220 function ReplaceRes( skin: string ): string;
1221 begin
1222 Result := SkinedRes( skin, @Res, No );
1223 end;
1224
1225 begin
1226 if ThreadItem <> nil then begin
1227 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1228 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1229 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1230 ResLink.FKey := ThreadName;
1231 html.Clear;
1232 html.BeginUpdate;
1233 //if ThreadItem.IsBoardPlugInAvailable then begin
1234 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1235 //===== ?????違?ゃ?潟??????茵?ず
1236 //boardPlugIn := ThreadItem.BoardPlugIn;
1237 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1238 // ?????潟?????泣?ゃ?冴??┃絎?
1239 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1240 try
1241 // ??絖??潟?若?????????違?ゃ?潟??算????
1242 // ??????
1243 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1244 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1245 //腟九????с?????後????с??/span>
1246 if GikoSys.Setting.UseSkin then begin
1247 tmp1 := './' + GikoSys.Setting.CSSFileName;
1248 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1249 tmp1 := CustomStringReplace(tmp1, '\', '/');
1250 tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1251 end else if GikoSys.Setting.UseCSS then begin
1252 tmp1 := './' + CSSFileName;
1253 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1254 tmp1 := CustomStringReplace(tmp1, '\', '/');
1255 tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1256 end;
1257 html.Append( tmp );
1258
1259 for i := 0 to threadItem.Count - 1 do begin
1260
1261 // ????/span>
1262 Res.FBody := boardPlugIn.GetRes( DWORD( threadItem ), i + 1 );
1263 ConvertResAnchor(@Res);
1264 html.Append( Res.FBody );
1265
1266 end;
1267 // ?鴻??????????
1268 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1269 finally
1270 end;
1271 html.EndUpdate;
1272 //Exit;
1273 end else begin
1274 ShortDayNames[1] := '??#39;; ShortDayNames[2] := '??';
1275 ShortDayNames[3] := '??#39;; ShortDayNames[4] := '羂?#39;;
1276 ShortDayNames[5] := '??#39;; ShortDayNames[6] := '??';
1277 ShortDayNames[7] := '??';
1278 BBSID := ThreadItem.ParentBoard.BBSID;
1279 ReadList := TStringList.Create;
1280 try
1281 if ThreadItem.IsLogFile then begin
1282 FileName := ThreadItem.GetThreadFileName;
1283 ReadList.LoadFromFile(FileName);
1284 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1285 GikoSys.FAbon.Execute(ReadList); // ???若????????/span>
1286 GikoSys.FSelectResFilter.Execute(ReadList); //???鴻?????c???帥???潟?違??????
1287 DivideStrLine(ReadList[0], @Res);
1288 //Res.FTitle := CustomStringReplace(Res.FTitle, '鐚?鐔?', ',');
1289 sTitle := Res.FTitle;
1290 end else begin
1291 sTitle := CustomStringReplace(ThreadItem.Title, '鐚?鐔?', ',');
1292 end;
1293 try
1294 // ?????潟?????泣?ゃ?冴??┃絎?
1295 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1296
1297 if GikoSys.Setting.UseSkin then begin
1298 // ?鴻???割戎??/span>
1299 // ?鴻???潟??┃絎?
1300 try
1301 SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1302 if Length( UserOptionalStyle ) > 0 then
1303 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1304 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1305 //腟九????с?????後????с??/span>
1306 tmp1 := './' + GikoSys.Setting.CSSFileName;
1307 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1308 tmp1 := CustomStringReplace(tmp1, '\', '/');
1309 SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1310 html.Append( SkinHeader );
1311 except
1312 end;
1313 try
1314 SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1315 except
1316 end;
1317 html.Append('<a name="top"></a>');
1318 for i := 0 to ReadList.Count - 1 do begin
1319 if (Trim(ReadList[i]) <> '') then begin
1320 No := IntToStr(i + 1);
1321
1322 DivideStrLine(ReadList[i], @Res);
1323 AddAnchorTag(@Res);
1324 ConvRes(@Res, @ResLink, true);
1325 ConvertResAnchor(@Res);
1326
1327 try
1328 html.Append( ReplaceRes( SkinRes ) );
1329 except
1330 end;
1331 end;
1332
1333 end;
1334 html.Append('<a name="bottom"></a>');
1335 // ?鴻??????????
1336 try
1337 html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1338 except
1339 end;
1340 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1341 //CSS篏睡??/span>
1342 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1343 html.Append('<html><head>');
1344 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1345 html.Append('<title>' + sTitle + '</title>');
1346 //腟九????с?????後????с??/span>
1347 tmp1 := './' + CSSFileName;
1348 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1349 tmp1 := CustomStringReplace(tmp1, '\', '/');
1350
1351 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1352 if Length( UserOptionalStyle ) > 0 then
1353 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1354 html.Append('</head>');
1355 html.Append('<body>');
1356 html.Append('<a name="top"></a>');
1357 html.Append('<div class="title">' + sTitle + '</div>');
1358 for i := 0 to ReadList.Count - 1 do begin
1359 if (Trim(ReadList[i]) <> '') then begin
1360 No := IntToStr(i + 1);
1361 DivideStrLine(ReadList[i], @Res);
1362 AddAnchorTag(@Res);
1363 ConvRes(@Res, @ResLink, true);
1364 ConvertResAnchor(@Res);
1365 if Res.FMailTo = '' then
1366 html.Append('<a name="' + No + '"></a>'
1367 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1368 + '<span class="name_label">????鐚?</span> '
1369 + '<span class="name"><b>' + Res.FName + '</b></span> '
1370 + '<span class="date_label">??腮炊?ワ?</span> '
1371 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1372 + '<div class="mes">' + Res.FBody + ' </div>')
1373 else if GikoSys.Setting.ShowMail then
1374 html.Append('<a name="' + No + '"></a>'
1375 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1376 + '<span class="name_label"> ????鐚? </span>'
1377 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1378 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1379 + '<span class="date_label"> ??腮炊?ワ?</span>'
1380 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1381 + '<div class="mes">' + Res.FBody + ' </div>')
1382 else
1383 html.Append('<a name="' + No + '"></a>'
1384 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1385 + '<span class="name_label"> ????鐚? </span>'
1386 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1387 + '<b>' + Res.FName + '</b></a>'
1388 + '<span class="date_label"> ??腮炊?ワ?</span>'
1389 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1390 + '<div class="mes">' + Res.FBody + ' </div>');
1391 end;
1392 end;
1393 html.Append('<a name="bottom"></a>');
1394 html.Append('<a name="last"></a>');
1395 html.Append('</body></html>');
1396 end else begin
1397 //CSS??篏睡??/span>
1398 html.Append('<html><head>');
1399 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1400 html.Append('<title>' + sTitle + '</title></head>');
1401 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1402 html.Append('<a name="top"></a>');
1403 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1404 html.Append('<dl>');
1405 for i := 0 to ReadList.Count - 1 do begin
1406 if (Trim(ReadList[i]) <> '') then begin
1407 No := IntToStr(i + 1);
1408 DivideStrLine(ReadList[i], @Res);
1409 AddAnchorTag(@Res);
1410 ConvRes(@Res, @ResLink, true);
1411 ConvertResAnchor(@Res);
1412 if Res.FMailTo = '' then
1413 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>')
1414 else if GikoSys.Setting.ShowMail then
1415 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>')
1416 else
1417 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>');
1418 end;
1419 end;
1420 html.Append('</dl>');
1421 html.Append('<a name="bottom"></a>');
1422 html.Append('</body></html>');
1423 end;
1424 finally
1425 html.EndUpdate;
1426 end;
1427 finally
1428 ReadList.Free;
1429 end;
1430 end;
1431 end;
1432 end;
1433
1434 procedure THTMLCreate.SetResPopupText(Hint : TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
1435 var
1436 i: Integer;
1437 tmp: string;
1438 FileName: string;
1439 Line: Integer;
1440
1441 wkInt: Integer;
1442
1443 Res: TResRec;
1444 Header: string;
1445 Body: string;
1446 boardPlugIn : TBoardPlugIn;
1447 begin
1448 try
1449 if StNum > ToNum then begin
1450 wkInt := StNum;
1451 StNum := ToNum;
1452 ToNum := wkInt;
1453 end;
1454
1455 //??紊?0???鴻?障?ц;腓?/span>
1456 if StNum + MAX_POPUP_RES < ToNum then
1457 ToNum := StNum + MAX_POPUP_RES;
1458
1459 //?帥?ゃ????;腓?/span>
1460 if Title then
1461 if ThreadItem <> nil then
1462 Hint.Title := ThreadItem.Title;
1463
1464 if ThreadItem <> nil then begin
1465 //if ThreadItem.IsBoardPlugInAvailable then begin
1466 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1467 //===== ?????違?ゃ?潟??????茵?ず
1468 //boardPlugIn := ThreadItem.BoardPlugIn;
1469 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1470
1471 // ?????潟?????泣?ゃ?冴??┃絎?
1472 // ??絖??潟?若?????????違?ゃ?潟??算????
1473 for i := StNum to ToNum do begin
1474 Line := i;
1475 //?????э??<??????????at??就綣?э?茵?茯??粋昭?????逸愁鐔ワ愁????茯??????????????c??
1476 tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
1477 if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1478 DivideStrLine(tmp, @Res);
1479 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
1480 Header := IntToStr(Line) + ' ????鐚? ' + Res.FName + ' ??腮炊?ワ? ' + Res.FDateTime
1481 else
1482 Header := IntToStr(Line) + ' ????鐚? ' + Res.FName + ' [' + res.FMailTo + '] ??腮炊?ワ? ' + Res.FDateTime;
1483 Header := DeleteFontTag(Header);
1484 Header := CustomStringReplace(Header, '<br>', '',true);
1485
1486 Body := CustomStringReplace(Res.FBody, '<br> ', #10,true);
1487 Body := CustomStringReplace(Body, '<br>', #10,true);
1488 Body := CustomStringReplace(Body, '</a>', '',true);
1489 Body := THTMLCreate.DeleteLink(Body);
1490 Body := CustomStringReplace(Body, '&lt;', '<');
1491 Body := CustomStringReplace(Body, '&gt;', '>');
1492 Body := CustomStringReplace(Body, '&quot;', '"');
1493 Body := CustomStringReplace(Body, '&amp;', '&');
1494 Body := CustomStringReplace(Body, '&nbsp;', ' ');
1495
1496 Hint.Add(Header, Body);
1497 end;
1498 end;
1499 end else begin
1500 for i := StNum to ToNum do begin
1501 Line := i;
1502 FileName := ThreadItem.FilePath;
1503 tmp := GikoSys.ReadThreadFile(FileName, Line);
1504 if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1505 DivideStrLine(tmp, @Res);
1506 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
1507 Header := IntToStr(Line) + ' ????鐚? ' + Res.FName + ' ??腮炊?ワ? ' + Res.FDateTime
1508 else
1509 Header := IntToStr(Line) + ' ????鐚? ' + Res.FName + ' [' + res.FMailTo + '] ??腮炊?ワ? ' + Res.FDateTime;
1510
1511 Body := DeleteFontTag(Res.FBody);
1512 Body := CustomStringReplace(Body, '<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 Hint.Add(Header, Body);
1522 end;
1523 end;
1524 end;
1525 end;
1526 finally
1527 end;
1528 end;
1529
1530 //???潟??????絖??????????鴻???????≪????????RL?????????
1531 class function THTMLCreate.GetRespopupURL(AText, AThreadURL : string): string;
1532 var
1533 wkInt: Integer;
1534 begin
1535 Result := '';
1536 if Pos('about:blank..', AText) = 1 then begin
1537 wkInt := LastDelimiter( '/', AThreadURL );
1538 if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin
1539 // Thread.URL ? PATH_INFO 羝<??
1540 Result := Copy( AThreadURL, 1, LastDelimiter( '/', AThreadURL ) );
1541 wkInt := LastDelimiter( '/', AText );
1542 if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then
1543 // Text ?? PATH_INFO 羝<??
1544 Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt )
1545 else
1546 // Text ? QUERY_STRING 羝<??
1547 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt );
1548 end else begin
1549 // Thread.URL ? QUERY_STRING 羝<??
1550 Result := Copy( AThreadURL, 1, LastDelimiter( '?', AThreadURL ) );
1551 wkInt := LastDelimiter( '/', AText );
1552 if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then begin
1553 // Text ? PATH_INFO 羝<??
1554 // URL ???帥?????若??莇潟????????? Text ???????眼????
1555 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1556 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1557 Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt );
1558 end else begin
1559 // Text ?? QUERY_STRING 羝<??
1560 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt )
1561 end;
1562 end;
1563 end else if Pos('about:blank/bbs/', AText) = 1 then begin
1564 //????????BBS???紊????後?/span>
1565 AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/');
1566 Result := GetRespopupURL(AText, AThreadURL);
1567 end else begin
1568 Result := AText;
1569 end;
1570
1571 end;
1572 //??絎????????鴻???鴻???潟???????SS?????<?ゃ?????潟???若??篏???
1573 class procedure THTMLCreate.SkinorCSSFilesCopy(path: string);
1574 var
1575 tmp, tmpD, tmpF: string;
1576 current: string;
1577 dirs: TStringList;
1578 files: TStringList;
1579 i, j: Integer;
1580 begin
1581 if GikoSys.Setting.UseSkin then begin
1582 current := ExtractFilePath(GikoSys.GetSkinDir);
1583 tmp := GikoSys.Setting.CSSFileName;
1584 end else if GikoSys.Setting.UseCSS then begin
1585 current := ExtractFilePath(GikoSys.GetStyleSheetDir);
1586 tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName);
1587 end;
1588 dirs := TStringList.Create;
1589 try
1590 dirs.Add(tmp);
1591 if tmp <> current then begin
1592 GikoSys.GetDirectoryList(current, '*.*', dirs, true);
1593 for i := 0 to dirs.Count - 1 do begin
1594 files := TStringList.Create;
1595 try
1596 files.BeginUpdate;
1597 gikoSys.GetFileList(dirs[i], '*.*', files, true);
1598 files.EndUpdate;
1599 tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path);
1600 if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then
1601 ForceDirectories(tmpD);
1602
1603 if(dirs[i] = tmp) and (dirs[i] <> current) then begin
1604 for j := 0 to files.Count - 1 do begin
1605 tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path);
1606 if not FileExists(tmpF) then begin
1607 CopyFile(PChar(files[j]), PChar(tmpF),True);
1608 end;
1609 end;
1610 end;
1611 finally
1612 files.Free;
1613 end;
1614 end;
1615 end else begin
1616 tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path);
1617 if not DirectoryExists(tmpD) then
1618 ForceDirectories(tmpD);
1619 tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName
1620 , GikoSys.GetConfigDir, path);
1621 if not FileExists(tmpF) then begin
1622 CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName)
1623 , PChar(tmpF), True);
1624 end;
1625 end;
1626 finally
1627 dirs.Free;
1628 end;
1629 end;{!
1630 \brief dat???<?ゃ????????ゃ?潟????茹?/span>
1631 \param Line dat???<?ゃ????罕??????? 1 茵?
1632 \return ???号????/span>
1633 }
1634 class procedure THTMLCreate.DivideStrLine(Line: string; PRes: PResRec);
1635 const
1636 delimiter = '<>';
1637 var
1638 pds, pde : PChar;
1639 pss, pse : PChar;
1640 ppos : PChar;
1641 begin
1642 //?阪?
1643 PRes.FType := glt2chNew;
1644
1645 pss := PChar(Line);
1646 pse := pss + Length(Line);
1647 pds := PChar(delimiter);
1648 pde := pds + Length(delimiter);
1649
1650 ppos := AnsiStrPosEx(pss, pse, pds, pde);
1651 if (ppos = nil) then begin
1652 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
1653 Line := CustomStringReplace(Line, ',', '<>');
1654 Line := CustomStringReplace(Line, '鐚?鐔?', ',');
1655 end;
1656 //Trim??????????????羂?????????by??????
1657 PRes.FName := RemoveToken(Line, delimiter);
1658 PRes.FMailTo := RemoveToken(Line, delimiter);
1659 PRes.FDateTime := RemoveToken(Line, delimiter);
1660 PRes.FBody := RemoveToken(Line, delimiter);
1661 //鐚??<????????????????????????????????ゅ??茹?腥榊?純???ャ?c?????????у???ゃ????
1662 //篁???イ腓堺?帥?с?????壕???????純???????????????????????????
1663 PRes.FBody := TrimLeft(PRes.FBody);
1664 //腥冴?????馹???莎激??????????腥榊?純??荐??????
1665 if PRes.FBody = '' then
1666 PRes.FBody := '&nbsp;';
1667
1668 PRes.FTitle := RemoveToken(Line, delimiter);
1669 end;
1670
1671 {!
1672 \brief HTML ?????≪?潟???若?帥?違??????/span>
1673 \param s ???????? HTML
1674 \return ?≪?潟???若?帥?違?????ゃ?????? HTML
1675 }
1676 class function THTMLCreate.DeleteLink(const s: string): string;
1677 var
1678 s1: string;
1679 s2: string;
1680 idx: Integer;
1681 i: Integer;
1682 begin
1683 i := 0;
1684 Result := '';
1685 while True do begin
1686 s1 := GikoSys.GetTokenIndex(s, '<a href="', i);
1687 s2 := GikoSys.GetTokenIndex(s, '<a href="', i + 1);
1688
1689 idx := Pos('">', s1);
1690 if idx <> 0 then
1691 Delete(s1, 1, idx + 1);
1692 idx := Pos('">', s2);
1693 if idx <> 0 then
1694 Delete(s2, 1, idx + 1);
1695
1696 Result := Result + s1 + s2;
1697
1698 if s2 = '' then
1699 Break;
1700
1701 inc(i, 2);
1702 end;
1703 end;
1704
1705 constructor TBufferedWebBrowser.Create(Browser: TWebBrowser; BuffSize: Integer);
1706 begin
1707 inherited Create;
1708 Self.Sorted := False;
1709 if (Browser = nil) then
1710 Raise Exception.Create('Browser is NULL');
1711 FBrowser := Browser;
1712
1713 // ???????<????茵??違??
1714 if (BuffSize < 0) then begin
1715 FBuffSize := 100;
1716 end else begin
1717 FBuffSize := BuffSize;
1718 end;
1719 Self.Capacity := FBuffSize + 1;
1720 end;
1721 procedure TBufferedWebBrowser.Open;
1722 begin
1723 FBrowserDoc := Idispatch( olevariant(FBrowser.ControlInterface).Document);
1724 FBrowserDoc.open;
1725 FBrowserDoc.charset := 'Shift_JIS';
1726 end;
1727 procedure TBufferedWebBrowser.Close;
1728 begin
1729 if (Self.Count > 0) then begin
1730 FBrowserDoc.Write(Self.Text);
1731 Self.Clear;
1732 end;
1733 try
1734 FBrowserDoc.Close;
1735 except
1736 end;
1737 FBrowser := nil;
1738 end;
1739 function TBufferedWebBrowser.Add(const S: string): Integer;
1740 begin
1741 Result := inherited Add(S);
1742 if (Self.Count > FBuffSize) then begin
1743 FBrowserDoc.Write(Self.Text);
1744 Self.Clear;
1745 end;
1746 end;
1747 destructor TBufferedWebBrowser.Destory;
1748 begin
1749 try
1750 if (FBrowserDoc <> 0) then begin
1751 FBrowserDoc.close;
1752 FBrowserDoc := 0;
1753 end;
1754 except
1755 end;
1756 inherited;
1757 end;
1758
1759 initialization
1760 HTMLCreater := THTMLCreate.Create;
1761
1762 finalization
1763 if HTMLCreater <> nil then begin
1764 HTMLCreater.Free;
1765 HTMLCreater := nil;
1766 end;
1767
1768 end.

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