Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/HTMLCreate.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.14 - (hide annotations) (download) (as text)
Wed Dec 7 15:48:16 2005 UTC (18 years, 4 months ago) by h677
Branch: MAIN
Changes since 1.13: +58 -86 lines
File MIME type: text/x-pascal
HTML作成部分の最適化

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

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