Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/HTMLCreate.pas

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

revision 1.27 by h677, Sat Mar 4 12:20:33 2006 UTC revision 1.28 by h677, Sun Jul 30 01:09:45 2006 UTC
# Line 60  type Line 60  type
60                  procedure CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );                  procedure CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
61                  procedure ConvertResAnchor(PRes: PResRec);                  procedure ConvertResAnchor(PRes: PResRec);
62                  procedure separateNumber(var st: String; var et: String; const Text, Separator: String);                  procedure separateNumber(var st: String; var et: String; const Text, Separator: String);
63                  function checkComma(const s : String; var j : Integer; var No  : String) : boolean;                  function checkComma(const s : String; var j : Integer) : boolean;
64                  function addResAnchor(PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;                  function addResAnchor(PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
65                   var s : String; j : Integer; const No: String) : string;                   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    
71          public          public
72                  { Public 宣言 }                  { Public 宣言 }
73                  procedure AddAnchorTag(PRes: PResRec);                  procedure AddAnchorTag(PRes: PResRec);
74                  function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;                  function LoadFromSkin(fileName: string; ThreadItem: TThreadItem; SizeByte: Integer): string;
75                  function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;                  function SkinedRes(const skin: string; PRes: PResRec; const No: string): string;
76                  procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;                  procedure ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false); overload;
                 function ConvRes(const Body, Bbs, Key,  ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string; DatToHTML: boolean = false): string; overload;  
77                  procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
78                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
79                  //レスポップアップの作成                  //レスポップアップの作成
# Line 352  begin Line 356  begin
356          end else          end else
357                  Result := AID;                  Result := AID;
358  end;  end;
359    //! レスアンカーのレス番号を分割する
360    // Text = '1-9' -> st =  '1'; et = '9'
361    // Text = '10'  -> st = '10'; et = '10'
362  procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text:String; const Separator: String);  procedure THTMLCreate.separateNumber(var st: String; var et: String; const Text:String; const Separator: String);
363  var  var
364          p : Integer;          p : Integer;
# Line 365  begin Line 372  begin
372                  et := Text;                  et := Text;
373          end;          end;
374  end;  end;
375    //! レスアンカーが指しているレス番号の文字列を取得する
376    function THTMLCreate.getNumberString(
377        const str: String;
378        var index :Integer; var dbCharlen: Boolean; sLen :Integer)
379    : String;
380    const
381            SN      = '0123456789';
382    var
383        ch : String;
384        sw : Boolean;
385    begin
386        Result := '';
387        sw := False;
388        while (index <= sLen) do begin
389            if (ByteType(str, index) = mbSingleByte) then begin
390                //1byte文字
391                ch := str[index];
392                Inc(index);
393                dbCharlen := false;
394            end else begin
395                //2byte文字
396                ch := ZenToHan(Copy(str, index, 2));
397                Inc(index, 2);
398                dbCharlen := true;
399            end;
400    
401            if System.Pos(ch, SN) > 0 then begin
402                Result := Result + ch;
403            end else if (ch = '-') then begin
404                if sw then break;
405                if Result = '' then break;
406                Result := Result + ch;
407                sw := true;
408            end else begin
409                break;
410            end;
411        end;
412    end;
413    
414  procedure THTMLCreate.ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false);  procedure THTMLCreate.ConvRes( PRes : PResRec; PResLink : PResLinkRec; DatToHTML: boolean = false);
415  const  const
416          GT      = '&gt;';          GT      = '&gt;';
         SN      = '0123456789';  
417          //検索対象の文字列郡          //検索対象の文字列郡
418          TOKEN : array[0..5] of string = (GT+GT, GT, '>>', '>', '<a ', '<A ');          TOKEN : array[0..5] of string = (GT+GT, GT, '>>', '>', '<a ', '<A ');
419  var  var
420          i : integer;          i : integer;
421          s : string;          s : string;
         sw: boolean;  
         cm: boolean;  
