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.44 - (hide annotations) (download) (as text)
Mon Oct 5 14:23:13 2009 UTC (14 years, 6 months ago) by h677
Branch: MAIN
CVS Tags: v1_63_1_819, v1_62_0_812, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_804, v1_62_0_807, v1_62_0_806, v1_62_0_803, v1_62_0_802, v1_62_0_809, v1_62_0_810, v1_62_0_811, v1_62_1_813, v1_61_0_800, v1_61_1_801, HEAD
Branch point for: Bb62, Bb63, Bb61
Changes since 1.43: +16 -4 lines
File MIME type: text/x-pascal
refs #17840
HTML化した際に、レスアンカーのタグ内で、ダブルクォートが2つつながる不具合の修正

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

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