OSDN Git Service

1.60.2.794
[gikonavigoeson/gikonavi.git] / HTMLCreate.pas
1 unit HTMLCreate;
2
3 interface
4
5 uses
6         Windows, Messages, SysUtils, Classes, {Graphics,} Controls, {Forms,}
7         ComCtrls, IniFiles, ShellAPI, Math, GikoSystem,
8 {$IF Defined(DELPRO) }
9         SHDocVw,
10         MSHTML,
11 {$ELSE}
12         SHDocVw_TLB,
13         MSHTML_TLB,
14 {$IFEND}
15         {HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,}
16         {bmRegExp,} AbonUnit,   MojuUtils, Setting,
17         ExternalBoardManager, ExternalBoardPlugInMain{,}
18         {Sort,} ,GikoBayesian, {HintWindow,} ActiveX, ResPopupBrowser;
19
20 type
21
22         PResLinkRec = ^TResLinkRec;
23         TResLinkRec = record
24                 FBbs: string;
25                 FKey : string;
26         end;
27
28         TBufferedWebBrowser = class(TStringList)
29         private
30                 //! \8f\91\82«\8d\9e\82Þ\83u\83\89\83E\83U
31                 FBrowser: TWebBrowser;
32                 //! \89½\8ds\82Ü\82Å\82½\82ß\82é\82©\82Ì\83T\83C\83Y
33                 FBuffSize: Integer;
34                 //! \83u\83\89\83E\83U\82ÌIHTMLDocument2\83C\83\93\83^\83t\83F\81[\83X\82ð\95Û\8e\9d\82·\82é open\82©\82çclose\82Ì\8aÔ\82Å
35                 FBrowserDoc: OleVariant;
36         public
37                 constructor Create(Browser: TWebBrowser; BuffSize: Integer);
38                 destructor Destory;
39                 procedure Open;
40                 procedure Close;
41                 procedure Flush;
42                 function Add(const S: string): Integer; override;
43         end;
44         THTMLCreate = class(TObject)
45         private
46                 { Private \90é\8c¾ }
47                 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                 function AddBeProfileLink(AID : string; ANum: Integer):string ;
57                 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                 procedure ConvertResAnchor(PRes: PResRec);
62                 procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
63                 function checkComma(const s : String; var j : Integer) : boolean;
64                 function addResAnchor(PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
65                  var s : String; j : Integer; const No: String) : string;
66         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         function isOutsideRange(item: TThreadItem; index: Integer ): Boolean;
71         function getKeywordLink(item: TThreadItem): String;
72         function GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
73         public
74                 { Public \90é\8c¾ }
75                 procedure AddAnchorTag(PRes: PResRec);
76                 function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;
77                 function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;
78                 procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;
79                 procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
80                 procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
81                 //\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8dì\90¬
82                 procedure SetResPopupText(Hint :TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
83                 //\83\8a\83\93\83N\82Ì\95\8e\9a\97ñ\82©\82ç\83\8c\83X\83|\83b\83v\83A\83b\83v\97p\82ÌURL\82É\95Ï\8a·\82·\82é
84                 class function GetRespopupURL(AText, AThreadURL : string): string;
85                 //\8ew\92è\82µ\82½\83p\83X\82É\83X\83L\83\93\82à\82µ\82­\82ÍCSS\82Ì\83t\83@\83C\83\8b\82Ì\83R\83s\81[\82ð\8dì\82é
86                 class procedure SkinorCSSFilesCopy(path: string);
87                 //dat\82P\8ds\82ð\83\8c\83X\82É\95ª\89ð\82·\82é
88                 class procedure DivideStrLine(Line: string; PRes: PResRec);
89         //HTML\82©\82ç\83\8a\83\93\83N\83^\83O\82ð\8dí\8f\9c\82·\82é
90                 class function DeleteLink(const s: string): string;
91         //HTML\82Ì\83{\83f\83B\82É\8b\96\82³\82ê\82é\95\8e\9a\97ñ\82É\92u\8a·\82·\82é
92         class function RepHtml(const s: string): string;
93         //\83\8c\83X\83G\83f\83B\83^\82Ì\83v\83\8c\83r\83\85\81[\97pHTML\82ð\8dì\90¬\82·\82é
94         class function CreatePreviewHTML(const Title: string; const No: string;
95                 const Mail: string; const Namae: string; const Body: string ) : string;
96         end;
97
98 var
99         HTMLCreater: THTMLCreate;
100
101 implementation
102
103 uses
104     Trip;
105
106 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 \82Í 'href="' ('"'\82Â\82«)\82È\82Ç\82Ì\83o\83\8a\83G\81[\83V\83\87\83\93\82É\97]\97T\82ð\8e\9d\82½\82¹\82é\82½\82ß
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 // \83X\83L\83\93\82ð\93Ç\82Ý\8d\9e\82Ý\81A\92l\82ð\92u\8a·\82·\82é
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                         // \82â\82è\82©\82½\82ª\8bê\82µ\82¢\82¯\82Ç\81A\83I\83v\83V\83\87\83\93\83_\83C\83A\83\8d\83O\82Ì\83v\83\8c\83r\83\85\81[\97p 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                         //----- \82Æ\82è\82 \82¦\82¸\82©\82¿\82ã\81`\82µ\82á\8cÝ\8a·\97p\81B\83R\83\81\83\93\83g\83A\83E\83g\82µ\82Ä\82à\82æ\82µ
173                         // \82â\82è\82©\82½\82ª\8bê\82µ\82¢\82¯\82Ç\81A\83I\83v\83V\83\87\83\93\83_\83C\83A\83\8d\83O\82Ì\83v\83\8c\83r\83\85\81[\97p try
174                         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                         //----- \82±\82±\82Ü\82Å
194                 end;
195                 Result := Skin.Text;
196         finally
197                 Skin.Free;
198         end;
199 end;
200
201 // \83\8c\83X\82Ì\92l\82ð\92u\8a·\82·\82é
202 function THTMLCreate.SkinedRes(
203         const skin: string;
204         PRes: PResRec;
205         const No: string
206 ): string;
207 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 var
212         spamminess      : Extended;
213 {$IFDEF SPAM_FILTER_ENABLED}
214         wordCount               : TWordCount;
215 {$ENDIF}
216 begin
217 {$IFDEF SPAM_FILTER_ENABLED}
218         wordCount := TWordCount.Create;
219         try
220                 spamminess := Floor( GikoSys.SpamParse(
221                         Res.FName + '<>' + Res.FMailTo + '<>' + Res.FBody, wordCount ) * 100 );
222 {$ELSE}
223         spamminess := 0;
224 {$ENDIF}
225                 Result := CustomStringReplace( skin, '<SPAMMINESS/>', FloatToStr( spamminess ) );
226                 Result := CustomStringReplace( Result, '<NONSPAMMINESS/>', FloatToStr( 100 - spamminess ) );
227                 Result := CustomStringReplace( Result, '<MAIL/>', PRes.FMailTo);
228                 Result := CustomStringReplace( Result, '<DATE/>', PRes.FDateTime);
229                 Result := CustomStringReplace( Result, '<PLAINNUMBER/>', No);
230                 Result := CustomStringReplace( Result, '<NAME/>',
231                         Format(FORMT_NAME, [PRes.FName]));
232                 Result := CustomStringReplace( Result, '<NUMBER/>',
233                         Format(FORMT_NUM, [No, No, No]));
234                 Result := CustomStringReplace( Result, '<MAILNAME/>',
235                         Format(FORMT_MAILNAME,[PRes.FMailTo, PRes.FName]));
236                 Result := CustomStringReplace( Result, '<MESSAGE/>', PRes.FBody);
237
238                 //----- \82©\82¿\82ã\81`\82µ\82á\8cÝ\8a·\97p\81B\83R\83\81\83\93\83g\83A\83E\83g\82µ\82Ä\82à\82æ\82µ
239                 if GikoSys.Setting.UseKatjushaType then begin
240                         Result := CustomStringReplace( Result, '&NUMBER',
241                                 '<a href="menu:' + No + '" name="' + No + '">' + No + '</a>');
242                         Result := CustomStringReplace( Result, '&PLAINNUMBER', No);
243                         Result := CustomStringReplace( Result, '&NAME', '<b>' + PRes.FName + '</b>');
244                         Result := CustomStringReplace( Result, '&MAILNAME',
245                                 '<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                         Result := CustomStringReplace( Result, '&SPAMMINESS', FloatToStr( spamminess ) );
250                         Result := CustomStringReplace( Result, '&NONSPAMMINESS', FloatToStr( 100 - spamminess ) );
251                 end;
252                 //----- \82±\82±\82Ü\82Å
253 {$IFDEF SPAM_FILTER_ENABLED}
254         finally
255                 wordCount.Free;
256         end;
257 {$ENDIF}
258
259 end;
260 (*************************************************************************
261  *http://\82Ì\95\8e\9a\97ñ\82ðanchor\83^\83O\95t\82«\82É\82·\82é\81B
262  *************************************************************************)
263 procedure THTMLCreate.AddAnchorTag(PRes: PResRec);
264 const
265         _HEAD : array[0..9] of String =
266                 ('', 'h', 'ht', '', 'htt', '', 'http://', '', '', '');
267 var
268         url: string;
269         href: string;
270         i, j, b: Integer;
271         tmp: Integer;
272         idx, idx2: Integer;
273         pos : PChar;
274         pp, pe : PChar;
275         s : String;
276         len : Integer;
277 begin
278         s := PRes.FBody;
279         PRes.FBody := '';
280
281         //while True do begin
282         repeat
283                 idx  := MaxInt;
284                 idx2 := MaxInt;
285                 pp := PChar(s);
286                 pe := pp + Length(s);
287
288                 for j := 0 to 9 do begin
289                         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;   //\82Ç\82Ì\83}\81[\83N\82Å\88ø\82Á\82©\82©\82Á\82½\82©\82ð\95Û\91
294                         end;
295                 end;
296
297                 if idx = MaxInt then begin
298                         //\83\8a\83\93\83N\82ª\96³\82¢\82æ\81B
299                         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                                 //\8aù\82É\83\8a\83\93\83N\83^\83O\82ª\82Â\82¢\82Ä\82¢\82é\82Á\82Û\82¢\82Æ\82«\82Í\83\80\83V
306                                 //</a></A>\82ð\92T\82·\81A\8f¬\95\8e\9a\82Å\8c©\82Â\82©\82ç\82È\82¯\82ê\82Î\91å\95\8e\9a\82Å\8c\9f\8dõ
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                                         b := pos - (pp  + idx) + 1;
314
315                                 len := Length(PRes.FBody);
316                                 SetLength(PRes.FBody, len + idx + b );
317                                 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                                         //\82P\83o\83C\83g\95\8e\9a\82ÅURL\82É\8eg\82¦\82È\82¢\95\8e\9a\82È\82ç
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                                         //\88ê\95\8e\9a\90i\82ß\82é\81B
339                                         Inc(pp);
340                                 end;
341                         end;
342                 end;
343         until idx = MaxInt;
344 end;
345
346 //\88ø\90\94\81AAID\81F\91Î\8fÛ\82Æ\82È\82é\93ú\95tID\95\8e\9a\97ñ\81AANum:\83\8c\83X\94Ô AURL\81F\82»\82Ì\83X\83\8c\83b\83h\82ÌURL
347 function THTMLCreate.AddBeProfileLink(AID : string; ANum: Integer):string ;
348 const
349         BE_MARK : string = 'BE:';
350 var
351         p : integer;
352         BNum, BMark : string;
353 begin
354         p := AnsiPos(BE_MARK, AnsiUpperCase(AID));
355         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 //! \83\8c\83X\83A\83\93\83J\81[\82Ì\83\8c\83X\94Ô\8d\86\82ð\95ª\8a\84\82·\82é
370 // Text = '1-9' -> st =  '1'; et = '9'
371 // Text = '10'  -> st = '10'; et = '10'
372 procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text:String; const Separator: String);
373 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 //! \83\8c\83X\83A\83\93\83J\81[\82ª\8ew\82µ\82Ä\82¢\82é\83\8c\83X\94Ô\8d\86\82Ì\95\8e\9a\97ñ\82ð\8eæ\93¾\82·\82é
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\95\8e\9a
401             ch := str[index];
402             Inc(index);
403             dbCharlen := false;
404         end else begin
405             //2byte\95\8e\9a
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 procedure THTMLCreate.ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false);
425 const
426         GT      = '&gt;';
427         //\8c\9f\8dõ\91Î\8fÛ\82Ì\95\8e\9a\97ñ\8cS
428         TOKEN : array[0..5] of string = (GT+GT, GT, '\81\84\81\84', '\81\84', '<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 \82É\96{\95\82ð\91S\95\94\93ü\82ê\82é
439         s        :=     PRes.FBody;
440         //\8c\8b\89Ê\82ð\83N\83\8a\83A
441         PRes.FBody       :=     '';
442
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                                         //\82Ç\82ê\82Å\83q\83b\83g\82µ\82½\82©\95Û\91
452                                         i := j;
453                                         //\8dÅ\8f¬\92l\82ð\8dX\90V
454                                         pmin := pos;
455                                 end;
456                         end;
457                 end;
458
459                 //\83q\83b\83g\82µ\82½\95\8e\9a\97ñ\82Ì\88ê\82Â\8eè\91O\82Ü\82Å\8c\8b\89Ê\82É\83R\83s\81[
460                 PRes.FBody := PRes.FBody + Copy(s, 1, pmin - 1);
461                 Delete(s, 1, pmin - 1);
462
463                 if i = 6 then begin
464                         //\83q\83b\83g\82È\82µ
465                 end else if (i = 4) or (i = 5) then begin
466                         //'<a ' or '<A' \82Å\83q\83b\83g '</a>' or '</A>' \82Ü\82Å\83R\83s\81[
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                         PRes.FBody := PRes.FBody + rink;
478                         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                                                 //\82Ç\82ê\82Å\83q\83b\83g\82µ\82½\82©\95Û\91
487                                                 i := j;
488                                                 //\8dÅ\8f¬\92l\82ð\8dX\90V
489                                                 pmin := pos;
490                                         end;
491                                 end;
492                         end;
493                         // \83\8c\83X\83A\83\93\83J\81[\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82½\82ç,\82ª\91±\82­\8cÀ\82è\83A\83\93\83J\81[\82Æ\82µ\82Ä\88µ\82¤
494                         if i <= 3 then begin
495                 appendResAnchor(PRes, PResLink, DatToHTML, s );
496                         end;
497                 end else begin
498                         //\89½\82©\82µ\82ç\8c©\82Â\82©\82Á\82½\83p\83^\81[\83\93
499                         j := Length(TOKEN[i]) + 1;
500                         db := false;
501                 No := getNumberString(s, j, db, Length(s) );
502                         //\8fI\92[\82Ü\82Å\8ds\82Á\82Ä\82Ì\8fI\97¹\82©\83`\83F\83b\83N
503                         if j <= Length(s) then begin
504                                 if db then j := j - 2
505                                 else j := j - 1;
506                         end;
507                         addResAnchor(PRes, PResLink, DatToHTML, s, j, No);
508
509             // , \82ª\91±\82­\8cÀ\82è\83\8c\83X\83A\83\93\83J\81[\82Æ\82µ\82Ä\8f\88\97\9d\82·\82é
510             appendResAnchor(PRes, PResLink, DatToHTML, s );
511                 end;
512         end;
513         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         var j : Integer
520 ) : boolean;
521 var
522         bType : TMbcsByteType;
523 begin
524         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         end;
536 end;
537 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         //\8fI\92[\82Ü\82Å\8ds\82Á\82Ä\82Ì\8fI\97¹\82©\83`\83F\83b\83N
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 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         //\89½\82à\90\94\8e\9a\82ª\8c©\82Â\82©\82ç\82È\82¢\82Æ\82«
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 end;
591
592
593 procedure THTMLCreate.ConvertResAnchor(PRes: PResRec);
594 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         tmp: string;
604         res: string;
605 begin
606         res := PRes.FBody;
607         PRes.FBody := '';
608         i := AnsiPos(_HEAD, res);
609         while i <> 0 do begin
610                 PRes.FBody := PRes.FBody + Copy(res, 1, i -1);
611                 Delete(res, 1, i - 1);
612                 j := AnsiPos(_TAIL, res);
613                 if j = 0 then begin
614                         PRes.FBody := PRes.FBody + res;
615                         Exit;
616                 end;
617                 tmp := Copy(res, 1, j - 1);
618                 Delete(res, 1, j + 16);
619                 if (AnsiPos(_ST, tmp) <> 0) and (AnsiPos(_TO, tmp) <> 0) then begin
620                         Delete(tmp, 1, AnsiPos(_ST, tmp) + 3);
621                         Delete(tmp, AnsiPos(_TO, tmp), Length(tmp));
622                         PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
623                 end else if (AnsiPos(_STA, tmp) <> 0) and (AnsiPos(_END, tmp) <> 0) then begin
624                         Delete(tmp, 1, AnsiPos(_STA, tmp) + 6);
625                         Delete(tmp, AnsiPos(_END, tmp), Length(tmp));
626                         PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
627                 end else begin
628                         k := LastDelimiter('/', tmp);
629                         Delete(tmp, 1, k);
630                         if AnsiPos('-', tmp) < AnsiPos('"', tmp) then
631                                 Delete(tmp, AnsiPos('-', tmp), Length(tmp))
632                         else
633                                 Delete(tmp, AnsiPos('"', tmp), Length(tmp));
634
635                         PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
636                 end;
637                 i := AnsiPos(_HEAD, res);
638         end;
639         PRes.FBody := PRes.FBody + res;
640
641 end;
642 //Plugin\82ð\97\98\97p\82·\82éBoard\82Ì\83X\83\8c\83b\83h\82ÌHTML\82ð\8dì\90¬\82µ\82Ädoc\82É\8f\91\82«\8d\9e\82Þ
643 procedure THTMLCreate.CreateUsePluginHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
644 var
645         i: integer;
646         NewReceiveNo: Integer;
647         boardPlugIn : TBoardPlugIn;
648         UserOptionalStyle: string;
649 begin
650         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
651         boardPlugIn             := ThreadItem.ParentBoard.BoardPlugIn;
652         NewReceiveNo    := ThreadItem.NewReceive;
653         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
654         UserOptionalStyle := GikoSys.SetUserOptionalStyle;
655         html.add(boardPlugIn.GetHeader( DWORD( threadItem ),
656                 '<style type="text/css">body {' + UserOptionalStyle + '}</style>' ));
657         html.Add('<p id="idSearch"></p>');
658         html.Flush;
659         
660         for i := 0 to threadItem.Count - 1 do begin
661                 // 1 \82Í\95K\82¸\95\\8e¦
662                 if i <> 0 then begin
663                         // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
664             if (isOutsideRange(ThreadItem, i)) then begin
665                 Continue;
666             end;
667                 end;
668
669                 // \90V\92\85\83}\81[\83N
670                 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
671                         try
672                                 if GikoSys.Setting.UseSkin then begin
673                                         if FileExists( GikoSys.GetSkinNewmarkFileName ) then
674                                                 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
675                                         else
676                                                 html.Add( '<a name="new"></a>');
677                                 end else if GikoSys.Setting.UseCSS then begin
678                                         html.Add('<a name="new"></a><div class="new">\90V\92\85\83\8c\83X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
679                                 end else begin
680                                         html.Add('</dl>');
681                                         html.Add('<a name="new"></a>');
682                                         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>\90V\92\85\83\8c\83X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
683                                         html.Add('<dl>');
684                                 end;
685                         except
686                                 html.Add( '<a name="new"></a>');
687                         end;
688                 end;
689
690                 // \83\8c\83X
691                 html.Add( boardPlugIn.GetRes( DWORD( threadItem ), i + 1 ));
692
693                 if ThreadItem.Kokomade = (i + 1) then begin
694                         // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
695                         try
696                                 if GikoSys.Setting.UseSkin then begin
697                                         if FileExists( GikoSys.GetSkinBookmarkFileName ) then
698                                                 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
699                                         else
700                                                 html.Add( '<a name="koko"></a>');
701                                 end else if GikoSys.Setting.UseCSS then begin
702                                         html.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
703                                 end else begin
704                                         html.Add('</dl>');
705                                         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>\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</b></font></td></tr></table>');
706                                         html.Add('<dl>');
707                                 end;
708                         except
709                                 html.Add('<a name="koko"></a>');
710                         end;
711                 end;
712         end;
713
714
715         // \83X\83L\83\93(\83t\83b\83^)
716         html.Add( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ));
717 end;
718
719
720 procedure THTMLCreate.CreateUseSKINHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList);
721 const
722         KOKO_TAG = '<a name="koko"></a>';
723         NEW_TAG = '<a name="new"></a>';
724 var
725         i: integer;
726         NewReceiveNo: Integer;
727         Res: TResRec;
728         UserOptionalStyle: string;
729         SkinHeader: string;
730         SkinNewRes: string;
731         SkinRes: string;
732         ThreadName : string;
733         ResLink :TResLinkRec;
734 begin
735         NewReceiveNo := ThreadItem.NewReceive;
736         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
737         UserOptionalStyle := GikoSys.SetUserOptionalStyle;
738         ThreadName := ChangeFileExt(ThreadItem.FileName, '');
739         ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
740         ResLink.FKey := ThreadName;
741         // \83X\83L\83\93\82Ì\90Ý\92è
742         try
743                 SkinHeader := LoadFromSkin( GikoSys.GetSkinHeaderFileName, ThreadItem, ThreadItem.Size);
744                 if Length( UserOptionalStyle ) > 0 then
745                         SkinHeader := CustomStringReplace( SkinHeader, '</head>',
746                                 '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
747                 html.Add( SkinHeader );
748         except
749         end;
750
751         SkinNewRes := LoadFromSkin( GikoSys.GetSkinNewResFileName, ThreadItem, ThreadItem.Size);
752         SkinRes := LoadFromSkin( GikoSys.GetSkinResFileName, ThreadItem, ThreadItem.Size );
753
754         html.Add('<p id="idSearch"></p>'#13#10'<a name="top"></a>');
755         html.Flush;
756
757         for i := 0 to ReadList.Count - 1 do begin
758                 // 1 \82Í\95K\82¸\95\\8e¦
759                 if i <> 0 then begin
760                         // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
761             if (isOutsideRange(ThreadItem, i)) then begin
762                 Continue;
763             end;
764                 end;
765
766                 // \90V\92\85\83}\81[\83N
767                 if (NewReceiveNo = i + 1) or ((NewReceiveNo = 0) and (i = 0)) then begin
768                         if FileExists( GikoSys.GetSkinNewmarkFileName ) then
769                                 html.Add( LoadFromSkin( GikoSys.GetSkinNewmarkFileName, ThreadItem, ThreadItem.Size ))
770                         else
771                                 html.Add( NEW_TAG );
772                 end;
773
774                 if (Trim(ReadList[i]) <> '') then begin
775                         DivideStrLine(ReadList[i], @Res);
776             AddAnchorTag(@Res);
777             ConvRes(@Res, @ResLink);
778             Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
779
780             if NewReceiveNo <= (i + 1) then
781                 // \90V\92\85\83\8c\83X
782                 html.Add(SkinedRes(SkinNewRes, @Res, IntToStr(i + 1)))
783             else
784                 // \92Ê\8fí\82Ì\83\8c\83X
785                 html.Add(SkinedRes(SkinRes, @Res, IntToStr(i + 1)));
786                 end;
787
788                 if ThreadItem.Kokomade = (i + 1) then begin
789                         // \82±\82±\82Ü\82Å\93Ç\82ñ\82¾
790                         if FileExists( GikoSys.GetSkinBookmarkFileName ) then
791                                 html.Add( LoadFromSkin( GikoSys.GetSkinBookmarkFileName, ThreadItem, ThreadItem.Size ))
792                         else
793                                 html.Add( KOKO_TAG );
794                 end;
795         end;
796     html.Add(getKeywordLink(ThreadItem));
797         html.Add('<a name="bottom"></a>');
798         // \83X\83L\83\93(\83t\83b\83^)
799         html.Add( LoadFromSkin( GikoSys.GetSkinFooterFileName, ThreadItem, ThreadItem.Size ) );
800 end;
801
802 procedure THTMLCreate.CreateUseCSSHTML(html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
803 const
804         FORMAT_NOMAIL  = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
805                                         + '<span class="name_label"> \96¼\91O\81F </span> <span class="name"><b>%s</b></span>'
806                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span> <span class="date">%s</span></div>'
807                                         + '<div class="mes">%s</div>';
808
809         FORMAT_SHOWMAIL = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
810                                         + '<span class="name_label"> \96¼\91O\81F </span><a class="name_mail" href="mailto:%s">'
811                                         + '<b>%s</b></a><span class="mail"> [%s]</span><span class="date_label"> \93\8a\8de\93ú\81F</span>'
812                                         + '<span class="date"> %s</span></div><div class="mes">%s</div>';
813
814         FORMAT_NOSHOW = '<a name="%s"></a><div class="header"><span class="no"><a href="menu:%s">%s</a></span>'
815                                         + '<span class="name_label"> \96¼\91O\81F </span><a class="name_mail" href="mailto:%s">'
816                                         + '<b>%s</b></a><span class="date_label"> \93\8a\8de\93ú\81F</span><span class="date"> %s</span></div>'
817                                         + '<div class="mes">%s</div>';
818 var
819         i: integer;
820         No: string;
821         CSSFileName: string;
822         NewReceiveNo: Integer;
823         Res: TResRec;
824         UserOptionalStyle: string;
825         ThreadName :String;
826         ResLink :TResLinkRec;
827 begin
828         NewReceiveNo := ThreadItem.NewReceive;
829         ThreadName := ChangeFileExt(ThreadItem.FileName, '');
830         ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
831         ResLink.FKey := ThreadName;
832         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
833         UserOptionalStyle := GikoSys.SetUserOptionalStyle;
834         CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
835         if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
836                 //CSS\8eg\97p
837                 html.Add('<html><head>');
838                 html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
839                 html.Add('<title>' + sTitle + '</title>');
840                 html.Add('<link rel="stylesheet" href="'+CSSFileName+'" type="text/css">');
841                 if Length( UserOptionalStyle ) > 0 then
842                         html.Add('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
843                 html.Add('</head>'#13#10'<body>');
844                 html.Add('<a name="top"></a>'#13#10'<p id="idSearch"></p>');
845                 html.Add('<div class="title">' + sTitle + '</div>');
846                 html.Flush;
847                 for i := 0 to ReadList.Count - 1 do begin
848                         // 1 \82Í\95K\82¸\95\\8e¦
849                         if i <> 0 then begin
850                         // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
851                 if (isOutsideRange(ThreadItem, i)) then begin
852                     Continue;
853                 end;
854                         end;
855
856                         if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
857                                 html.Add('<a name="new"></a><div class="new">\90V\92\85\83\8c\83X <span class="newdate">' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</span></div>');
858                         end;
859
860                         if (Trim(ReadList[i]) <> '') then begin
861                                 No := IntToStr(i + 1);
862                                 DivideStrLine(ReadList[i], @Res);
863                 AddAnchorTag(@Res);
864                 ConvRes(@Res, @ResLink);
865                 Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
866                 if Res.FMailTo = '' then
867                     html.Add(Format(FORMAT_NOMAIL, [No, No, No, Res.FName, Res.FDateTime, Res.FBody]))
868                 else if GikoSys.Setting.ShowMail then
869                     html.Add(Format(FORMAT_SHOWMAIL, [No, No, No, Res.FMailTo, Res.FName, Res.FMailTo, Res.FDateTime, Res.FBody]))
870                 else
871                     html.Add(Format(FORMAT_NOSHOW, [No, No, No, Res.FMailTo, Res.FName, Res.FDateTime, Res.FBody]));
872             end;
873                         if ThreadItem.Kokomade = (i + 1) then begin
874                                 html.Add('<a name="koko"></a><div class="koko">\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</div>');
875                         end;
876
877                 end;
878         html.Add(getKeywordLink(ThreadItem));
879                 html.Add('<a name="bottom"></a>');
880                 html.Add('<a name="last"></a>');
881                 html.Add('</body></html>');
882         end;
883 end;
884
885 procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
886 var
887         i: integer;
888         NewReceiveNo: Integer;
889         ThreadName: String;
890         ResLink : TResLinkRec;
891 begin
892         NewReceiveNo := ThreadItem.NewReceive;
893         ThreadName := ChangeFileExt(ThreadItem.FileName, '');
894         ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
895         ResLink.FKey := ThreadName;
896         html.Add('<html><head>');
897         html.Add('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
898         html.Add('<title>' + sTitle + '</title></head>');
899         html.Add('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
900         html.Add('<a name="top"></a>');
901         html.Add('<font size=+1 color="#FF0000">' + sTitle + '</font>');
902         html.Add('<dl>');
903         html.Add('<p id="idSearch"></p>');
904         html.Flush;
905         for i := 0 to ReadList.Count - 1 do begin
906                 // 1 \82Í\95K\82¸\95\\8e¦
907                 if i <> 0 then begin
908                         // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
909             if (isOutsideRange(ThreadItem, i)) then begin
910                 Continue;
911             end;
912                 end;
913
914                 if (NewReceiveNo = (i + 1)) or ((NewReceiveNo = 0) and (i = 0)) then begin
915                         html.Add('</dl>');
916                         html.Add('<a name="new"></a>');
917                         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>\90V\92\85\83\8c\83X ' + FormatDateTime('yyyy/mm/dd(ddd) hh:mm', ThreadItem.RoundDate) + '</b></font></td></tr></table>');
918                         html.Add('<dl>');
919                 end;
920
921                 if (Trim(ReadList[i]) <> '') then begin
922             html.Add(GetResString(i, ReadList[i], @ResLink));
923         end;
924                 if ThreadItem.Kokomade = (i + 1) then begin
925                         html.Add('</dl>');
926                         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>\83R\83R\82Ü\82Å\93Ç\82ñ\82¾</b></font></td></tr></table>');
927                         html.Add('<dl>');
928                 end;
929         end;
930     html.Add(getKeywordLink(ThreadItem));
931         html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
932 end;
933 function THTMLCreate.GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
934 var
935     No : String;
936     Res: TResRec;
937 begin
938     No := IntToStr(index + 1);
939     DivideStrLine(Line, @Res);
940     Res.FBody := DeleteLink(Res.FBody);
941     AddAnchorTag(@Res);
942     ConvRes(@Res, PResLink);
943     Res.FDateTime := AddBeProfileLink(Res.FDateTime, index + 1);
944     if Res.FMailTo = '' then
945         Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10
946     else if GikoSys.Setting.ShowMail then
947         Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10
948     else
949         Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10;
950 end;
951 procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
952 var
953         ReadList: TStringList;
954         CSSFileName: string;
955         FileName: string;
956         Res: TResRec;
957         body : TBufferedWebBrowser;
958 {$IFDEF DEBUG}
959         st, rt: Cardinal;
960 {$ENDIF}
961 begin
962 {$IFDEF DEBUG}
963         Writeln('Create HTML');
964         st := GetTickCount;
965 {$ENDIF}
966         if ThreadItem <> nil then begin
967                 body := TBufferedWebBrowser.Create(Browser, 100);
968                 try
969                         body.Open;
970                         if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
971                                 CreateUsePluginHTML(body, ThreadItem, sTitle);
972                         end else begin
973                                 ShortDayNames[1] := '\93ú';               ShortDayNames[2] := '\8c\8e';
974                                 ShortDayNames[3] := '\89Î';               ShortDayNames[4] := '\90\85';
975                                 ShortDayNames[5] := '\96Ø';               ShortDayNames[6] := '\8bà';
976                                 ShortDayNames[7] := '\93y';
977
978                                 ReadList := TStringList.Create;
979                                 try
980                                         if ThreadItem.IsLogFile then begin
981                                                 ReadList.BeginUpdate;
982                                                 FileName := ThreadItem.GetThreadFileName;
983                                                 ReadList.LoadFromFile(FileName);
984                                                 ReadList.EndUpdate;
985                                                 GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
986                                                 GikoSys.FAbon.Execute(ReadList);                //       \82 \82Ú\81`\82ñ\82µ\82Ä
987                                                 GikoSys.FSelectResFilter.Execute(ReadList); //\83\8c\83X\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\82·\82é
988                                                 if ThreadItem.Title = '' then begin
989                                                         DivideStrLine(ReadList[0], @Res);
990                                                         sTitle := Res.FTitle;
991                                                 end else
992                                                         sTitle := ThreadItem.Title
993                                         end else begin
994                                                 sTitle := CustomStringReplace(ThreadItem.Title, '\81\97\81M', ',');
995                                         end;
996                                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
997                                         CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
998                                         if GikoSys.Setting.UseSkin then begin
999                                                 CreateUseSKINHTML(body, ThreadItem, ReadList);
1000                                         end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1001                                                 CreateUseCSSHTML(body, ThreadItem, ReadList, sTitle);
1002                                         end else begin
1003                                                 CreateDefaultHTML(body, ThreadItem, ReadList, sTitle);
1004                                         end;
1005                                 finally
1006                                         ReadList.Free;
1007                                 end;
1008                         end;
1009                 finally
1010                         body.Close;
1011                         body.Free;
1012                 end;
1013         end;
1014 {$IFDEF DEBUG}
1015         rt := GetTickCount - st;
1016         Writeln('Done.');
1017         Writeln(IntToStr(rt) + ' ms');
1018 {$ENDIF}
1019 end;
1020
1021 procedure THTMLCreate.CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
1022 var
1023         i: integer;
1024         No: string;
1025         //bufList : TStringList;
1026         ReadList: TStringList;
1027 //      SaveList: TStringList;
1028         CSSFileName: string;
1029         BBSID: string;
1030         FileName: string;
1031         Res: TResRec;
1032         boardPlugIn : TBoardPlugIn;
1033
1034         UserOptionalStyle: string;
1035         SkinHeader: string;
1036         SkinRes: string;
1037         tmp, tmp1: string;
1038         ThreadName: String;
1039         ResLink : TResLinkRec;
1040         function LoadSkin( fileName: string ): string;
1041         begin
1042                 Result := LoadFromSkin( fileName, ThreadItem, ThreadItem.Size );
1043         end;
1044         function ReplaceRes( skin: string ): string;
1045         begin
1046                 Result := SkinedRes( skin, @Res, No );
1047         end;
1048
1049 begin
1050         if ThreadItem <> nil then begin
1051                 CSSFileName := GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName;
1052                 ThreadName := ChangeFileExt(ThreadItem.FileName, '');
1053                 ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1054                 ResLink.FKey := ThreadName;
1055                 html.Clear;
1056                 html.BeginUpdate;
1057                 //if ThreadItem.IsBoardPlugInAvailable then begin
1058                 if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1059                         //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
1060                         //boardPlugIn           := ThreadItem.BoardPlugIn;
1061                         boardPlugIn             := ThreadItem.ParentBoard.BoardPlugIn;
1062                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1063                         UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1064                         try
1065                                 // \95\8e\9a\83R\81[\83h\82Í\83v\83\89\83O\83C\83\93\82É\94C\82¹\82é
1066                                 // \83w\83b\83_
1067                                 tmp := boardPlugIn.GetHeader( DWORD( threadItem ),
1068                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style>' );
1069                                 //\90â\91Î\8eQ\8fÆ\82©\82ç\91\8a\91Î\8eQ\8fÆ\82Ö
1070                                 if GikoSys.Setting.UseSkin then begin
1071                                         tmp1 := './' + GikoSys.Setting.CSSFileName;
1072                                         tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1073                                         tmp1 := CustomStringReplace(tmp1, '\', '/');
1074                                         tmp := CustomStringReplace(tmp, ExtractFilePath(GikoSys.Setting.CSSFileName),  tmp1);
1075                                 end else if GikoSys.Setting.UseCSS then begin
1076                                         tmp1 := './' + CSSFileName;
1077                                         tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1078                                         tmp1 := CustomStringReplace(tmp1, '\', '/');
1079                                         tmp := CustomStringReplace(tmp, CSSFileName,  tmp1);
1080                                 end;
1081                                 html.Append( tmp );
1082
1083                                 for i := 0 to threadItem.Count - 1 do begin
1084
1085                                         // \83\8c\83X
1086                                         Res.FBody := boardPlugIn.GetRes( DWORD( threadItem ), i + 1 );
1087                                         ConvertResAnchor(@Res);
1088                                         html.Append( Res.FBody );
1089
1090                                 end;
1091                                 // \83X\83L\83\93(\83t\83b\83^)
1092                                 html.Append( boardPlugIn.GetFooter( DWORD( threadItem ), '<a name="bottom"></a>' ) );
1093                         finally
1094                         end;
1095                         html.EndUpdate;
1096                         //Exit;
1097                 end else begin
1098                         ShortDayNames[1] := '\93ú';               ShortDayNames[2] := '\8c\8e';
1099                         ShortDayNames[3] := '\89Î';               ShortDayNames[4] := '\90\85';
1100                         ShortDayNames[5] := '\96Ø';               ShortDayNames[6] := '\8bà';
1101                         ShortDayNames[7] := '\93y';
1102                         BBSID := ThreadItem.ParentBoard.BBSID;
1103                         ReadList := TStringList.Create;
1104                         try
1105                                 if ThreadItem.IsLogFile then begin
1106                                         FileName := ThreadItem.GetThreadFileName;
1107                                         ReadList.LoadFromFile(FileName);
1108                                         GikoSys.FAbon.IndividualAbon(ReadList, ChangeFileExt(FileName,'.NG'));
1109                                         GikoSys.FAbon.Execute(ReadList);                //       \82 \82Ú\81`\82ñ\82µ\82Ä
1110                                         GikoSys.FSelectResFilter.Execute(ReadList); //\83\8c\83X\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\82·\82é
1111                                         DivideStrLine(ReadList[0], @Res);
1112                                         //Res.FTitle := CustomStringReplace(Res.FTitle, '\81\97\81M', ',');
1113                                         sTitle := Res.FTitle;
1114                                 end else begin
1115                                         sTitle := CustomStringReplace(ThreadItem.Title, '\81\97\81M', ',');
1116                                 end;
1117                                 try
1118                                         // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1119                                         UserOptionalStyle := GikoSys.SetUserOptionalStyle;
1120
1121                                         if GikoSys.Setting.UseSkin then begin
1122                                                 // \83X\83L\83\93\8eg\97p
1123                                                 // \83X\83L\83\93\82Ì\90Ý\92è
1124                                                 try
1125                                                         SkinHeader := LoadSkin( GikoSys.GetSkinHeaderFileName );
1126                                                         if Length( UserOptionalStyle ) > 0 then
1127                                                                 SkinHeader := CustomStringReplace( SkinHeader, '</head>',
1128                                                                         '<style type="text/css">body {' + UserOptionalStyle + '}</style></head>');
1129                                                         //\90â\91Î\8eQ\8fÆ\82©\82ç\91\8a\91Î\8eQ\8fÆ\82Ö
1130                                                         tmp1 := './' + GikoSys.Setting.CSSFileName;
1131                                                         tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1132                                                         tmp1 := CustomStringReplace(tmp1, '\', '/');
1133                                                         SkinHeader := CustomStringReplace(SkinHeader, ExtractFilePath(GikoSys.Setting.CSSFileName),  tmp1);
1134                                                         html.Append( SkinHeader );
1135                                                 except
1136                                                 end;
1137                                                 try
1138                                                         SkinRes := LoadSkin( GikoSys.GetSkinResFileName );
1139                                                 except
1140                                                 end;
1141                                                 html.Append('<a name="top"></a>');
1142                                                 for i := 0 to ReadList.Count - 1 do begin
1143                                                         if (Trim(ReadList[i]) <> '') then begin
1144                                                                 No := IntToStr(i + 1);
1145
1146                                                                 DivideStrLine(ReadList[i], @Res);
1147                                                                 AddAnchorTag(@Res);
1148                                                                 ConvRes(@Res, @ResLink, true);
1149                                                                 ConvertResAnchor(@Res);
1150
1151                                                                 try
1152                                                                         html.Append( ReplaceRes( SkinRes ) );
1153                                                                 except
1154                                                                 end;
1155                                                         end;
1156
1157                                                 end;
1158                                                 html.Append('<a name="bottom"></a>');
1159                                                 // \83X\83L\83\93(\83t\83b\83^)
1160                                                 try
1161                                                         html.Append( LoadSkin( GikoSys.GetSkinFooterFileName ) );
1162                                                 except
1163                                                 end;
1164                                         end else if GikoSys.Setting.UseCSS and FileExists(CSSFileName) then begin
1165                                                 //CSS\8eg\97p
1166                                                 //CSSFileName := GetAppDir + CSS_FILE_NAME;
1167                                                 html.Append('<html><head>');
1168                                                 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1169                                                 html.Append('<title>' + sTitle + '</title>');
1170                                                 //\90â\91Î\8eQ\8fÆ\82©\82ç\91\8a\91Î\8eQ\8fÆ\82Ö
1171                                                 tmp1 := './' + CSSFileName;
1172                                                 tmp1 := CustomStringReplace(tmp1, GikoSys.GetConfigDir, '');
1173                                                 tmp1 := CustomStringReplace(tmp1, '\', '/');
1174
1175                                                 html.Append('<link rel="stylesheet" href="'+tmp1+'" type="text/css">');
1176                                                 if Length( UserOptionalStyle ) > 0 then
1177                                                         html.Append('<style type="text/css">body {' + UserOptionalStyle + '}</style>');
1178                                                 html.Append('</head>');
1179                                                 html.Append('<body>');
1180                                                 html.Append('<a name="top"></a>');
1181                                                 html.Append('<div class="title">' + sTitle + '</div>');
1182                                                 for i := 0 to ReadList.Count - 1 do begin
1183                                                         if (Trim(ReadList[i]) <> '') then begin
1184                                                                 No := IntToStr(i + 1);
1185                                                                 DivideStrLine(ReadList[i], @Res);
1186                                                                 AddAnchorTag(@Res);
1187                                                                 ConvRes(@Res, @ResLink, true);
1188                                                                 ConvertResAnchor(@Res);
1189                                                                 if Res.FMailTo = '' then
1190                                                                         html.Append('<a name="' + No + '"></a>'
1191                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span> '
1192                                                                                                         + '<span class="name_label">\96¼\91O\81F</span> '
1193                                                                                                         + '<span class="name"><b>' + Res.FName + '</b></span> '
1194                                                                                                         + '<span class="date_label">\93\8a\8de\93ú\81F</span> '
1195                                                                                                         + '<span class="date">' + Res.FDateTime+ '</span></div>'
1196                                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>')
1197                                                                 else if GikoSys.Setting.ShowMail then
1198                                                                         html.Append('<a name="' + No + '"></a>'
1199                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1200                                                                                                                                                                                                 + '<span class="name_label"> \96¼\91O\81F </span>'
1201                                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1202                                                                                                         + '<b>' + Res.FName + '</b></a><span class="mail"> [' + Res.FMailTo + ']</span>'
1203                                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1204                                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1205                                                                                                         + '<div class="mes">' + Res.FBody + ' </div>')
1206                                                                 else
1207                                                                         html.Append('<a name="' + No + '"></a>'
1208                                                                                                         + '<div class="header"><span class="no"><a href="menu:' + No + '">' + No + '</a></span>'
1209                                                                                                         + '<span class="name_label"> \96¼\91O\81F </span>'
1210                                                                                                         + '<a class="name_mail" href="mailto:' + Res.FMailTo + '">'
1211                                                                                                         + '<b>' + Res.FName + '</b></a>'
1212                                                                                                         + '<span class="date_label"> \93\8a\8de\93ú\81F</span>'
1213                                                                                                         + '<span class="date"> ' + Res.FDateTime+ '</span></div>'
1214                                                                                                                                                                                                 + '<div class="mes">' + Res.FBody + ' </div>');
1215                                                         end;
1216                                                 end;
1217                                                 html.Append('<a name="bottom"></a>');
1218                                                 html.Append('<a name="last"></a>');
1219                                                 html.Append('</body></html>');
1220                                         end else begin
1221                                                 //CSS\94ñ\8eg\97p
1222                                                 html.Append('<html><head>');
1223                                                 html.Append('<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">');
1224                                                 html.Append('<title>' + sTitle + '</title></head>');
1225                                                 html.Append('<body TEXT="#000000" BGCOLOR="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">');
1226                                                 html.Append('<a name="top"></a>');
1227                                                 html.Append('<font size=+1 color="#FF0000">' + sTitle + '</font>');
1228                                                 html.Append('<dl>');
1229                                                 for i := 0 to ReadList.Count - 1 do begin
1230                                                         if (Trim(ReadList[i]) <> '') then begin
1231                                                                 No := IntToStr(i + 1);
1232                                                                 DivideStrLine(ReadList[i], @Res);
1233                                                                 AddAnchorTag(@Res);
1234                                                                 ConvRes(@Res, @ResLink, true);
1235                                                                 ConvertResAnchor(@Res);
1236                                                                 if Res.FMailTo = '' then
1237                                                                         html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> \93\8a\8de\93ú\81F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1238                                                                 else if GikoSys.Setting.ShowMail then
1239                                                                         html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] \93\8a\8de\93ú\81F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>')
1240                                                                 else
1241                                                                         html.Append('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> \93\8a\8de\93ú\81F ' + Res.FDateTime+ '<br><dd>' + Res.Fbody + ' <br><br><br>');
1242                                                         end;
1243                                                 end;
1244                                                 html.Append('</dl>');
1245                                                 html.Append('<a name="bottom"></a>');
1246                                                 html.Append('</body></html>');
1247                                         end;
1248                                 finally
1249                                         html.EndUpdate;
1250                                 end;
1251                         finally
1252                                 ReadList.Free;
1253                         end;
1254                 end;
1255         end;
1256 end;
1257
1258 procedure THTMLCreate.SetResPopupText(Hint : TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
1259 var
1260         i: Integer;
1261         tmp: string;
1262         FileName: string;
1263         Line: Integer;
1264
1265         wkInt: Integer;
1266
1267     boardPlugIn : TBoardPlugIn;
1268     Html: TStringList;
1269         ResLink : TResLinkRec;
1270 begin
1271
1272     Html := TStringList.Create;
1273         try
1274                 if StNum > ToNum then begin
1275                         wkInt := StNum;
1276                         StNum := ToNum;
1277                         ToNum := wkInt;
1278                 end;
1279
1280                 //\8dÅ\91å10\83\8c\83X\82Ü\82Å\95\\8e¦
1281                 if StNum + MAX_POPUP_RES < ToNum then
1282                         ToNum := StNum + MAX_POPUP_RES;
1283
1284         Hint.Title := '';
1285         Hint.RawDocument := '';
1286         Hint.Thread := nil;
1287         
1288                 //\83^\83C\83g\83\8b\95\\8e¦
1289                 if Title then
1290                                 if ThreadItem <> nil then
1291                                         Hint.Title := ThreadItem.Title;
1292
1293         if ThreadItem <> nil then begin
1294             Hint.Thread := ThreadItem;
1295             ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1296             ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
1297             //if ThreadItem.IsBoardPlugInAvailable then begin
1298             if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1299                 //===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
1300                 //boardPlugIn           := ThreadItem.BoardPlugIn;
1301                 boardPlugIn             := ThreadItem.ParentBoard.BoardPlugIn;
1302
1303                 // \83t\83H\83\93\83g\82â\83T\83C\83Y\82Ì\90Ý\92è
1304                 // \95\8e\9a\83R\81[\83h\82Í\83v\83\89\83O\83C\83\93\82É\94C\82¹\82é
1305                 for i := StNum to ToNum do begin
1306                     Line := i;
1307                                         //\82±\82±\82Å\82Q\82¿\82á\82ñ\82Ë\82é\82Ìdat\82Ì\8c`\8e®\82Å\82P\8ds\93Ç\82Ý\8d\9e\82ß\82ê\82Î¥¥¥\81B\81«\93Ç\82ß\82é\82æ\82¤\82É\82È\82Á\82½
1308                                         tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
1309                     if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1310                         Html.Add(GetResString(Line-1, tmp, @ResLink));
1311                                         end;
1312                                 end;
1313                         end else begin
1314                                 for i := StNum to ToNum do begin
1315                                         Line := i;
1316                                         FileName := ThreadItem.FilePath;
1317                                         tmp := GikoSys.ReadThreadFile(FileName, Line);
1318                                         if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1319                                                 Html.Add(GetResString(Line-1, tmp, @ResLink));
1320                                         end;
1321                                 end;
1322                         end;
1323             if (Html.Count > 0) then begin
1324                 Hint.RawDocument := '<DL>' + Html.Text + '</DL>';
1325             end;
1326                 end;
1327         finally
1328         Html.Free;
1329         end;
1330 end;
1331
1332 //\83\8a\83\93\83N\82Ì\95\8e\9a\97ñ\82©\82ç\83\8c\83X\83|\83b\83v\83A\83b\83v\97p\82ÌURL\82É\95Ï\8a·\82·\82é
1333 class function THTMLCreate.GetRespopupURL(AText, AThreadURL : string): string;
1334 var
1335         wkInt: Integer;
1336 begin
1337         Result := '';
1338         if Pos('about:blank..', AText) = 1 then begin
1339                 wkInt := LastDelimiter( '/', AThreadURL );
1340                 if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin
1341                         // Thread.URL \82Í PATH_INFO \93n\82µ
1342                         Result := Copy( AThreadURL, 1,  LastDelimiter( '/', AThreadURL ) );
1343                         wkInt := LastDelimiter( '/', AText );
1344                         if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then
1345                                 // Text \82à PATH_INFO \93n\82µ
1346                                 Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt )
1347                         else
1348                                 // Text \82Í QUERY_STRING \93n\82µ
1349                                 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt );
1350                 end else begin
1351                         // Thread.URL \82Í QUERY_STRING \93n\82µ
1352                         Result := Copy( AThreadURL, 1,  LastDelimiter( '?', AThreadURL ) );
1353                         wkInt := LastDelimiter( '/', AText );
1354                         if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then begin
1355                                 // Text \82Í PATH_INFO \93n\82µ
1356                                 // URL \82É\94Â\82Æ\83L\81[\82ª\91«\82ç\82È\82¢\82Ì\82Å Text \82©\82ç\92¸\91Õ\82·\82é
1357                                 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1358                                 wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) );
1359                                 Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt );
1360                         end else begin
1361                                 // Text \82à QUERY_STRING \93n\82µ
1362                                 Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt )
1363                         end;
1364                 end;
1365         end else if Pos('about:blank/bbs/', AText) = 1 then begin
1366                 //\82µ\82½\82ç\82ÎJBBS\82Ì\8ed\95Ï\82Ì\8bz\8eû
1367                 AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/');
1368                 Result := GetRespopupURL(AText, AThreadURL);
1369         end else begin
1370                 Result := AText;
1371         end;
1372
1373 end;
1374 //\8ew\92è\82µ\82½\83p\83X\82É\83X\83L\83\93\82à\82µ\82­\82ÍCSS\82Ì\83t\83@\83C\83\8b\82Ì\83R\83s\81[\82ð\8dì\82é
1375 class procedure THTMLCreate.SkinorCSSFilesCopy(path: string);
1376 var
1377         tmp, tmpD, tmpF: string;
1378         current: string;
1379         dirs: TStringList;
1380         files: TStringList;
1381         i, j: Integer;
1382 begin
1383         if GikoSys.Setting.UseSkin then begin
1384                 current := ExtractFilePath(GikoSys.GetSkinDir);
1385                 tmp := GikoSys.Setting.CSSFileName;
1386         end else if GikoSys.Setting.UseCSS then begin
1387                 current := ExtractFilePath(GikoSys.GetStyleSheetDir);
1388                 tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName);
1389         end else begin
1390         Exit;
1391     end;
1392         dirs := TStringList.Create;
1393         try
1394                 dirs.Add(tmp);
1395                 if tmp <> current then begin
1396                         GikoSys.GetDirectoryList(current, '*.*', dirs, true);
1397                         for i := 0 to dirs.Count - 1 do begin
1398                                 files := TStringList.Create;
1399                                 try
1400                                         files.BeginUpdate;
1401                                         gikoSys.GetFileList(dirs[i], '*.*', files, true);
1402                                         files.EndUpdate;
1403                                         tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path);
1404                                         if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then
1405                                                 ForceDirectories(tmpD);
1406
1407                                         if(dirs[i] = tmp) and (dirs[i] <> current) then begin
1408                                                 for j := 0 to files.Count - 1 do begin
1409                                                         tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path);
1410                                                         if not FileExists(tmpF) then begin
1411                                                                 CopyFile(PChar(files[j]), PChar(tmpF),True);
1412                                                         end;
1413                                                 end;
1414                                         end;
1415                                 finally
1416                                         files.Free;
1417                                 end;
1418                         end;
1419                 end else begin
1420                         tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path);
1421                         if not DirectoryExists(tmpD) then
1422                                 ForceDirectories(tmpD);
1423                         tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName
1424                                         , GikoSys.GetConfigDir, path);
1425                         if not FileExists(tmpF) then begin
1426                                 CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName)
1427                                         , PChar(tmpF), True);
1428                         end;
1429                 end;
1430         finally
1431                 dirs.Free;
1432         end;
1433 end;
1434 {!
1435 \brief dat\83t\83@\83C\83\8b\82Ì\88ê\83\89\83C\83\93\82ð\95ª\89ð
1436 \param Line dat\83t\83@\83C\83\8b\82ð\8d\\90¬\82·\82é 1 \8ds
1437 \return     \83\8c\83X\8fî\95ñ
1438 }
1439 class procedure THTMLCreate.DivideStrLine(Line: string; PRes: PResRec);
1440 const
1441         delimiter = '<>';
1442 var
1443         pds, pde : PChar;
1444         pss, pse : PChar;
1445         ppos : PChar;
1446 begin
1447         //\8cÅ\92è
1448         PRes.FType := glt2chNew;
1449
1450         pss := PChar(Line);
1451         pse := pss + Length(Line);
1452         pds := PChar(delimiter);
1453         pde := pds + Length(delimiter);
1454
1455         ppos := AnsiStrPosEx(pss, pse, pds, pde);
1456         if (ppos = nil) then begin
1457                 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
1458                 Line := CustomStringReplace(Line, ',', '<>');
1459                 Line := CustomStringReplace(Line, '\81\97\81M', ',');
1460         end;
1461         //Trim\82µ\82Ä\82Í\82¢\82¯\82È\82¢\8bC\82ª\82·\82é\81@by\82à\82\82ã
1462         PRes.FName := MojuUtils.RemoveToken(Line, delimiter);
1463         PRes.FMailTo := MojuUtils.RemoveToken(Line, delimiter);
1464         PRes.FDateTime := MojuUtils.RemoveToken(Line, delimiter);
1465         PRes.FBody := MojuUtils.RemoveToken(Line, delimiter);
1466         //\82Q\82¿\82á\82ñ\82Ë\82é\82Æ\82©\82¾\82Æ\81A\96{\95\82Ì\90æ\93ª\82É\82P\82Â\94¼\8ap\8bó\94\92\82ª\93ü\82Á\82Ä\82¢\82é\82Ì\82Å\8dí\8f\9c\82·\82é
1467         //\91¼\82Ì\8cf\8e¦\94Â\82Å\81A\83\8c\83X\8e©\91Ì\82Ì\8bó\94\92\82©\82à\82µ\82ê\82È\82¢\82¯\82Ç\82»\82ê\82Í\92ú\82ß\82é
1468         PRes.FBody := TrimLeft(PRes.FBody);
1469         //\8bó\82¾\82Æ\96â\91è\82ª\8bN\82«\82é\82©\82ç\81A\8bó\94\92\82ð\90Ý\92è\82·\82é
1470         if PRes.FBody = '' then
1471                 PRes.FBody := '&nbsp;';
1472
1473         PRes.FTitle := MojuUtils.RemoveToken(Line, delimiter);
1474 end;
1475
1476 {!
1477 \brief HTML \82©\82ç\83A\83\93\83J\81[\83^\83O\82ð\8dí\8f\9c
1478 \param s \8c³\82É\82È\82é HTML
1479 \return  \83A\83\93\83J\81[\83^\83O\82ª\8dí\8f\9c\82³\82ê\82½ HTML
1480 }
1481 class function THTMLCreate.DeleteLink(const s: string): string;
1482 var
1483         s1: string;
1484     mark: string;
1485         idx: Integer;
1486 begin
1487     mark := '<a href="';
1488     Result := '';
1489     s1 := s;
1490     idx := AnsiPos(mark, s1);
1491     while idx <> 0 do begin
1492         Result := Result + Copy(s1, 1, idx - 1);
1493         Delete(s1, 1, idx);
1494         // \83^\83O\82Ì\83G\83\93\83h\82ð\92T\82·
1495         idx := AnsiPos('">', s1);
1496         if idx <> 0 then begin
1497             Delete(s1, 1, idx + 1);
1498         end;
1499         // </a> \82Ü\82Å
1500         idx := AnsiPos('</a>', s1);
1501         if idx <> 0 then begin
1502             Result := Result + Copy(s1, 1, idx - 1);
1503             Delete(s1, 1, idx + 3);
1504         end;
1505         idx := AnsiPos(mark, s1);
1506     end;
1507
1508     Result := Result + s1;
1509 end;
1510 {
1511 \brief  HTML\89»\82Ì\82½\82ß\82Ì\92u\8a·
1512 \param  s   \8c³\82É\82È\82é\95\8e\9a\97ñ
1513 \return HTML\82ÌinnerText\82Æ\82µ\82Ä\82ä\82é\82³\82ê\82é\95\8e\9a\97ñ
1514 }
1515 class function THTMLCreate.RepHtml(const s: string): string;
1516 begin
1517 //      s := StringReplace(s, '&', '&amp;', [rfReplaceAll]);
1518     Result := s;
1519         Result := CustomStringReplace(Result, '<', '&lt;');
1520         Result := CustomStringReplace(Result, '>', '&gt;');
1521 //      s := StringReplace(s, ' ', '&nbsp;', [rfReplaceAll]);   //\8ed\97l\95Ï\8dX\82É\82æ\82è&nbsp;\8eg\97p\95s\89Â
1522         Result := CustomStringReplace(Result, '"', '&quot;');
1523 end;
1524 {
1525 \brief  \83\8c\83X\83G\83f\83B\83^\82Å\82Ì\83v\83\8c\83r\83\85\81[\97pHTML\8dì\90¬
1526 \param  Title   \83X\83\8c\83b\83h\83^\83C\83g\83\8b
1527 \param  No  \83\8c\83X\94Ô\8d\86
1528 \param  Mail    \83\81\81[\83\8b\97\93
1529 \param  Name    \96¼\91O\97\93
1530 \param  Body    \96{\95
1531 \return \83v\83\8c\83r\83\85\81[\97pHTML
1532 }
1533 class function THTMLCreate.CreatePreviewHTML(
1534         const Title: string;
1535         const No: string;
1536         const Mail: string;
1537         const Namae: string;
1538         const Body: string
1539 ) : string;
1540 var
1541     posTrip : Integer;
1542     tripOrigin : string;
1543     NameWithTrip: string;
1544     DateTime: string;
1545 begin
1546         Result := '<HTML><HEAD>'#13#10
1547                         + '<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">'#13#10
1548                         + '<TITLE>' + title + '</TITLE>'#13#10
1549                         + '</HEAD>'#13#10
1550                         + '<BODY text="#000000" bgcolor="#EFEFEF" link="#0000FF" alink="#FF0000" vlink="#660099">'#13#10
1551                         + '<FONT COLOR="#FF0000">' + title + '</FONT>'#13#10
1552                         + '<DL>'#13#10;
1553
1554         DateTime := FormatDateTime('yyyy/mm/dd(aaa) hh:nn', Now());
1555
1556     NameWithTrip := Namae;
1557     posTrip := AnsiPos( '#', Namae );
1558     if posTrip > 0 then begin
1559         tripOrigin := Copy( Namae, posTrip + 1, Length( Namae ) );
1560         NameWithTrip := Copy( Namae, 1, posTrip - 1 ) + '</B> \81\9f' +
1561                     get_2ch_trip( PChar( tripOrigin ) ) + '<B>';
1562     end;
1563     if Mail = '' then begin
1564         Result := Result + '<DT>' + No + ' \81F <FONT color="forestgreen"><B>' + NameWithTrip
1565                  + '</B></FONT> \81F ' + DateTime+ '<BR><DD>' + Body + '<BR><BR><BR>' + #13#10
1566     end else begin
1567                 Result := Result + '<DT>' + No + ' \81F <A href="mailto:' + Mail + '"><B>' + NameWithTrip
1568                  + '</B></A> [' + Mail + ']\81F ' + DateTime+ '<BR><DD>' + Body + '<BR><BR><BR>' + #13#10;
1569     end;
1570         Result := Result + '</BODY></HTML>';
1571
1572 end;
1573 {
1574 \brief  \95\\8e¦\94Í\88Í\8aO\83\8c\83X\94Ô\8d\86\94»\92è\8f\88\97\9d
1575 \param  item    \95\\8e¦\83X\83\8c\83b\83h
1576 \param  index   \83\8c\83X\94Ô\8d\86
1577 \return ture:\95\\8e¦\94Í\88Í\8aO false:\95\\8e¦\94Í\88Í\93à
1578 }
1579 function THTMLCreate.isOutsideRange( item: TThreadItem; index: Integer ): Boolean;
1580 begin
1581     Result := False;
1582     // \95\\8e¦\94Í\88Í\82ð\8cÀ\92è
1583     case GikoSys.ResRange of
1584     Ord( grrKoko ):
1585         if item.Kokomade > (index + 1) then
1586             Result := True;
1587     Ord( grrNew ):
1588         if item.NewReceive > (index + 1) then
1589             Result := True;
1590     10..65535:
1591         if (GikoSys.Setting.HeadResCount) < (index + 1)  then begin
1592             if (item.Count - index) > GikoSys.ResRange then begin
1593                 Result := True;
1594             end;
1595         end;
1596     end;
1597 end;
1598 constructor TBufferedWebBrowser.Create(Browser: TWebBrowser; BuffSize: Integer);
1599 begin
1600         inherited Create;
1601         Self.Sorted := False;
1602         if (Browser = nil) then
1603                 Raise  Exception.Create('Browser is NULL');
1604         FBrowser := Browser;
1605
1606         // \83o\83b\83t\83@\82·\82é\8ds\90\94\82ð
1607         if (BuffSize < 0) then begin
1608                 FBuffSize := 100;
1609         end else begin
1610                 FBuffSize := BuffSize;
1611         end;
1612         Self.Capacity := FBuffSize + 10;
1613 end;
1614 procedure TBufferedWebBrowser.Open;
1615 begin
1616         FBrowserDoc := FBrowser.ControlInterface.Document;
1617         FBrowserDoc.open;
1618         FBrowserDoc.charset := 'Shift_JIS';
1619 end;
1620 procedure TBufferedWebBrowser.Close;
1621 begin
1622         Self.Flush;
1623         try
1624                 FBrowserDoc.Close;
1625         except
1626         end;
1627         FBrowser := nil;
1628 end;
1629 function TBufferedWebBrowser.Add(const S: string): Integer;
1630 begin
1631         Result := inherited Add(TrimRight(s));
1632         if (Self.Count > FBuffSize) then begin
1633                 FBrowserDoc.Write(Self.Text);
1634                 Self.Clear;
1635         end;
1636 end;
1637 procedure TBufferedWebBrowser.Flush ;
1638 begin
1639         if (Self.Count > 0) then begin
1640                 FBrowserDoc.Write(Self.Text);
1641                 Self.Clear;
1642         end;
1643 end;
1644 destructor TBufferedWebBrowser.Destory;
1645 begin
1646         try
1647                 if (FBrowserDoc <> 0) then begin
1648                         FBrowserDoc.close;
1649                         FBrowserDoc := 0;
1650                 end;
1651         except
1652         end;
1653         inherited;
1654 end;
1655 //! \8aÖ\98A\83L\81[\83\8f\81[\83h\83\8a\83\93\83N\8fo\97Í
1656 function THTMLCreate.getKeywordLink(item: TThreadItem): String;
1657 const
1658     PARA_URL = 'http://p2.2ch.io/getf.cgi?';
1659 begin
1660     Result := '';
1661     if (GikoSys.Setting.AddKeywordLink) and (item.ParentBoard.Is2ch) then begin
1662         Result := '<p><span id="keyword"><a href="' + PARA_URL
1663             + item.URL + '" target="_blank">\8aÖ\98A\83L\81[\83\8f\81[\83h</a></span></p>';
1664     end;
1665 end;
1666 initialization
1667          HTMLCreater := THTMLCreate.Create;
1668
1669 finalization
1670         if HTMLCreater <> nil then begin
1671                 FreeAndNil(HTMLCreater);
1672         end;
1673
1674 end.