422          No: string;          No: string;
         oc      : string;  
423          pos, pmin : integer;          pos, pmin : integer;
424          j : integer;          j : integer;
         ch : string;  
425          db : boolean;          db : boolean;
         len : integer;  
426          rink : string;          rink : string;
   
         procedure getNumberString;  
         begin  
                 while (j <= len) do begin  
                         if (ByteType(s, j) = mbSingleByte) then begin  
                                 //1byte文字  
                                 ch := s[j];  
                                 Inc(j);  
                                 db := false;  
                         end else begin  
                                 //2byte文字  
                                 ch := ZenToHan(Copy(s, j, 2));  
                                 Inc(j, 2);  
                                 db := true;  
                         end;  
   
                         if System.Pos(ch, SN) > 0 then begin  
                                 No := No + ch;  
                         end else if (ch = '-') then begin  
                                 if sw then break;  
                                 if No = '' then break;  
                                 No := No + ch;  
                                 sw := true;  
                         end else begin  
                                 break;  
                         end;  
                 end;  
         end;  
   
427  begin  begin
428          //s に本文を全部入れる          //s に本文を全部入れる
429          s        :=     PRes.FBody;          s        :=     PRes.FBody;
# Line 471  begin Line 482  begin
482                          end;                          end;
483                          // レスアンカーが含まれていたら,が続く限りアンカーとして扱う                          // レスアンカーが含まれていたら,が続く限りアンカーとして扱う
484                          if i <= 3 then begin                          if i <= 3 then begin
485                                  No := '';                  appendResAnchor(PRes, PResLink, DatToHTML, s );
                                 j := 1;  
                                 len := Length(s);  
                                 cm := checkComma(s, j, No);  
                                 len := Length(s);  
                                 while cm do begin  
                                         oc := '';  
                                         No := '';  
                                         sw := false;  
                                         db := false;  
                                         getNumberString;  
                                         //終端まで行っての終了かチェック  
                                         if j <= len then begin  
                                                 if db then j := j - 2  
                                                 else j := j - 1;  
                                         end;  
                                         addResAnchor(PRes, PResLink, DatToHTML, s, j, No);  
                                         j := 1;  
                                         len := Length(s);  
                                         cm := checkComma(s, j, No);  
                                 end;  
486                          end;                          end;
487                  end else begin                  end else begin
488                          //何かしら見つかったパターン                          //何かしら見つかったパターン
489                          j := Length(TOKEN[i]) + 1;                          j := Length(TOKEN[i]) + 1;
                         oc := '';  
                         No := '';  
                         sw := false;  
490                          db := false;                          db := false;
491                          len := Length(s);                  No := getNumberString(s, j, db, Length(s) );
                         getNumberString;  
492                          //終端まで行っての終了かチェック                          //終端まで行っての終了かチェック
493                          if j <= len then begin                          if j <= Length(s) then begin
494                                  if db then j := j - 2                                  if db then j := j - 2
495                                  else j := j - 1;                                  else j := j - 1;
496                          end;                          end;
497                          addResAnchor(PRes, PResLink, DatToHTML, s, j, No);                          addResAnchor(PRes, PResLink, DatToHTML, s, j, No);
498    
499                // , が続く限りレスアンカーとして処理する
500                appendResAnchor(PRes, PResLink, DatToHTML, s );
501                  end;                  end;
502          end;          end;
503          if Length(s) > 0 then begin          if Length(s) > 0 then begin
# Line 516  begin Line 506  begin
506  end;  end;
507  function THTMLCreate.checkComma(  function THTMLCreate.checkComma(
508          const s : String;          const s : String;
509          var j : Integer;          var j : Integer
         var No  : String  
510  ) : boolean;  ) : boolean;
511  var  var
512          bType : TMbcsByteType;          bType : TMbcsByteType;
# Line 532  begin Line 521  begin
521                                  Inc(j)                                  Inc(j)
522                          else                          else
523                                  Inc(j, 2);                                  Inc(j, 2);
                         No := '';  
