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.23 - (show annotations) (download) (as text)
Wed Feb 22 18:28:48 2006 UTC (18 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_52_0_648
Changes since 1.22: +2 -2 lines
File MIME type: text/x-pascal
CSSで、メール欄が無いときにハンドル名と送信日時がくっつく不具合の修正

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

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