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

1 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.21 {Sort,} ,GikoBayesian, HintWindow, ActiveX;
19 h677 1.1
20     type
21 h677 1.16
22     PResLinkRec = ^TResLinkRec;
23     TResLinkRec = record
24     FBbs: string;
25     FKey : string;
26     end;
27    
28 h677 1.1 THTMLCreate = class(TObject)
29     private
30     { Private ?辿?転 }
31 h677 1.4 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 h677 1.1 function AddBeProfileLink(AID : string; ANum: Integer):string ;
41 h677 1.21 procedure CreateUsePluginHTML(html:TStringList; ThreadItem: TThreadItem; var sTitle: string);
42     procedure CreateUseSKINHTML(html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
43     procedure CreateUseCSSHTML(html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
44     procedure CreateDefaultHTML (html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
45 h677 1.13 procedure ConvertResAnchor(PRes: PResRec);
46 h677 1.5 procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
47 h677 1.16 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 h677 1.1 public
51     { Public ?辿?転 }
52 h677 1.13 procedure AddAnchorTag(PRes: PResRec);
53 h677 1.2 function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;
54 h677 1.12 function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;
55 h677 1.16 procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;
56 h677 1.2 function ConvRes(const Body, Bbs, Key, ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;
57 h677 1.21 procedure CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);
58 h677 1.2 procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
59 h677 1.8 //???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 h677 1.16 //dat?P?s?????X?????????辿
66     class procedure DivideStrLine(Line: string; PRes: PResRec);
67 h677 1.17 //HTML???巽?????N?^?O???鱈?????辿
68     class function DeleteLink(const s: string): string;
69 h677 1.1 end;
70    
71     var
72     HTMLCreater: THTMLCreate;
73    
74     implementation
75    
76 h677 1.4 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 h677 1.1 // ?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 h677 1.6 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 h677 1.1 //----- ???????長
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 h677 1.11 const skin: string;
174 h677 1.12 PRes: PResRec;
175 h677 1.11 const No: string
176 h677 1.1 ): string;
177 h677 1.11 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 h677 1.1 var
182     spamminess : Extended;
183 h677 1.11 {$IFDEF SPAM_FILTER_ENABLED}
184 h677 1.1 wordCount : TWordCount;
185 h677 1.11 {$ENDIF}
186 h677 1.1 begin
187 h677 1.11 {$IFDEF SPAM_FILTER_ENABLED}
188 h677 1.1 wordCount := TWordCount.Create;
189     try
190     spamminess := Floor( GikoSys.SpamParse(
191     Res.FName + '<>' + Res.FMailTo + '<>' + Res.FBody, wordCount ) * 100 );
192 h677 1.11 {$ELSE}
193     spamminess := 0;
194     {$ENDIF}
195 h677 1.14 Result := CustomStringReplace( skin, '<SPAMMINESS/>', FloatToStr( spamminess ) );
196 h677 1.11 Result := CustomStringReplace( Result, '<NONSPAMMINESS/>', FloatToStr( 100 - spamminess ) );
197 h677 1.14 Result := CustomStringReplace( Result, '<MAIL/>', PRes.FMailTo);
198     Result := CustomStringReplace( Result, '<DATE/>', PRes.FDateTime);
199 h677 1.11 Result := CustomStringReplace( Result, '<PLAINNUMBER/>', No);
200     Result := CustomStringReplace( Result, '<NAME/>',
201 h677 1.14 Format(FORMT_NAME, [PRes.FName]));
202 h677 1.11 Result := CustomStringReplace( Result, '<NUMBER/>',
203     Format(FORMT_NUM, [No, No, No]));
204     Result := CustomStringReplace( Result, '<MAILNAME/>',
205 h677 1.14 Format(FORMT_MAILNAME,[PRes.FMailTo, PRes.FName]));
206     Result := CustomStringReplace( Result, '<MESSAGE/>', PRes.FBody);
207    
208 h677 1.1 //----- ???甜???`?直?叩?????p?B?R?????g?A?E?g?直???????直
209 h677 1.6 if GikoSys.Setting.UseKatjushaType then begin
210 h677 1.11 Result := CustomStringReplace( Result, '&NUMBER',
211 h677 1.6 '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
212 h677 1.11 Result := CustomStringReplace( Result, '&PLAINNUMBER', No);
213 h677 1.14 Result := CustomStringReplace( Result, '&NAME', '<b>' + PRes.FName + '</b>');
214 h677 1.11 Result := CustomStringReplace( Result, '&MAILNAME',
215 h677 1.14 '<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 h677 1.11 Result := CustomStringReplace( Result, '&SPAMMINESS', FloatToStr( spamminess ) );
220     Result := CustomStringReplace( Result, '&NONSPAMMINESS', FloatToStr( 100 - spamminess ) );
221 h677 1.6 end;
222 h677 1.1 //----- ???????長
223 h677 1.11 {$IFDEF SPAM_FILTER_ENABLED}
224 h677 1.1 finally
225     wordCount.Free;
226     end;
227 h677 1.11 {$ENDIF}
228 h677 1.1
229     end;
230     (*************************************************************************
231     *http://??????????anchor?^?O?t?鼎?????辿?B
232     *************************************************************************)
233 h677 1.13 procedure THTMLCreate.AddAnchorTag(PRes: PResRec);
234     const
235     _HEAD : array[0..9] of String =
236     ('', 'h', 'ht', '', 'htt', '', 'http://', '', '', '');
237 h677 1.1 var
238     url: string;
239     href: string;
240     i, j, b: Integer;
241     tmp: Integer;
242     idx, idx2: Integer;
243 h677 1.4 pos : PChar;
244 h677 1.1 pp, pe : PChar;
245 h677 1.13 s : String;
246 h677 1.16 len : Integer;
247 h677 1.1 begin
248 h677 1.14 s := PRes.FBody;
249     PRes.FBody := '';
250 h677 1.4
251 h677 1.16 //while True do begin
252     repeat
253 h677 1.1 idx := MaxInt;
254     idx2 := MaxInt;
255 h677 1.4 pp := PChar(s);
256     pe := pp + Length(s);
257    
258 h677 1.1 for j := 0 to 9 do begin
259 h677 1.4 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 h677 1.1 end;
266 h677 1.4
267 h677 1.1 if idx = MaxInt then begin
268     //?????N?????????B
269 h677 1.16 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 h677 1.1
285 h677 1.16 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 h677 1.1 end;
312     end;
313 h677 1.16 until idx = MaxInt;
314 h677 1.1 end;
315    
316     //?????AAID?F???徹?????辿?炭?tID???????AANum:???X?? AURL?F?泥???X???b?h??URL
317     function THTMLCreate.AddBeProfileLink(AID : string; ANum: Integer):string ;
318 h677 1.16 const
319     BE_MARK : string = 'BE:';
320 h677 1.1 var
321     p : integer;
322     BNum, BMark : string;
323     begin
324 h677 1.16 p := AnsiPos(BE_MARK, AnsiUpperCase(AID));
325 h677 1.1 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 h677 1.16 procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text:String; const Separator: String);
340 h677 1.5 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 h677 1.16 procedure THTMLCreate.ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false);
353 h677 1.12 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 h677 1.14 s := PRes.FBody;
403 h677 1.12 //???????N???A
404 h677 1.14 PRes.FBody := '';
405 h677 1.12
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 h677 1.14 PRes.FBody := PRes.FBody + Copy(s, 1, pmin - 1);
424 h677 1.12 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 h677 1.14 PRes.FBody := PRes.FBody + rink;
441 h677 1.12 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 h677 1.16 j := 1;
460     len := Length(s);
461     cm := checkComma(s, j, No);
462 h677 1.12 len := Length(s);
463     while cm do begin
464     oc := '';
465     No := '';
466     sw := false;
467     db := false;
468     getNumberString;
469 h677 1.16 //?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 h677 1.12 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 h677 1.16 //?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 h677 1.12 end;
496     end;
497 h677 1.16 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 h677 1.18 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 h677 1.16 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 h677 1.12 end;
548    
549 h677 1.1 (*************************************************************************
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 h677 1.5 SN = '0123456789';
559     FORMAT_LINK = '<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">';
560 h677 1.10 //???????徹?????????S
561     TOKEN : array[0..5] of string = (GT+GT, GT, '????', '??', '<a ', '<A ');
562 h677 1.1 var
563     i : integer;
564 h677 1.5 s : string;
565 h677 1.1 sw: boolean;
566 h677 1.5 cm: boolean;
567 h677 1.1 No: string;
568     oc : string;
569 h677 1.5 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 h677 1.1 var
577 h677 1.5 st,et : string;
578 h677 1.1 begin
579 h677 1.5 //?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 h677 1.1 end;
600 h677 1.5
601     procedure getNumberString;
602 h677 1.1 begin
603 h677 1.5 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 h677 1.1 end;
615 h677 1.5
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 h677 1.1 end;
626     end;
627     end;
628    
629 h677 1.5 function checkComma : boolean;
630 h677 1.1 begin
631 h677 1.5 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 h677 1.1 end;
643     end;
644     begin
645 h677 1.5 //s ???{?????S???端???辿
646 h677 1.1 s := Body;
647 h677 1.5 //???????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 h677 1.10 pos := AnsiPos(TOKEN[j], s);
656 h677 1.5 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 h677 1.1 end;
680 h677 1.5 end else if (pos <> 0) then begin
681     pmin := pos;
682 h677 1.1 end;
683 h677 1.5 rink := Copy(s, 1, pmin + 3);
684     Result := Result + rink;
685     Delete(s, 1, pmin + 3);
686    
687     pmin := Length(rink);
688 h677 1.10 i := Length(TOKEN);
689 h677 1.5 for j := 0 to 3 do begin
690 h677 1.10 pos := AnsiPos(TOKEN[j], rink);
691 h677 1.5 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 h677 1.1 end;
698     end;
699     end;
700 h677 1.5 // ???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 h677 1.1 end;
715     end else begin
716 h677 1.5 //?????直?巽???????????p?^?[??
717 h677 1.10 j := Length(TOKEN[i]) + 1;
718 h677 1.5 oc := '';
719     No := '';
720     sw := false;
721     db := false;
722     len := Length(s);
723     getNumberString;
724     Result := addResAnchor(Result);
725 h677 1.1 end;
726     end;
727 h677 1.5 Result := Result + s;
728 h677 1.1 end;
729    
730 h677 1.13 procedure THTMLCreate.ConvertResAnchor(PRes: PResRec);
731 h677 1.2 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 h677 1.13 res: string;
742 h677 1.2 begin
743 h677 1.14 res := PRes.FBody;
744     PRes.FBody := '';
745 h677 1.2 i := AnsiPos(_HEAD, res);
746     while i <> 0 do begin
747 h677 1.14 PRes.FBody := PRes.FBody + Copy(res, 1, i -1);
748 h677 1.2 Delete(res, 1, i - 1);
749     j := AnsiPos(_TAIL, res);
750     if j = 0 then begin
751 h677 1.14 PRes.FBody := PRes.FBody + res;
752 h677 1.2 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 h677 1.14 PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
760 h677 1.2 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 h677 1.14 PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
764 h677 1.2 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 h677 1.14 PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
773 h677 1.2 end;
774     i := AnsiPos(_HEAD, res);
775     end;
776 h677 1.14 PRes.FBody := PRes.FBody + res;
777 h677 1.2
778     end;
779    
780 h677 1.1 //Plugin?????p???辿Board???X???b?h??HTML?????店?直??doc?????鼎???鄭
781 h677 1.21 procedure THTMLCreate.CreateUsePluginHTML(html:TStringList; ThreadItem: TThreadItem; var sTitle: string);
782 h677 1.1 var
783     i: integer;
784     NewReceiveNo: Integer;
785     boardPlugIn : TBoardPlugIn;
786     UserOptionalStyle: string;
787     begin
788 h677 1.6 //===== ?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 h677 1.21 // doc.open;
795 h677 1.6 // ?w?b?_
796 h677 1.21 html.add(boardPlugIn.GetHeader( DWORD( threadItem ),
797 h677 1.11 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
798 h677 1.21 html.Add('<p id="idSearch"></p>');
799 h677 1.6
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 h677 1.1
817 h677 1.6 // ?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 h677 1.21 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
823 h677 1.6 else
824 h677 1.21 html.Add( '<a name="new"></a>');
825 h677 1.6 end else if GikoSys.Setting.UseCSS then begin
826 h677 1.21 html.Add('<a name="new"></a><div class="new">?V?????X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
827 h677 1.6 end else begin
828 h677 1.21 html.Add('</dl>');
829     html.Add('<a name="new"></a>');
830     html.Add('<table width="100%" bgcolor="#3333CC" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#6666FF" valign="middle"><font size="-1" color="#ffffff"><b>?V?????X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
831     html.Add('<dl>');
832 h677 1.1 end;
833 h677 1.6 except
834 h677 1.21 html.Add( '<a name="new"></a>');
835 h677 1.6 end;
836     end;
837 h677 1.1
838 h677 1.6 // ???X
839 h677 1.21 html.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ));
840 h677 1.1
841 h677 1.6 if ThreadItem.Kokomade = (i + 1) then begin
842     // ???????長?????転
843     try
844     if GikoSys.Setting.UseSkin then begin
845     if FileExists( GikoSys.GetSkinBookmarkFileName ) then
846 h677 1.21 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
847 h677 1.6 else
848 h677 1.21 html.Add( '<a name="koko"></a>');
849 h677 1.6 end else if GikoSys.Setting.UseCSS then begin
850 h677 1.21 html.Add('<a name="koko"></a><div class="koko">?R?R???長?????転</div>');
851 h677 1.6 end else begin
852 h677 1.21 html.Add('</dl>');
853     html.Add('<a name="koko"></a><table width="100%" bgcolor="#55AA55" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#77CC77" valign="middle"><font size="-1" color="#ffffff"><b>?R?R???長?????転</b></font></td></tr></table>');
854     html.Add('<dl>');
855 h677 1.1 end;
856 h677 1.6 except
857 h677 1.21 html.Add('<a name="koko"></a>');
858 h677 1.1 end;
859 h677 1.6 end;
860     end;
861 h677 1.1
862    
863 h677 1.6 // ?X?L??(?t?b?^)
864 h677 1.21 html.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ));
865 h677 1.6 finally
866 h677 1.21 //doc.Close;
867 h677 1.1 end;
868     end;
869    
870    
871 h677 1.21 procedure THTMLCreate.CreateUseSKINHTML(html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList);
872 h677 1.14 const
873     KOKO_TAG = '<a name="koko"></a>';
874     NEW_TAG = '<a name="new"></a>';
875 h677 1.1 var
876     i: integer;
877     NewReceiveNo: Integer;
878     Res: TResRec;
879     UserOptionalStyle: string;
880     SkinHeader: string;
881     SkinNewRes: string;
882     SkinRes: string;
883 h677 1.7 ThreadName : string;
884 h677 1.16 ResLink :TResLinkRec;
885 h677 1.1 begin
886 h677 1.6 NewReceiveNo := ThreadItem.NewReceive;
887     // ?t?H???g?但?T?C?Y??????
888     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
889 h677 1.7 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
890 h677 1.16 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
891     ResLink.FKey := ThreadName;
892     //,
893 h677 1.21 //doc.open;
894 h677 1.6 try
895 h677 1.21 //doc.charset := 'Shift_JIS';
896 h677 1.6
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 h677 1.21 html.Add( SkinHeader );
904 h677 1.6 except
905     end;
906    
907 h677 1.14 SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
908     SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
909 h677 1.1
910 h677 1.21 html.Add('<p id="idSearch"></p>'#13#10'<a name="top"></a>');
911 h677 1.1
912 h677 1.6 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 h677 1.1 end;
927 h677 1.6 end;
928 h677 1.1
929 h677 1.6 // ?V???}?[?N
930     if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
931 h677 1.14 if FileExists( GikoSys.GetSkinNewmarkFileName ) then
932 h677 1.21 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
933 h677 1.14 else
934 h677 1.21 html.Add( NEW_TAG );
935 h677 1.6 end;
936 h677 1.1
937 h677 1.6 if (Trim(ReadList[i]) <> '') then begin
938 h677 1.12 DivideStrLine(ReadList[i], @Res);
939 h677 1.13 AddAnchorTag(@Res);
940 h677 1.16 ConvRes(@Res, @ResLink);
941 h677 1.6 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
942 h677 1.1
943 h677 1.14 if NewReceiveNo <= (i + 1) then
944     // ?V?????X
945 h677 1.21 html.Add(SkinedRes(SkinNewRes, @Res, IntToStr(i + 1)))
946 h677 1.14 else
947     // ???鱈?????X
948 h677 1.21 html.Add(SkinedRes(SkinRes, @Res, IntToStr(i + 1)));
949 h677 1.6 end;
950 h677 1.1
951 h677 1.6 if ThreadItem.Kokomade = (i + 1) then begin
952     // ???????長?????転
953 h677 1.14 if FileExists( GikoSys.GetSkinBookmarkFileName ) then
954 h677 1.21 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
955 h677 1.14 else
956 h677 1.21 html.Add( KOKO_TAG );
957 h677 1.1 end;
958     end;
959 h677 1.6
960 h677 1.21 html.Add('<a name="bottom"></a>');
961 h677 1.6 // ?X?L??(?t?b?^)
962 h677 1.21 html.Add( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
963 h677 1.6 finally
964 h677 1.21 //doc.close;
965 h677 1.1 end;
966     end;
967    
968 h677 1.21 procedure THTMLCreate.CreateUseCSSHTML(html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
969 h677 1.10 const
970     FORMAT_NOMAIL = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
971 h677 1.23 + '<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 h677 1.21 + '<div class="mes">%s</div>';
974 h677 1.10
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 h677 1.21 + '<span class="date"> %s</span></div><div class="mes">%s</div>';
979 h677 1.10
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 h677 1.21 + '<div class="mes">%s</div>';
984 h677 1.1 var
985     i: integer;
986     No: string;
987     CSSFileName: string;
988     NewReceiveNo: Integer;
989     Res: TResRec;
990     UserOptionalStyle: string;
991 h677 1.13 ThreadName :String;
992 h677 1.16 ResLink :TResLinkRec;
993 h677 1.1 begin
994 h677 1.21 //doc.open;
995 h677 1.6 try
996 h677 1.21 //doc.charset := 'Shift_JIS';
997 h677 1.6 NewReceiveNo := ThreadItem.NewReceive;
998 h677 1.13 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
999 h677 1.16 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1000     ResLink.FKey := ThreadName;
1001 h677 1.6 // ?t?H???g?但?T?C?Y??????
1002     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1003     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1004     if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1005     //CSS?g?p
1006 h677 1.21 html.Add('<html><head>');
1007     html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1008     html.Add('<title>' + sTitle + '</title>');
1009     html.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
1010 h677 1.6 if Length( UserOptionalStyle ) > 0 then
1011 h677 1.21 html.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1012     html.Add('</head>'#13#10'<body>');
1013     html.Add('<a name="top"></a>'#13#10'<p id="idSearch"></p>');
1014     html.Add('<div class="title">' + sTitle + '</div>');
1015 h677 1.1 for i := 0 to ReadList.Count - 1 do begin
1016     // 1 ???K?存?\??
1017     if i <> 0 then begin
1018     // ?\????????????
1019     case GikoSys.ResRange of
1020     Ord( grrKoko ):
1021     if ThreadItem.Kokomade > (i + 1) then
1022     Continue;
1023     Ord( grrNew ):
1024     if NewReceiveNo > (i + 1) then
1025     Continue;
1026     10..65535:
1027     if (threadItem.Count - i) > GikoSys.ResRange then
1028     Continue;
1029     end;
1030     end;
1031    
1032     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1033 h677 1.21 html.Add('<a name="new"></a><div class="new">?V?????X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
1034 h677 1.1 end;
1035    
1036     if (Trim(ReadList[i]) <> '') then begin
1037     No := IntToStr(i + 1);
1038 h677 1.12 DivideStrLine(ReadList[i], @Res);
1039 h677 1.13 AddAnchorTag(@Res);
1040 h677 1.16 ConvRes(@Res, @ResLink);
1041 h677 1.1 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1042     if Res.FMailTo = '' then
1043 h677 1.21 html.Add(Format(FORMAT_NOMAIL, [No, No, No, Res.FName, Res.FDateTime, Res.FBody]))
1044 h677 1.1 else if GikoSys.Setting.ShowMail then
1045 h677 1.21 html.Add(Format(FORMAT_SHOWMAIL, [No, No, No, Res.FMailTo, Res.FName, Res.FMailTo, Res.FDateTime, Res.FBody]))
1046 h677 1.1 else
1047 h677 1.21 html.Add(Format(FORMAT_NOSHOW, [No, No, No, Res.FMailTo, Res.FName, Res.FDateTime, Res.FBody]));
1048 h677 1.1 end;
1049 h677 1.6
1050 h677 1.1 if ThreadItem.Kokomade = (i + 1) then begin
1051 h677 1.21 html.Add('<a name="koko"></a><div class="koko">?R?R???長?????転</div>');
1052 h677 1.1 end;
1053 h677 1.6
1054 h677 1.1 end;
1055 h677 1.6
1056 h677 1.21 html.Add('<a name="bottom"></a>');
1057     html.Add('<a name="last"></a>');
1058     html.Add('</body></html>');
1059 h677 1.1 end;
1060 h677 1.6 finally
1061 h677 1.21 //doc.Close;
1062 h677 1.6 end;
1063     end;
1064    
1065 h677 1.21 procedure THTMLCreate.CreateDefaultHTML (html:TStringList; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
1066 h677 1.6 var
1067     i: integer;
1068     No: string;
1069     NewReceiveNo: Integer;
1070     Res: TResRec;
1071 h677 1.13 ThreadName: String;
1072 h677 1.16 ResLink : TResLinkRec;
1073 h677 1.6 begin
1074 h677 1.21 // doc.open;
1075 h677 1.6 try
1076 h677 1.21 // doc.charset := 'Shift_JIS';
1077 h677 1.6 NewReceiveNo := ThreadItem.NewReceive;
1078 h677 1.13 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1079 h677 1.16 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1080     ResLink.FKey := ThreadName;
1081 h677 1.21 html.Add('<html><head>');
1082     html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1083     html.Add('<title>' + sTitle + '</title></head>');
1084     html.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1085     html.Add('<a name="top"></a>');
1086     html.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1087     html.Add('<dl>');
1088     html.Add('<p id="idSearch"></p>');
1089 h677 1.6 for i := 0 to ReadList.Count - 1 do begin
1090     // 1 ???K?存?\??
1091     if i <> 0 then begin
1092     // ?\????????????
1093     case GikoSys.ResRange of
1094     Ord( grrKoko ):
1095     if ThreadItem.Kokomade > (i + 1) then
1096     Continue;
1097     Ord( grrNew ):
1098     if NewReceiveNo > (i + 1) then
1099     Continue;
1100     10..65535:
1101     if (threadItem.Count - i) > GikoSys.ResRange then
1102     Continue;
1103     end;
1104     end;
1105    
1106     if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
1107 h677 1.21 html.Add('</dl>');
1108     html.Add('<a name="new"></a>');
1109     html.Add('<table width="100%" bgcolor="#3333CC" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#6666FF" valign="middle"><font size="-1" color="#ffffff"><b>?V?????X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
1110     html.Add('<dl>');
1111 h677 1.6 end;
1112    
1113     if (Trim(ReadList[i]) <> '') then begin
1114     No := IntToStr(i + 1);
1115 h677 1.12 DivideStrLine(ReadList[i], @Res);
1116 h677 1.13 AddAnchorTag(@Res);
1117 h677 1.16 ConvRes(@Res, @ResLink);
1118 h677 1.6 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
1119     if Res.FMailTo = '' then
1120 h677 1.21 html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10)
1121 h677 1.6 else if GikoSys.Setting.ShowMail then
1122 h677 1.21 html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10)
1123 h677 1.6 else
1124 h677 1.21 html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> ???e?炭?F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10);
1125 h677 1.6 end;
1126     if ThreadItem.Kokomade = (i + 1) then begin
1127 h677 1.21 html.Add('</dl>');
1128     html.Add('<a name="koko"></a><table width="100%" bgcolor="#55AA55" cellpadding="0" cellspacing="1"><tr><td align="center" bgcolor="#77CC77" valign="middle"><font size="-1" color="#ffffff"><b>?R?R???長?????転</b></font></td></tr></table>');
1129     html.Add('<dl>');
1130 h677 1.6 end;
1131     end;
1132 h677 1.21 html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
1133 h677 1.6 finally
1134 h677 1.21 //doc.Close;
1135 h677 1.1 end;
1136     end;
1137    
1138 h677 1.21 procedure THTMLCreate.CreateHTML2(doc: IDispatch; ThreadItem: TThreadItem; var sTitle: string);
1139 h677 1.1 var
1140     ReadList: TStringList;
1141     CSSFileName: string;
1142     FileName: string;
1143     Res: TResRec;
1144 h677 1.21 body : TStringList;
1145     mStream : TMemoryStream;
1146 h677 1.4 {$IFDEF DEBUG}
1147     st, rt: Cardinal;
1148     {$ENDIF}
1149 h677 1.1 begin
1150 h677 1.4 {$IFDEF DEBUG}
1151     Writeln('Create HTML');
1152     st := GetTickCount;
1153     {$ENDIF}
1154 h677 1.1 if ThreadItem <> nil then begin
1155 h677 1.21 body := TStringList.Create;
1156     try
1157     body.BeginUpdate;
1158     if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1159     CreateUsePluginHTML(body, ThreadItem, sTitle);
1160     end else begin
1161     ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1162     ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1163     ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1164     ShortDayNames[7] := '?y';
1165 h677 1.1
1166 h677 1.21 ReadList := TStringList.Create;
1167     try
1168     if ThreadItem.IsLogFile then begin
1169     ReadList.BeginUpdate;
1170     FileName := ThreadItem.GetThreadFileName;
1171     ReadList.LoadFromFile(FileName);
1172     ReadList.EndUpdate;
1173     GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1174     GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1175     GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1176     if ThreadItem.Title = '' then begin
1177     DivideStrLine(ReadList[0], @Res);
1178     sTitle := Res.FTitle;
1179     end else
1180     sTitle := ThreadItem.Title
1181     end else begin
1182     sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1183     end;
1184     // ?t?H???g?但?T?C?Y??????
1185     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1186     if GikoSys.Setting.UseSkin then begin
1187     CreateUseSKINHTML(body, ThreadItem, ReadList);
1188     end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1189     CreateUseCSSHTML(body, ThreadItem, ReadList, sTitle);
1190     end else begin
1191     CreateDefaultHTML(body, ThreadItem, ReadList, sTitle);
1192     end;
1193     finally
1194     ReadList.Free;
1195 h677 1.1 end;
1196     end;
1197 h677 1.22 body.EndUpdate;
1198     //WebBrowser?????鼎????
1199     mStream := TMemoryStream.Create;
1200     try
1201     body.SaveToStream(mStream);
1202     mStream.Seek(soFromBeginning, 0);
1203     (doc as IPersistStreamInit).Load(TStreamAdapter.Create(mStream));
1204     finally
1205     mStream.Free;
1206     end;
1207 h677 1.21 finally
1208     body.Free;
1209 h677 1.1 end;
1210     end;
1211 h677 1.4 {$IFDEF DEBUG}
1212     rt := GetTickCount - st;
1213     Writeln('Done.');
1214     Writeln(IntToStr(rt) + ' ms');
1215     {$ENDIF}
1216 h677 1.1 end;
1217    
1218 h677 1.2 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1219     var
1220     i: integer;
1221     No: string;
1222     //bufList : TStringList;
1223     ReadList: TStringList;
1224     // SaveList: TStringList;
1225     CSSFileName: string;
1226     BBSID: string;
1227     FileName: string;
1228     Res: TResRec;
1229     boardPlugIn : TBoardPlugIn;
1230    
1231     UserOptionalStyle: string;
1232     SkinHeader: string;
1233     SkinRes: string;
1234     tmp, tmp1: string;
1235 h677 1.13 ThreadName: String;
1236 h677 1.16 ResLink : TResLinkRec;
1237 h677 1.2 function LoadSkin( fileName: string ): string;
1238     begin
1239     Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1240     end;
1241     function ReplaceRes( skin: string ): string;
1242     begin
1243 h677 1.12 Result := SkinedRes( skin, @Res, No );
1244 h677 1.2 end;
1245    
1246     begin
1247     if ThreadItem <> nil then begin
1248     CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1249 h677 1.13 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1250 h677 1.16 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1251     ResLink.FKey := ThreadName;
1252 h677 1.2 html.Clear;
1253     html.BeginUpdate;
1254     //if ThreadItem.IsBoardPlugInAvailable then begin
1255     if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1256     //===== ?v???O?C???????辿?\??
1257     //boardPlugIn := ThreadItem.BoardPlugIn;
1258     boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1259     // ?t?H???g?但?T?C?Y??????
1260     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1261     try
1262     // ?????R?[?h???v???O?C?????C?邸?辿
1263     // ?w?b?_
1264     tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1265     '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1266     //?但???Q?????巽?????Q????
1267     if GikoSys.Setting.UseSkin then begin
1268     tmp1 := './' + GikoSys.Setting.CSSFileName;
1269     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1270     tmp1 := CustomStringReplace(tmp1, '\', '/');
1271     tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1272     end else if GikoSys.Setting.UseCSS then begin
1273     tmp1 := './' + CSSFileName;
1274     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1275     tmp1 := CustomStringReplace(tmp1, '\', '/');
1276     tmp := CustomStringReplace(tmp, CSSFileName, tmp1);
1277     end;
1278     html.Append( tmp );
1279    
1280     for i := 0 to threadItem.Count - 1 do begin
1281    
1282     // ???X
1283 h677 1.13 Res.FBody := boardPlugIn.GetRes( DWORD( threadItem ), i + 1 );
1284     ConvertResAnchor(@Res);
1285     html.Append( Res.FBody );
1286 h677 1.2
1287     end;
1288     // ?X?L??(?t?b?^)
1289     html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1290     finally
1291     end;
1292     html.EndUpdate;
1293     //Exit;
1294     end else begin
1295     ShortDayNames[1] := '?炭'; ShortDayNames[2] := '??';
1296     ShortDayNames[3] := '??'; ShortDayNames[4] := '??';
1297     ShortDayNames[5] := '??'; ShortDayNames[6] := '??';
1298     ShortDayNames[7] := '?y';
1299     BBSID := ThreadItem.ParentBoard.BBSID;
1300     ReadList := TStringList.Create;
1301     try
1302     if ThreadItem.IsLogFile then begin
1303     FileName := ThreadItem.GetThreadFileName;
1304     ReadList.LoadFromFile(FileName);
1305     GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1306     GikoSys.FAbon.Execute(ReadList); // ?????`???直??
1307     GikoSys.FSelectResFilter.Execute(ReadList); //???X???t?B???^?????O?????辿
1308 h677 1.12 DivideStrLine(ReadList[0], @Res);
1309 h677 1.2 //Res.FTitle := CustomStringReplace(Res.FTitle, '???M', ',');
1310     sTitle := Res.FTitle;
1311     end else begin
1312     sTitle := CustomStringReplace(ThreadItem.Title, '???M', ',');
1313     end;
1314     try
1315     // ?t?H???g?但?T?C?Y??????
1316     UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1317    
1318     if GikoSys.Setting.UseSkin then begin
1319     // ?X?L???g?p
1320     // ?X?L????????
1321     try
1322     SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1323     if Length( UserOptionalStyle ) > 0 then
1324     SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1325     '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1326     //?但???Q?????巽?????Q????
1327     tmp1 := './' + GikoSys.Setting.CSSFileName;
1328     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1329     tmp1 := CustomStringReplace(tmp1, '\', '/');
1330     SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName), tmp1);
1331     html.Append( SkinHeader );
1332     except
1333     end;
1334     try
1335     SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1336     except
1337     end;
1338     html.Append('<a name="top"></a>');
1339     for i := 0 to ReadList.Count - 1 do begin
1340     if (Trim(ReadList[i]) <> '') then begin
1341     No := IntToStr(i + 1);
1342    
1343 h677 1.12 DivideStrLine(ReadList[i], @Res);
1344 h677 1.13 AddAnchorTag(@Res);
1345 h677 1.16 ConvRes(@Res, @ResLink, true);
1346 h677 1.13 ConvertResAnchor(@Res);
1347 h677 1.2
1348     try
1349     html.Append( ReplaceRes( SkinRes ) );
1350     except
1351     end;
1352     end;
1353    
1354     end;
1355     html.Append('<a name="bottom"></a>');
1356     // ?X?L??(?t?b?^)
1357     try
1358     html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1359     except
1360     end;
1361     end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1362     //CSS?g?p
1363     //CSSFileName := GetAppDir + CSS_FILE_NAME;
1364     html.Append('<html><head>');
1365     html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1366     html.Append('<title>' + sTitle + '</title>');
1367     //?但???Q?????巽?????Q????
1368     tmp1 := './' + CSSFileName;
1369     tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1370     tmp1 := CustomStringReplace(tmp1, '\', '/');
1371    
1372     html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1373     if Length( UserOptionalStyle ) > 0 then
1374     html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1375     html.Append('</head>');
1376     html.Append('<body>');
1377     html.Append('<a name="top"></a>');
1378     html.Append('<div class="title">' + sTitle + '</div>');
1379     for i := 0 to ReadList.Count - 1 do begin
1380     if (Trim(ReadList[i]) <> '') then begin
1381     No := IntToStr(i + 1);
1382 h677 1.12 DivideStrLine(ReadList[i], @Res);
1383 h677 1.13 AddAnchorTag(@Res);
1384 h677 1.16 ConvRes(@Res, @ResLink, true);
1385 h677 1.13 ConvertResAnchor(@Res);
1386 h677 1.2 if Res.FMailTo = '' then
1387     html.Append('<a name="' + No + '"></a>'
1388     + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1389     + '<span class="name_label">?添?O?F</span> '
1390     + '<span class="name"><b>' + Res.FName + '</b></span> '
1391     + '<span class="date_label">???e?炭?F</span> '
1392     + '<span class="date">' + Res.FDateTime+ '</span></div>'
1393     + '<div class="mes">' + Res.FBody + ' </div>')
1394     else if GikoSys.Setting.ShowMail then
1395     html.Append('<a name="' + No + '"></a>'
1396     + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1397     + '<span class="name_label"> ?添?O?F </span>'
1398     + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1399     + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1400     + '<span class="date_label"> ???e?炭?F</span>'
1401     + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1402     + '<div class="mes">' + Res.FBody + ' </div>')
1403     else
1404     html.Append('<a name="' + No + '"></a>'
1405     + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1406     + '<span class="name_label"> ?添?O?F </span>'
1407     + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1408     + '<b>' + Res.FName + '</b></a>'
1409     + '<span class="date_label"> ???e?炭?F</span>'
1410     + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1411     + '<div class="mes">' + Res.FBody + ' </div>');
1412     end;
1413     end;
1414     html.Append('<a name="bottom"></a>');
1415     html.Append('<a name="last"></a>');
1416     html.Append('</body></html>');
1417     end else begin
1418     //CSS???g?p
1419     html.Append('<html><head>');
1420     html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1421     html.Append('<title>' + sTitle + '</title></head>');
1422     html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1423     html.Append('<a name="top"></a>');
1424     html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1425     html.Append('<dl>');
1426     for i := 0 to ReadList.Count - 1 do begin
1427     if (Trim(ReadList[i]) <> '') then begin
1428     No := IntToStr(i + 1);
1429 h677 1.12 DivideStrLine(ReadList[i], @Res);
1430 h677 1.13 AddAnchorTag(@Res);
1431 h677 1.16 ConvRes(@Res, @ResLink, true);
1432 h677 1.13 ConvertResAnchor(@Res);
1433 h677 1.2 if Res.FMailTo = '' then
1434     html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1435     else if GikoSys.Setting.ShowMail then
1436     html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1437     else
1438     html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> ?添?O?F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> ???e?炭?F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1439     end;
1440     end;
1441     html.Append('</dl>');
1442     html.Append('<a name="bottom"></a>');
1443     html.Append('</body></html>');
1444     end;
1445     finally
1446     html.EndUpdate;
1447     end;
1448     finally
1449     ReadList.Free;
1450     end;
1451     end;
1452     end;
1453     end;
1454    
1455 h677 1.8 procedure THTMLCreate.SetResPopupText(Hint : TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
1456     var
1457     i: Integer;
1458     tmp: string;
1459     FileName: string;
1460     Line: Integer;
1461    
1462     wkInt: Integer;
1463    
1464     Res: TResRec;
1465     Header: string;
1466     Body: string;
1467     boardPlugIn : TBoardPlugIn;
1468     begin
1469     try
1470     if StNum > ToNum then begin
1471     wkInt := StNum;
1472     StNum := ToNum;
1473     ToNum := wkInt;
1474     end;
1475    
1476     //?長?頂10???X???長?\??
1477     if StNum + MAX_POPUP_RES < ToNum then
1478     ToNum := StNum + MAX_POPUP_RES;
1479    
1480     //?^?C?g???\??
1481     if Title then
1482     if ThreadItem <> nil then
1483     Hint.Title := ThreadItem.Title;
1484    
1485     if ThreadItem <> nil then begin
1486     //if ThreadItem.IsBoardPlugInAvailable then begin
1487     if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1488     //===== ?v???O?C???????辿?\??
1489     //boardPlugIn := ThreadItem.BoardPlugIn;
1490     boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn;
1491    
1492     // ?t?H???g?但?T?C?Y??????
1493     // ?????R?[?h???v???O?C?????C?邸?辿
1494     for i := StNum to ToNum do begin
1495     Line := i;
1496     //?????長?Q?甜?叩?????辿??dat???`?貼?長?P?s????????????捗捗捗?B?鼎?????辿???造????????
1497     tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
1498     if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1499 h677 1.12 DivideStrLine(tmp, @Res);
1500 h677 1.8 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
1501     Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' ???e?炭?F ' + Res.FDateTime
1502     else
1503     Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' [' + res.FMailTo + '] ???e?炭?F ' + Res.FDateTime;
1504     Header := DeleteFontTag(Header);
1505     Header := CustomStringReplace(Header, '<br>', '',true);
1506    
1507     Body := CustomStringReplace(Res.FBody, '<br> ', #10,true);
1508     Body := CustomStringReplace(Body, '<br>', #10,true);
1509     Body := CustomStringReplace(Body, '</a>', '',true);
1510 h677 1.17 Body := THTMLCreate.DeleteLink(Body);
1511 h677 1.8 Body := CustomStringReplace(Body, '&lt;', '<');
1512     Body := CustomStringReplace(Body, '&gt;', '>');
1513     Body := CustomStringReplace(Body, '&quot;', '"');
1514     Body := CustomStringReplace(Body, '&amp;', '&');
1515     Body := CustomStringReplace(Body, '&nbsp;', ' ');
1516    
1517     Hint.Add(Header, Body);
1518     end;
1519     end;
1520     end else begin
1521     for i := StNum to ToNum do begin
1522     Line := i;
1523     FileName := ThreadItem.FilePath;
1524     tmp := GikoSys.ReadThreadFile(FileName, Line);
1525     if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1526 h677 1.12 DivideStrLine(tmp, @Res);
1527 h677 1.8 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
1528     Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' ???e?炭?F ' + Res.FDateTime
1529     else
1530     Header := IntToStr(Line) + ' ?添?O?F ' + Res.FName + ' [' + res.FMailTo + '] ???e?炭?F ' + Res.FDateTime;
1531    
1532     Body := DeleteFontTag(Res.FBody);
1533     Body := CustomStringReplace(Body, '<br> ', #10,true);
1534     Body := CustomStringReplace(Body, '<br>', #10,true);
1535     Body := CustomStringReplace(Body, '</a>', '',true);
1536 h677 1.17 Body := THTMLCreate.DeleteLink(Body);
1537 h677 1.8 Body := CustomStringReplace(Body, '&lt;', '<');
1538     Body := CustomStringReplace(Body, '&gt;', '>');
1539     Body := CustomStringReplace(Body, '&quot;', '"');
1540     Body := CustomStringReplace(Body, '&amp;', '&');
1541     Body := CustomStringReplace(Body, '&nbsp;', ' ');
1542     Hint.Add(Header, Body);
1543     end;
1544     end;
1545     end;
1546     end;
1547     finally
1548     end;
1549     end;
1550    
1551     //?????N???????????巽???X?|?b?v?A?b?v?p??URL?????????辿
1552     class function THTMLCreate.GetRespopupURL(AText, AThreadURL : string): string;
1553     var
1554     wkInt: Integer;
1555     begin
1556     Result := '';
1557     if Pos('about:blank..', AText) = 1 then begin
1558     wkInt := LastDelimiter( '/', AThreadURL );
1559     if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin
1560     // Thread.URL ?? PATH_INFO ?n?直
1561     Result := Copy( AThreadURL, 1, LastDelimiter( '/', AThreadURL ) );
1562     wkInt := LastDelimiter( '/', AText );
1563     if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then
1564     // Text ?? PATH_INFO ?n?直
1565     Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt )
1566     else
1567     // Text ?? QUERY_STRING ?n?直
1568     Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt );
1569     end else begin
1570     // Thread.URL ?? QUERY_STRING ?n?直
1571     Result := Copy( AThreadURL, 1, LastDelimiter( '?', AThreadURL ) );
1572     wkInt := LastDelimiter( '/', AText );
1573     if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then begin
1574     // Text ?? PATH_INFO ?n?直
1575     // URL ???????L?[???鼎?巽???????長 Text ???巽?存?????辿
1576     wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1577     wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1578     Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt );
1579     end else begin
1580     // Text ?? QUERY_STRING ?n?直
1581     Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt )
1582     end;
1583     end;
1584     end else if Pos('about:blank/bbs/', AText) = 1 then begin
1585     //?直???巽??JBBS???d?????z?撤
1586     AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/');
1587     Result := GetRespopupURL(AText, AThreadURL);
1588     end else begin
1589     Result := AText;
1590     end;
1591    
1592     end;
1593     //?w???直???p?X???X?L?????直?足??CSS???t?@?C?????R?s?[?????辿
1594     class procedure THTMLCreate.SkinorCSSFilesCopy(path: string);
1595     var
1596     tmp, tmpD, tmpF: string;
1597     current: string;
1598     dirs: TStringList;
1599     files: TStringList;
1600     i, j: Integer;
1601     begin
1602     if GikoSys.Setting.UseSkin then begin
1603     current := ExtractFilePath(GikoSys.GetSkinDir);
1604     tmp := GikoSys.Setting.CSSFileName;
1605     end else if GikoSys.Setting.UseCSS then begin
1606     current := ExtractFilePath(GikoSys.GetStyleSheetDir);
1607     tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName);
1608     end;
1609     dirs := TStringList.Create;
1610     try
1611     dirs.Add(tmp);
1612     if tmp <> current then begin
1613     GikoSys.GetDirectoryList(current, '*.*', dirs, true);
1614     for i := 0 to dirs.Count - 1 do begin
1615     files := TStringList.Create;
1616     try
1617 h677 1.16 files.BeginUpdate;
1618 h677 1.8 gikoSys.GetFileList(dirs[i], '*.*', files, true);
1619 h677 1.16 files.EndUpdate;
1620 h677 1.8 tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path);
1621     if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then
1622     ForceDirectories(tmpD);
1623    
1624     if(dirs[i] = tmp) and (dirs[i] <> current) then begin
1625     for j := 0 to files.Count - 1 do begin
1626     tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path);
1627     if not FileExists(tmpF) then begin
1628     CopyFile(PChar(files[j]), PChar(tmpF),True);
1629     end;
1630     end;
1631     end;
1632     finally
1633     files.Free;
1634     end;
1635     end;
1636     end else begin
1637     tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path);
1638     if not DirectoryExists(tmpD) then
1639     ForceDirectories(tmpD);
1640     tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName
1641     , GikoSys.GetConfigDir, path);
1642     if not FileExists(tmpF) then begin
1643     CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName)
1644     , PChar(tmpF), True);
1645     end;
1646     end;
1647     finally
1648     dirs.Free;
1649     end;
1650 h677 1.16 end;{!
1651     \brief dat?t?@?C?????????C????????
1652     \param Line dat?t?@?C?????\?店???辿 1 ?s
1653     \return ???X?樽??
1654     }
1655     class procedure THTMLCreate.DivideStrLine(Line: string; PRes: PResRec);
1656     const
1657     delimiter = '<>';
1658     var
1659     pds, pde : PChar;
1660     pss, pse : PChar;
1661     ppos : PChar;
1662     begin
1663     //?長??
1664     PRes.FType := glt2chNew;
1665    
1666     pss := PChar(Line);
1667     pse := pss + Length(Line);
1668     pds := PChar(delimiter);
1669     pde := pds + Length(delimiter);
1670    
1671     ppos := AnsiStrPosEx(pss, pse, pds, pde);
1672     if (ppos = nil) then begin
1673     Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
1674     Line := CustomStringReplace(Line, ',', '<>');
1675     Line := CustomStringReplace(Line, '???M', ',');
1676     end;
1677     //Trim?直???????纏?????C?????辿?@by??????
1678     PRes.FName := RemoveToken(Line, delimiter);
1679     PRes.FMailTo := RemoveToken(Line, delimiter);
1680     PRes.FDateTime := RemoveToken(Line, delimiter);
1681     PRes.FBody := RemoveToken(Line, delimiter);
1682     //?Q?甜?叩?????辿?????転???A?{???????????P???添?p?坦?????端???????辿???長?鱈?????辿
1683     //?添???f?????長?A???X???????坦???????直???????纏???泥?????炭???辿
1684     PRes.FBody := TrimLeft(PRes.FBody);
1685     //?坦?転???但?????N?鼎?辿???巽?A?坦???????????辿
1686     if PRes.FBody = '' then
1687     PRes.FBody := '&nbsp;';
1688    
1689     PRes.FTitle := RemoveToken(Line, delimiter);
1690 h677 1.8 end;
1691    
1692 h677 1.17 {!
1693     \brief HTML ???巽?A???J?[?^?O???鱈??
1694     \param s ???????辿 HTML
1695     \return ?A???J?[?^?O???鱈???????? HTML
1696     }
1697     class function THTMLCreate.DeleteLink(const s: string): string;
1698     var
1699     s1: string;
1700     s2: string;
1701     idx: Integer;
1702     i: Integer;
1703     begin
1704     i := 0;
1705     Result := '';
1706     while True do begin
1707     s1 := GikoSys.GetTokenIndex(s, '<a href="', i);
1708     s2 := GikoSys.GetTokenIndex(s, '<a href="', i + 1);
1709    
1710     idx := Pos('">', s1);
1711     if idx <> 0 then
1712     Delete(s1, 1, idx + 1);
1713     idx := Pos('">', s2);
1714     if idx <> 0 then
1715     Delete(s2, 1, idx + 1);
1716    
1717     Result := Result + s1 + s2;
1718    
1719     if s2 = '' then
1720     Break;
1721    
1722     inc(i, 2);
1723     end;
1724     end;
1725 h677 1.8
1726    
1727 h677 1.16
1728 h677 1.1 initialization
1729     HTMLCreater := THTMLCreate.Create;
1730    
1731     finalization
1732     if HTMLCreater <> nil then begin
1733     HTMLCreater.Free;
1734     HTMLCreater := nil;
1735     end;
1736    
1737     end.

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