524                  end;                  end;
525          end;          end;
526  end;  end;
527    function THTMLCreate.appendResAnchor(
528            PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
529            var s : String) : string;
530    var
531        No{, ch, oc}: String;
532        len, j : Integer;
533        cm, {sw,} db : Boolean;
534    
535    begin
536        No := '';
537        j := 1;
538        cm := checkComma(s, j);
539        len := Length(s);
540        while cm do begin
541            db := false;
542            No := getNumberString(s, j, db, len );
543    
544            //終端まで行っての終了かチェック
545            if j <= len then begin
546                if db then j := j - 2
547                else j := j - 1;
548            end;
549            addResAnchor(PAddRes, PResLink, dat, s, j, No);
550            j := 1;
551            len := Length(s);
552            cm := checkComma(s, j);
553        end;
554    end;
555    
556  function THTMLCreate.addResAnchor(  function THTMLCreate.addResAnchor(
557          PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;          PAddRes: PResRec; PResLink : PResLinkRec; dat : boolean;
558          var s : String; j : Integer; const No: String) : string;          var s : String; j : Integer; const No: String) : string;
# Line 562  begin Line 579  begin
579          Delete(s, 1, j - 1);          Delete(s, 1, j - 1);
580  end;  end;
581    
 (*************************************************************************  
  *  
  * from HotZonu  
  *************************************************************************)  
 function THTMLCreate.ConvRes(const Body, Bbs, Key,  
         ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue : string;  
         DatToHTML: boolean = false): string;  
 const  
         GT      = '&gt;';  
         SN      = '0123456789';  
         FORMAT_LINK = '<a href="../test/read.cgi?%s=%s&%s=%s&%s=%s&%s=%s&%s=%s" target="_blank">';  
         //検索対象の文字列郡  
         TOKEN : array[0..5] of string = (GT+GT, GT, '>>', '>', '<a ', '<A ');  
 var  
         i : integer;  
         s : string;  
         sw: boolean;  
         cm: boolean;  
         No: string;  
         oc      : string;  
         pos, pmin : integer;  
         j : integer;  
         ch : string;  
         db : boolean;  
         len : integer;  
         rink : string;  
         function addResAnchor(const Left :string) : string;  
         var  
                 st,et : string;  
         begin  
                 //終端まで行っての終了かチェック  
                 if j <= len then begin  
                         if db then j := j - 2  
                         else j := j - 1;  
                 end;  
                 //何も数字が見つからないとき  
                 if No = '' then begin  
                         Result := Left + Copy(s, 1, j - 1);  
                 end else begin  
                         separateNumber(st, et, No, '-');  
   
                         if not DatToHTML then begin  
                                 Result := Left + Format(FORMAT_LINK,  
                                                         [ParamBBS, Bbs, ParamKey, Key, ParamStart, st, ParamTo, et, ParamNoFirst, ParamTrue]);  
                         end else begin  
                                 Result := Left + Format('<a href="#%s">', [st]);  
                         end;  
                         Result := Result + Copy(s, 1, j - 1) + '</a>';  
                 end;  
                 Delete(s, 1, j - 1);  
         end;  
   
         procedure getNumberString;  
         begin  
                 while (j <= len) do begin  
                         if (ByteType(s, j) = mbSingleByte) then begin  
                                 //1byte文字  
                                 ch := s[j];  
                                 Inc(j);  
                                 db := false;  
                         end else begin  
                                 //2byte文字  
                                 ch := ZenToHan(Copy(s, j, 2));  
                                 Inc(j, 2);  
                                 db := true;  
                         end;  
   
                         if System.Pos(ch, SN) > 0 then begin  
                                 No := No + ch;  
                         end else if (ch = '-') then begin  
                                 if sw then break;  
                                 if No = '' then break;  
                                 No := No + ch;  
                                 sw := true;  
                         end else begin  
                                 break;  
                         end;  
                 end;  
         end;  
   
         function checkComma : boolean;  
         begin  
                 j := 1;  
                 len := Length(s);  
                 if ((len > 0) and (s[j] = ',')) or ((len > 1) and (ZenToHan(Copy(s, j ,2)) = ','))  then begin  
                         Result := true;  
                         if (ByteType(s, j) = mbSingleByte) then  
                                 Inc(j)  
                         else  
                                 Inc(j, 2);  
                         No := '';  
                 end else begin  
                         Result := false;  
                 end;  
         end;  
 begin  
         //s に本文を全部入れる  
         s        :=     Body;  
         //結果をクリア  
         Result   :=     '';  
   
         //  
         while Length(s) > 2 do begin  
                 pmin := Length(s) + 1;  
                 i       := Length(token);  
                 for j := 0 to 5 do begin  
                         pos := AnsiPos(TOKEN[j], s);  
                         if pos <> 0 then begin  
                                 if pos < pmin then begin  
                                         //どれでヒットしたか保存  
                                         i := j;  
                                         //最小値を更新  
                                         pmin := pos;  
                                 end;  
                         end;  
                 end;  
   
                 //ヒットした文字列の一つ手前まで結果にコピー  
                 Result := Result + Copy(s, 1, pmin - 1);  
                 Delete(s, 1, pmin - 1);  
   
                 if i = 6 then begin  
                         //ヒットなし  
                 end else if (i = 4) or (i = 5) then begin  
                         //'<a ' or '<A' でヒット '</a>' or '</A>' までコピー  
                         pmin := AnsiPos('</a>' , s);  
                         pos := AnsiPos('</A>' , s);  
                         if (pmin <> 0) and (pos <> 0) then begin  
                                 if (pmin > pos) then begin  
                                         pmin := pos;  
                                 end;  
                         end else if (pos <> 0) then begin  
                                 pmin := pos;  
                         end;  
                         rink := Copy(s, 1, pmin + 3);  
                         Result := Result + rink;  
                         Delete(s, 1, pmin + 3);  
   
                         pmin := Length(rink);  
                         i       := Length(TOKEN);  
                         for j := 0 to 3 do begin  
                                 pos := AnsiPos(TOKEN[j], rink);  
                                 if pos <> 0 then begin  
                                         if pos < pmin then begin  
                                                 //どれでヒットしたか保存  
                                                 i := j;  
                                                 //最小値を更新  
                                                 pmin := pos;  
                                         end;  
                                 end;  
                         end;  
                         // レスアンカーが含まれていたら,が続く限りアンカーとして扱う  
                         if i <= 3 then begin  
                                 No := '';  
                                 cm := checkComma;  
                                 len := Length(s);  
                                 while cm do begin  
                                         oc := '';  
                                         No := '';  
                                         sw := false;  
                                         db := false;  
                                         getNumberString;  
                                         Result := addResAnchor(Result);  
                                         cm := checkComma;  
                                 end;  
                         end;  
                 end else begin  
                         //何かしら見つかったパターン  
                         j := Length(TOKEN[i]) + 1;  
                         oc := '';  
                         No := '';  
                         sw := false;  
                         db := false;  
                         len := Length(s);  
                         getNumberString;  
                         Result := addResAnchor(Result);  
                 end;  
         end;  
         Result := Result + s;  
 end;  
582    
583  procedure THTMLCreate.ConvertResAnchor(PRes: PResRec);  procedure THTMLCreate.ConvertResAnchor(PRes: PResRec);
584  const  const
# Line 1631  begin Line 1468  begin
1468          finally          finally
1469                  dirs.Free;                  dirs.Free;
1470          end;          end;
1471  end;{!  end;
1472    {!
1473  \brief datファイルの一ラインを分解  \brief datファイルの一ラインを分解
1474  \param Line datファイルを構成する 1 行  \param Line datファイルを構成する 1 行
1475  \return     レス情報  \return     レス情報

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28

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