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.29 - (show annotations) (download) (as text)
Sun Aug 13 00:05:02 2006 UTC (17 years, 8 months ago) by h677
Branch: MAIN
CVS Tags: v1_54_0_679
Changes since 1.28: +3 -1 lines
File MIME type: text/x-pascal
HTML化して保存する際に、CSS/Skinを使用していないと、
フォルダの生成に失敗のエラーが表示される不具合の修正

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

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