Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/HTMLCreate.pas

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


Revision 1.4.2.1 - (hide annotations) (download) (as text)
Sun Oct 30 04:34:37 2005 UTC (18 years, 5 months ago) by h677
Branch: Bdraw
Changes since 1.4: +219 -159 lines
File MIME type: text/x-pascal
WebBrowserへの書き込みを直接ではなく、メモリストリーム経由に変更。
かちゅ〜しゃ用のスキンの使用をオプションに変更

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

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