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.18.2.1 - (show annotations) (download) (as text)
Sat Dec 31 13:59:25 2005 UTC (18 years, 3 months ago) by h677
Branch: Bb51
CVS Tags: v1_51_1_639, v1_51_1_640
Changes since 1.18: +1 -1 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;
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(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
42 procedure CreateUseSKINHTML(doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList);
43 procedure CreateUseCSSHTML(doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
44 procedure CreateDefaultHTML (doc: Variant; 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: Variant; 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(doc: Variant; 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 doc.Write( boardPlugIn.GetHeader( DWORD( threadItem ),
797 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
798 doc.Write('<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 doc.Write( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
823 else
824 doc.Write( '<a name="new"></a>');
825 end else if GikoSys.Setting.UseCSS then begin
826 doc.Write('<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 doc.Write('</dl>');
829 doc.Write('<a name="new"></a>');
830 doc.Write('<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 doc.Write('<dl>');
832 end;
833 except
834 doc.Write( '<a name="new"></a>');
835 end;
836 end;
837
838 // ???X
839 doc.Write( 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 doc.Write( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
847 else
848 doc.Write( '<a name="koko"></a>');
849 end else if GikoSys.Setting.UseCSS then begin
850 doc.Write('<a name="koko"></a><div class="koko">?R?R???長?????転</div>');
851 end else begin
852 doc.Write('</dl>');
853 doc.Write('<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 doc.Write('<dl>');
855 end;
856 except
857 doc.Write( '<a name="koko"></a>');
858 end;
859 end;
860 end;
861
862
863 // ?X?L??(?t?b?^)
864 doc.Write( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ));
865 finally
866 doc.Close;
867 end;
868 end;
869
870
871 procedure THTMLCreate.CreateUseSKINHTML(doc: Variant; 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 doc.Write( SkinHeader );
904 except
905 end;
906
907 SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
908 SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
909
910 doc.Write('<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 doc.Write( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
933 else
934 doc.Write( 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 doc.Write(SkinedRes(SkinNewRes, @Res, IntToStr(i + 1)))
946 else
947 // ???鱈?????X
948 doc.Write(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 doc.Write( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ) + #13#10 )
955 else
956 doc.Write( KOKO_TAG );
957 end;
958 end;
959
960 doc.Write('<a name="bottom"></a>');
961 // ?X?L??(?t?b?^)
962 doc.Write( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
963 finally
964 doc.close;
965 end;
966 end;
967
968 procedure THTMLCreate.CreateUseCSSHTML(doc: Variant; 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
985 var
986 i: integer;
987 No: string;
988 CSSFileName: string;
989 NewReceiveNo: Integer;
990 Res: TResRec;
991 UserOptionalStyle: string;
992 ThreadName :String;
993 ResLink :TResLinkRec;
994 begin
995 doc.open;
996 try
997 doc.charset := 'Shift_JIS';
998 NewReceiveNo := ThreadItem.NewReceive;
999 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1000 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1001 ResLink.FKey := ThreadName;
1002 // ?t?H???g?但?T?C?Y??????
1003 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1004 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1005 if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1006 //CSS?g?p
1007 doc.Write('<html><head>');
1008 doc.Write('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1009 doc.Write('<title>' + sTitle + '</title>');
1010 doc.Write('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1011 if Length( UserOptionalStyle ) > 0 then
1012 doc.Write('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1013 doc.Write('</head>'#13#10'<body>');
1014 doc.Write('<a name="top"></a>'#13#10'<p id="idSearch"></p>');
1015 doc.Write('<div class="title">' + sTitle + '</div>');
1016 for i := 0 to ReadList.Count - 1 do begin
1017 // 1 ???K?存?\??
1018 if i <> 0 then begin
1019 // ?\????????????
1020 case GikoSys.ResRange of
1021 Ord( grrKoko ):
1022 if ThreadItem.Kokomade > (i + 1) then
1023 Continue;
1024 Ord( grrNew ):
1025 if NewReceiveNo > (i + 1) then
1026 Continue;
1027 10..65535:
1028 if (threadItem.Count - i) > GikoSys.ResRange then
1029 Continue;
1030 end;
1031 end;
1032
1033 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1034 doc.Write('<a name="new"></a><div class="new">?V?????X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1035 end;
1036
1037 if (Trim(ReadList[i]) <> '') then begin
1038 No := IntToStr(i + 1);
1039 DivideStrLine(ReadList[i], @Res);
1040 AddAnchorTag(@Res);
1041 ConvRes(@Res, @ResLink);
1042 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1043 if Res.FMailTo = '' then
1044 doc.Write(Format(FORMAT_NOMAIL, [No, No, No, Res.FName, Res.FDateTime, Res.FBody]))
1045 else if GikoSys.Setting.ShowMail then
1046 doc.Write(Format(FORMAT_SHOWMAIL, [No, No, No, Res.FMailTo, Res.FName, Res.FMailTo, Res.FDateTime, Res.FBody]))
1047 else
1048 doc.Write(Format(FORMAT_NOSHOW, [No, No, No, Res.FMailTo, Res.FName, Res.FDateTime, Res.FBody]));
1049 end;
1050
1051 if ThreadItem.Kokomade = (i + 1) then begin
1052 doc.Write('<a name="koko"></a><div class="koko">?R?R???長?????転</div>');
1053 end;
1054
1055 end;
1056
1057 doc.Write('<a name="bottom"></a>');
1058 doc.Write('<a name="last"></a>');
1059 doc.Write('</body></html>');
1060 end;
1061 finally
1062 doc.Close;
1063 end;
1064 end;
1065
1066 procedure THTMLCreate.CreateDefaultHTML (doc: Variant; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
1067 var
1068 i: integer;
1069 No: string;
1070 NewReceiveNo: Integer;
1071 Res: TResRec;
1072 ThreadName: String;
1073 ResLink : TResLinkRec;
1074 begin
1075 doc.open;
1076 try
1077 doc.charset := 'Shift_JIS';
1078 NewReceiveNo := ThreadItem.NewReceive;
1079 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1080 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1081 ResLink.FKey := ThreadName;
1082 doc.Write('<html><head>'#13#10);
1083 doc.Write('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">'#13#10);
1084 doc.Write('<title>' + sTitle + '</title></head>'#13#10);
1085 doc.Write('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">'#13#10);
1086 doc.Write('<a name="top"></a>'#13#10);
1087 doc.Write('<font size=+1 color="#FF0000">' + sTitle + '</font>'#13#10);
1088 doc.Write('<dl>'#13#10);
1089 doc.Write('<p id="idSearch"></p>'#13#10);
1090 for i := 0 to ReadList.Count - 1 do begin
1091 // 1 ???K?存?\??
1092 if i <> 0 then begin
1093 // ?\????????????
1094 case GikoSys.ResRange of
1095 Ord( grrKoko ):
1096 if ThreadItem.Kokomade > (i + 1) then
1097 Continue;
1098 Ord( grrNew ):
1099 if NewReceiveNo > (i + 1) then
1100 Continue;
1101 10..65535:
1102 if (threadItem.Count - i) > GikoSys.ResRange then
1103 Continue;
1104 end;
1105 end;
1106
1107 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1108 doc.Write('</dl>');
1109 doc.Write('<a name="new"></a>');
1110 doc.Write('<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>');
1111 doc.Write('<dl>');
1112 end;
1113
1114 if (Trim(ReadList[i]) <> '') then begin
1115 No := IntToStr(i + 1);
1116 DivideStrLine(ReadList[i], @Res);
1117 AddAnchorTag(@Res);
1118 ConvRes(@Res, @ResLink);
1119 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1120 if Res.FMailTo = '' then
1121 doc.Write('<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)
1122 else if GikoSys.Setting.ShowMail then
1123 doc.Write('<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)
1124 else
1125 doc.Write('<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);
1126 end;
1127 if ThreadItem.Kokomade = (i + 1) then begin
1128 doc.Write('</dl>');
1129 doc.Write('<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>');
1130 doc.Write('<dl>');
1131 end;
1132 end;
1133 doc.Write('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
1134 finally
1135 doc.Close;
1136 end;
1137 end;
1138
1139 procedure THTMLCreate.CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string);
1140 var
1141 ReadList: TStringList;
1142 CSSFileName: string;
1143 FileName: string;
1144 Res: TResRec;
1145 {$IFDEF DEBUG}
1146 st, rt: Cardinal;
1147 {$ENDIF}
1148 begin
1149 {$IFDEF DEBUG}
1150 Writeln('Create HTML');
1151 st := GetTickCount;
1152 {$ENDIF}
1153 if ThreadItem <> nil then begin
1154 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1155 CreateUsePluginHTML(doc, ThreadItem, sTitle);
1156 end else begin
1157 ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1158 ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1159 ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1160 ShortDayNames[7] := '?y';
1161
1162 ReadList := TStringList.Create;
1163 try
1164 if ThreadItem.IsLogFile then begin
1165 ReadList.BeginUpdate;
1166 FileName := ThreadItem.GetThreadFileName;
1167 ReadList.LoadFromFile(FileName);
1168 ReadList.EndUpdate;
1169 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1170 GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1171 GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1172 if ThreadItem.Title = '' then begin
1173 DivideStrLine(ReadList[0], @Res);
1174 sTitle := Res.FTitle;
1175 end else
1176 sTitle := ThreadItem.Title
1177 end else begin
1178 sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1179 end;
1180 // ?t?H???g?但?T?C?Y??????
1181 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1182 if GikoSys.Setting.UseSkin then begin
1183 CreateUseSKINHTML(doc, ThreadItem, ReadList);
1184 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1185 CreateUseCSSHTML(doc, ThreadItem, ReadList, sTitle);
1186 end else begin
1187 CreateDefaultHTML(doc, ThreadItem, ReadList, sTitle);
1188 end;
1189
1190 finally
1191 ReadList.Free;
1192 end;
1193 end;
1194 end;
1195 {$IFDEF DEBUG}
1196 rt := GetTickCount - st;
1197 Writeln('Done.');
1198 Writeln(IntToStr(rt) + ' ms');
1199 {$ENDIF}
1200 end;
1201
1202 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1203 var
1204 i: integer;
1205 No: string;
1206 //bufList : TStringList;
1207 ReadList: TStringList;
1208 // SaveList: TStringList;
1209 CSSFileName: string;
1210 BBSID: string;
1211 FileName: string;
1212 Res: TResRec;
1213 boardPlugIn : TBoardPlugIn;
1214
1215 UserOptionalStyle: string;
1216 SkinHeader: string;
1217 SkinRes: string;
1218 tmp, tmp1: string;
1219 ThreadName: String;
1220 ResLink : TResLinkRec;
1221 function LoadSkin( fileName: string ): string;
1222 begin
1223 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1224 end;
1225 function ReplaceRes( skin: string ): string;
1226 begin
1227 Result := SkinedRes( skin, @Res, No );
1228 end;
1229
1230 begin
1231 if ThreadItem <> nil then begin
1232 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1233 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1234 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1235 ResLink.FKey := ThreadName;
1236 html.Clear;
1237 html.BeginUpdate;
1238 //if ThreadItem.IsBoardPlugInAvailable then begin
1239 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1240 //===== ?v???O?C???????辿?\??
1241 //boardPlugIn := ThreadItem.BoardPlugIn;
1242 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1243 // ?t?H???g?但?T?C?Y??????
1244 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1245 try
1246 // ?????R?[?h???v???O?C?????C?邸?辿
1247 // ?w?b?_
1248 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1249 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1250 //?但???Q?????巽?????Q????
1251 if GikoSys.Setting.UseSkin then begin
1252 tmp1 := './' + GikoSys.Setting.CSSFileName;
1253 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1254 tmp1 := CustomStringReplace(tmp1, '\', '/');
1255 tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1256 end else if GikoSys.Setting.UseCSS then begin
1257 tmp1 := './' + CSSFileName;
1258 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1259 tmp1 := CustomStringReplace(tmp1, '\', '/');
1260 tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1261 end;
1262 html.Append( tmp );
1263
1264 for i := 0 to threadItem.Count - 1 do begin
1265
1266 // ???X
1267 Res.FBody := boardPlugIn.GetRes( DWORD( threadItem ), i + 1 );
1268 ConvertResAnchor(@Res);
1269 html.Append( Res.FBody );
1270
1271 end;
1272 // ?X?L??(?t?b?^)
1273 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1274 finally
1275 end;
1276 html.EndUpdate;
1277 //Exit;
1278 end else begin
1279 ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1280 ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1281 ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1282 ShortDayNames[7] := '?y';
1283 BBSID := ThreadItem.ParentBoard.BBSID;
1284 ReadList := TStringList.Create;
1285 try
1286 if ThreadItem.IsLogFile then begin
1287 FileName := ThreadItem.GetThreadFileName;
1288 ReadList.LoadFromFile(FileName);
1289 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1290 GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1291 GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1292 DivideStrLine(ReadList[0], @Res);
1293 //Res.FTitle := CustomStringReplace(Res.FTitle, '???M', ',');
1294 sTitle := Res.FTitle;
1295 end else begin
1296 sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1297 end;
1298 try
1299 // ?t?H???g?但?T?C?Y??????
1300 UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1301
1302 if GikoSys.Setting.UseSkin then begin
1303 // ?X?L???g?p
1304 // ?X?L????????
1305 try
1306 SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1307 if Length( UserOptionalStyle ) > 0 then
1308 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1309 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1310 //?但???Q?????巽?????Q????
1311 tmp1 := './' + GikoSys.Setting.CSSFileName;
1312 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1313 tmp1 := CustomStringReplace(tmp1, '\', '/');
1314 SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1315 html.Append( SkinHeader );
1316 except
1317 end;
1318 try
1319 SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1320 except
1321 end;
1322 html.Append('<a name="top"></a>');
1323 for i := 0 to ReadList.Count - 1 do begin
1324 if (Trim(ReadList[i]) <> '') then begin
1325 No := IntToStr(i + 1);
1326
1327 DivideStrLine(ReadList[i], @Res);
1328 AddAnchorTag(@Res);
1329 ConvRes(@Res, @ResLink, true);
1330 ConvertResAnchor(@Res);
1331
1332 try
1333 html.Append( ReplaceRes( SkinRes ) );
1334 except
1335 end;
1336 end;
1337
1338 end;
1339 html.Append('<a name="bottom"></a>');
1340 // ?X?L??(?t?b?^)
1341 try
1342 html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1343 except
1344 end;
1345 end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1346 //CSS?g?p
1347 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1348 html.Append('<html><head>');
1349 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1350 html.Append('<title>' + sTitle + '</title>');
1351 //?但???Q?????巽?????Q????
1352 tmp1 := './' + CSSFileName;
1353 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1354 tmp1 := CustomStringReplace(tmp1, '\', '/');
1355
1356 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1357 if Length( UserOptionalStyle ) > 0 then
1358 html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1359 html.Append('</head>');
1360 html.Append('<body>');
1361 html.Append('<a name="top"></a>');
1362 html.Append('<div class="title">' + sTitle + '</div>');
1363 for i := 0 to ReadList.Count - 1 do begin
1364 if (Trim(ReadList[i]) <> '') then begin
1365 No := IntToStr(i + 1);
1366 DivideStrLine(ReadList[i], @Res);
1367 AddAnchorTag(@Res);
1368 ConvRes(@Res, @ResLink, true);
1369 ConvertResAnchor(@Res);
1370 if Res.FMailTo = '' then
1371 html.Append('<a name="' + No + '"></a>'
1372 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1373 + '<span class="name_label">?添?O?F</span> '
1374 + '<span class="name"><b>' + Res.FName + '</b></span> '
1375 + '<span class="date_label">???e?炭?F</span> '
1376 + '<span class="date">' + Res.FDateTime+ '</span></div>'
1377 + '<div class="mes">' + Res.FBody + ' </div>')
1378 else if GikoSys.Setting.ShowMail then
1379 html.Append('<a name="' + No + '"></a>'
1380 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1381 + '<span class="name_label"> ?添?O?F </span>'
1382 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1383 + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1384 + '<span class="date_label"> ???e?炭?F</span>'
1385 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1386 + '<div class="mes">' + Res.FBody + ' </div>')
1387 else
1388 html.Append('<a name="' + No + '"></a>'
1389 + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1390 + '<span class="name_label"> ?添?O?F </span>'
1391 + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1392 + '<b>' + Res.FName + '</b></a>'
1393 + '<span class="date_label"> ???e?炭?F</span>'
1394 + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1395 + '<div class="mes">' + Res.FBody + ' </div>');
1396 end;
1397 end;
1398 html.Append('<a name="bottom"></a>');
1399 html.Append('<a name="last"></a>');
1400 html.Append('</body></html>');
1401 end else begin
1402 //CSS???g?p
1403 html.Append('<html><head>');
1404 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1405 html.Append('<title>' + sTitle + '</title></head>');
1406 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1407 html.Append('<a name="top"></a>');
1408 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1409 html.Append('<dl>');
1410 for i := 0 to ReadList.Count - 1 do begin
1411 if (Trim(ReadList[i]) <> '') then begin
1412 No := IntToStr(i + 1);
1413 DivideStrLine(ReadList[i], @Res);
1414 AddAnchorTag(@Res);
1415 ConvRes(@Res, @ResLink, true);
1416 ConvertResAnchor(@Res);
1417 if Res.FMailTo = '' then
1418 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>')
1419 else if GikoSys.Setting.ShowMail then
1420 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>')
1421 else
1422 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>');
1423 end;
1424 end;
1425 html.Append('</dl>');
1426 html.Append('<a name="bottom"></a>');
1427 html.Append('</body></html>');
1428 end;
1429 finally
1430 html.EndUpdate;
1431 end;
1432 finally
1433 ReadList.Free;
1434 end;
1435 end;
1436 end;
1437 end;
1438
1439 procedure THTMLCreate.SetResPopupText(Hint : TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
1440 var
1441 i: Integer;
1442 tmp: string;
1443 FileName: string;
1444 Line: Integer;
1445
1446 wkInt: Integer;
1447
1448 Res: TResRec;
1449 Header: string;
1450 Body: string;
1451 boardPlugIn : TBoardPlugIn;
1452 begin
1453 try
1454 if StNum > ToNum then begin
1455 wkInt := StNum;
1456 StNum := ToNum;
1457 ToNum := wkInt;
1458 end;
1459
1460 //?長?頂10???X???長?\??
1461 if StNum + MAX_POPUP_RES < ToNum then
1462 ToNum := StNum + MAX_POPUP_RES;
1463
1464 //?^?C?g???\??
1465 if Title then
1466 if ThreadItem <> nil then
1467 Hint.Title := ThreadItem.Title;
1468
1469 if ThreadItem <> nil then begin
1470 //if ThreadItem.IsBoardPlugInAvailable then begin
1471 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1472 //===== ?v???O?C???????辿?\??
1473 //boardPlugIn := ThreadItem.BoardPlugIn;
1474 boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1475
1476 // ?t?H???g?但?T?C?Y??????
1477 // ?????R?[?h???v???O?C?????C?邸?辿
1478 for i := StNum to ToNum do begin
1479 Line := i;
1480 //?????長?Q?甜?叩?????辿??dat???`?貼?長?P?s????????????捗捗捗?B?鼎?????辿???造????????
1481 tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
1482 if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1483 DivideStrLine(tmp, @Res);
1484 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
1485 Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' ???e?炭?F ' + Res.FDateTime
1486 else
1487 Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' [' + res.FMailTo + '] ???e?炭?F ' + Res.FDateTime;
1488 Header := DeleteFontTag(Header);
1489 Header := CustomStringReplace(Header, '<br>', '',true);
1490
1491 Body := CustomStringReplace(Res.FBody, '<br> ', #10,true);
1492 Body := CustomStringReplace(Body, '<br>', #10,true);
1493 Body := CustomStringReplace(Body, '</a>', '',true);
1494 Body := THTMLCreate.DeleteLink(Body);
1495 Body := CustomStringReplace(Body, '&lt;', '<');
1496 Body := CustomStringReplace(Body, '&gt;', '>');
1497 Body := CustomStringReplace(Body, '&quot;', '"');
1498 Body := CustomStringReplace(Body, '&amp;', '&');
1499 Body := CustomStringReplace(Body, '&nbsp;', ' ');
1500
1501 Hint.Add(Header, Body);
1502 end;
1503 end;
1504 end else begin
1505 for i := StNum to ToNum do begin
1506 Line := i;
1507 FileName := ThreadItem.FilePath;
1508 tmp := GikoSys.ReadThreadFile(FileName, Line);
1509 if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1510 DivideStrLine(tmp, @Res);
1511 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
1512 Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' ???e?炭?F ' + Res.FDateTime
1513 else
1514 Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' [' + res.FMailTo + '] ???e?炭?F ' + Res.FDateTime;
1515
1516 Body := DeleteFontTag(Res.FBody);
1517 Body := CustomStringReplace(Body, '<br> ', #10,true);
1518 Body := CustomStringReplace(Body, '<br>', #10,true);
1519 Body := CustomStringReplace(Body, '</a>', '',true);
1520 Body := THTMLCreate.DeleteLink(Body);
1521 Body := CustomStringReplace(Body, '&lt;', '<');
1522 Body := CustomStringReplace(Body, '&gt;', '>');
1523 Body := CustomStringReplace(Body, '&quot;', '"');
1524 Body := CustomStringReplace(Body, '&amp;', '&');
1525 Body := CustomStringReplace(Body, '&nbsp;', ' ');
1526 Hint.Add(Header, Body);
1527 end;
1528 end;
1529 end;
1530 end;
1531 finally
1532 end;
1533 end;
1534
1535 //?????N???????????巽???X?|?b?v?A?b?v?p??URL?????????辿
1536 class function THTMLCreate.GetRespopupURL(AText, AThreadURL : string): string;
1537 var
1538 wkInt: Integer;
1539 begin
1540 Result := '';
1541 if Pos('about:blank..', AText) = 1 then begin
1542 wkInt := LastDelimiter( '/', AThreadURL );
1543 if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin
1544 // Thread.URL ?? PATH_INFO ?n?直
1545 Result := Copy( AThreadURL, 1, LastDelimiter( '/', AThreadURL ) );
1546 wkInt := LastDelimiter( '/', AText );
1547 if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then
1548 // Text ?? PATH_INFO ?n?直
1549 Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt )
1550 else
1551 // Text ?? QUERY_STRING ?n?直
1552 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt );
1553 end else begin
1554 // Thread.URL ?? QUERY_STRING ?n?直
1555 Result := Copy( AThreadURL, 1, LastDelimiter( '?', AThreadURL ) );
1556 wkInt := LastDelimiter( '/', AText );
1557 if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then begin
1558 // Text ?? PATH_INFO ?n?直
1559 // URL ???????L?[???鼎?巽???????長 Text ???巽?存?????辿
1560 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1561 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1562 Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt );
1563 end else begin
1564 // Text ?? QUERY_STRING ?n?直
1565 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt )
1566 end;
1567 end;
1568 end else if Pos('about:blank/bbs/', AText) = 1 then begin
1569 //?直???巽??JBBS???d?????z?撤
1570 AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/');
1571 Result := GetRespopupURL(AText, AThreadURL);
1572 end else begin
1573 Result := AText;
1574 end;
1575
1576 end;
1577 //?w???直???p?X???X?L?????直?足??CSS???t?@?C?????R?s?[?????辿
1578 class procedure THTMLCreate.SkinorCSSFilesCopy(path: string);
1579 var
1580 tmp, tmpD, tmpF: string;
1581 current: string;
1582 dirs: TStringList;
1583 files: TStringList;
1584 i, j: Integer;
1585 begin
1586 if GikoSys.Setting.UseSkin then begin
1587 current := ExtractFilePath(GikoSys.GetSkinDir);
1588 tmp := GikoSys.Setting.CSSFileName;
1589 end else if GikoSys.Setting.UseCSS then begin
1590 current := ExtractFilePath(GikoSys.GetStyleSheetDir);
1591 tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName);
1592 end;
1593 dirs := TStringList.Create;
1594 try
1595 dirs.Add(tmp);
1596 if tmp <> current then begin
1597 GikoSys.GetDirectoryList(current, '*.*', dirs, true);
1598 for i := 0 to dirs.Count - 1 do begin
1599 files := TStringList.Create;
1600 try
1601 files.BeginUpdate;
1602 gikoSys.GetFileList(dirs[i], '*.*', files, true);
1603 files.EndUpdate;
1604 tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path);
1605 if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then
1606 ForceDirectories(tmpD);
1607
1608 if(dirs[i] = tmp) and (dirs[i] <> current) then begin
1609 for j := 0 to files.Count - 1 do begin
1610 tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path);
1611 if not FileExists(tmpF) then begin
1612 CopyFile(PChar(files[j]), PChar(tmpF),True);
1613 end;
1614 end;
1615 end;
1616 finally
1617 files.Free;
1618 end;
1619 end;
1620 end else begin
1621 tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path);
1622 if not DirectoryExists(tmpD) then
1623 ForceDirectories(tmpD);
1624 tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName
1625 , GikoSys.GetConfigDir, path);
1626 if not FileExists(tmpF) then begin
1627 CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName)
1628 , PChar(tmpF), True);
1629 end;
1630 end;
1631 finally
1632 dirs.Free;
1633 end;
1634 end;{!
1635 \brief dat?t?@?C?????????C????????
1636 \param Line dat?t?@?C?????\?店???辿 1 ?s
1637 \return ???X?樽??
1638 }
1639 class procedure THTMLCreate.DivideStrLine(Line: string; PRes: PResRec);
1640 const
1641 delimiter = '<>';
1642 var
1643 pds, pde : PChar;
1644 pss, pse : PChar;
1645 ppos : PChar;
1646 begin
1647 //?長??
1648 PRes.FType := glt2chNew;
1649
1650 pss := PChar(Line);
1651 pse := pss + Length(Line);
1652 pds := PChar(delimiter);
1653 pde := pds + Length(delimiter);
1654
1655 ppos := AnsiStrPosEx(pss, pse, pds, pde);
1656 if (ppos = nil) then begin
1657 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
1658 Line := CustomStringReplace(Line, ',', '<>');
1659 Line := CustomStringReplace(Line, '???M', ',');
1660 end;
1661 //Trim?直???????纏?????C?????辿?@by??????
1662 PRes.FName := RemoveToken(Line, delimiter);
1663 PRes.FMailTo := RemoveToken(Line, delimiter);
1664 PRes.FDateTime := RemoveToken(Line, delimiter);
1665 PRes.FBody := RemoveToken(Line, delimiter);
1666 //?Q?甜?叩?????辿?????転???A?{???????????P???添?p?坦?????端???????辿???長?鱈?????辿
1667 //?添???f?????長?A???X???????坦???????直???????纏???泥?????炭???辿
1668 PRes.FBody := TrimLeft(PRes.FBody);
1669 //?坦?転???但?????N?鼎?辿???巽?A?坦???????????辿
1670 if PRes.FBody = '' then
1671 PRes.FBody := '&nbsp;';
1672
1673 PRes.FTitle := RemoveToken(Line, delimiter);
1674 end;
1675
1676 {!
1677 \brief HTML ???巽?A???J?[?^?O???鱈??
1678 \param s ???????辿 HTML
1679 \return ?A???J?[?^?O???鱈???????? HTML
1680 }
1681 class function THTMLCreate.DeleteLink(const s: string): string;
1682 var
1683 s1: string;
1684 s2: string;
1685 idx: Integer;
1686 i: Integer;
1687 begin
1688 i := 0;
1689 Result := '';
1690 while True do begin
1691 s1 := GikoSys.GetTokenIndex(s, '<a href="', i);
1692 s2 := GikoSys.GetTokenIndex(s, '<a href="', i + 1);
1693
1694 idx := Pos('">', s1);
1695 if idx <> 0 then
1696 Delete(s1, 1, idx + 1);
1697 idx := Pos('">', s2);
1698 if idx <> 0 then
1699 Delete(s2, 1, idx + 1);
1700
1701 Result := Result + s1 + s2;
1702
1703 if s2 = '' then
1704 Break;
1705
1706 inc(i, 2);
1707 end;
1708 end;
1709
1710
1711
1712 initialization
1713 HTMLCreater := THTMLCreate.Create;
1714
1715 finalization
1716 if HTMLCreater <> nil then begin
1717 HTMLCreater.Free;
1718 HTMLCreater := nil;
1719 end;
1720
1721 end.

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