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.35 by h677, Wed Feb 14 15:12:06 2007 UTC revision 1.35.6.2 by h677, Tue May 8 21:27:45 2007 UTC
# Line 15  uses Line 15  uses
15          {HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,}          {HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,}
16          {bmRegExp,} AbonUnit,   MojuUtils, Setting,          {bmRegExp,} AbonUnit,   MojuUtils, Setting,
17          ExternalBoardManager, ExternalBoardPlugInMain{,}          ExternalBoardManager, ExternalBoardPlugInMain{,}
18          {Sort,} ,GikoBayesian, HintWindow, ActiveX;          {Sort,} ,GikoBayesian, HintWindow, ActiveX, ResPopupBrowser;
19    
20  type  type
21    
# Line 69  type Line 69  type
69               sLen :Integer): String;               sLen :Integer): String;
70          function isOutsideRange(item: TThreadItem; index: Integer ): Boolean;          function isOutsideRange(item: TThreadItem; index: Integer ): Boolean;
71          function getKeywordLink(item: TThreadItem): String;          function getKeywordLink(item: TThreadItem): String;
72            function GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
73          public          public
74                  { Public 宣言 }                  { Public 宣言 }
75                  procedure AddAnchorTag(PRes: PResRec);                  procedure AddAnchorTag(PRes: PResRec);
# Line 78  type Line 79  type
79                  procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
80                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);                  procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
81                  //レスポップアップの作成                  //レスポップアップの作成
82                  procedure SetResPopupText(Hint :TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);                  procedure SetResPopupText(Hint :TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
83                  //リンクの文字列からレスポップアップ用のURLに変換する                  //リンクの文字列からレスポップアップ用のURLに変換する
84                  class function GetRespopupURL(AText, AThreadURL : string): string;                  class function GetRespopupURL(AText, AThreadURL : string): string;
85                  //指定したパスにスキンもしくはCSSのファイルのコピーを作る                  //指定したパスにスキンもしくはCSSのファイルのコピーを作る
# Line 884  end; Line 885  end;
885  procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );  procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
886  var  var
887          i: integer;          i: integer;
         No: string;  
888          NewReceiveNo: Integer;          NewReceiveNo: Integer;
         Res: TResRec;  
889          ThreadName: String;          ThreadName: String;
890          ResLink : TResLinkRec;          ResLink : TResLinkRec;
891  begin  begin
# Line 920  begin Line 919  begin
919                  end;                  end;
920    
921                  if (Trim(ReadList[i]) <> '') then begin                  if (Trim(ReadList[i]) <> '') then begin
922                          No := IntToStr(i + 1);              html.Add(GetResString(i, ReadList[i], @ResLink));
                         DivideStrLine(ReadList[i], @Res);  
             AddAnchorTag(@Res);  
             ConvRes(@Res, @ResLink);  
             Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);  
             if Res.FMailTo = '' then  
                 html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<font color="forestgreen"><b> ' + Res.FName + ' </b></font> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10)  
             else if GikoSys.Setting.ShowMail then  
                 html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10)  
             else  
                 html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10);  
923          end;          end;
924                  if ThreadItem.Kokomade = (i + 1) then begin                  if ThreadItem.Kokomade = (i + 1) then begin
925                          html.Add('</dl>');                          html.Add('</dl>');
# Line 941  begin Line 930  begin
930      html.Add(getKeywordLink(ThreadItem));      html.Add(getKeywordLink(ThreadItem));
931          html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');          html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
932  end;  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        AddAnchorTag(@Res);
941        ConvRes(@Res, PResLink);
942        Res.FDateTime := AddBeProfileLink(Res.FDateTime, index + 1);
943        if Res.FMailTo = '' then
944            Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<font color="forestgreen"><b> ' + Res.FName + ' </b></font> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10
945        else if GikoSys.Setting.ShowMail then
946            Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10
947        else
948            Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10;
949    end;
950  procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);  procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
951  var  var
952          ReadList: TStringList;          ReadList: TStringList;
# Line 1249  begin Line 1254  begin
1254          end;          end;
1255  end;  end;
1256    
1257  procedure THTMLCreate.SetResPopupText(Hint : TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);  procedure THTMLCreate.SetResPopupText(Hint : TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
1258  var  var
1259          i: Integer;          i: Integer;
1260          tmp: string;          tmp: string;
# Line 1258  var Line 1263  var
1263    
1264          wkInt: Integer;          wkInt: Integer;
1265    
         Res: TResRec;  
         Header: string;  
         Body: string;  
1266      boardPlugIn : TBoardPlugIn;      boardPlugIn : TBoardPlugIn;
1267        Html: TStringList;
1268            ResLink : TResLinkRec;
1269  begin  begin
1270    
1271        Html := TStringList.Create;
1272          try          try
1273                  if StNum > ToNum then begin                  if StNum > ToNum then begin
1274                          wkInt := StNum;                          wkInt := StNum;
# Line 1280  begin Line 1286  begin
1286                                          Hint.Title := ThreadItem.Title;                                          Hint.Title := ThreadItem.Title;
1287    
1288          if ThreadItem <> nil then begin          if ThreadItem <> nil then begin
1289                ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
1290                ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
1291              //if ThreadItem.IsBoardPlugInAvailable then begin              //if ThreadItem.IsBoardPlugInAvailable then begin
1292              if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin              if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
1293                  //===== プラグインによる表示                  //===== プラグインによる表示
# Line 1293  begin Line 1301  begin
1301                                          //ここで2ちゃんねるのdatの形式で1行読み込めれば・・・。↓読めるようになった                                          //ここで2ちゃんねるのdatの形式で1行読み込めれば・・・。↓読めるようになった
1302                                          tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );                                          tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
1303                      if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin                      if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1304                                                  DivideStrLine(tmp, @Res);                          Html.Add(GetResString(Line-1, tmp, @ResLink));
                         if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then  
                                 Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' 投稿日: ' + Res.FDateTime  
                         else  
                                 Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' [' + res.FMailTo + '] 投稿日: ' + Res.FDateTime;  
                                                 Header := DeleteFontTag(Header);  
                                                 Header := CustomStringReplace(Header, '<br>', '',true);  
   
                                                 Body := CustomStringReplace(Res.FBody, '<br> ', #10,true);  
                                                 Body := CustomStringReplace(Body, '<br>', #10,true);  
                         Body := CustomStringReplace(Body, '</a>', '',true);  
                                                 Body := THTMLCreate.DeleteLink(Body);  
                         Body := CustomStringReplace(Body, '&lt;', '<');  
                         Body := CustomStringReplace(Body, '&gt;', '>');  
                         Body := CustomStringReplace(Body, '&quot;', '"');  
                         Body := CustomStringReplace(Body, '&amp;', '&');  
                         Body := CustomStringReplace(Body, '&nbsp;', ' ');  
   
                                                 Hint.Add(Header, Body);  
1305                                          end;                                          end;
1306                                  end;                                  end;
1307                          end else begin                          end else begin
# Line 1320  begin Line 1310  begin
1310                                          FileName := ThreadItem.FilePath;                                          FileName := ThreadItem.FilePath;
1311                                          tmp := GikoSys.ReadThreadFile(FileName, Line);                                          tmp := GikoSys.ReadThreadFile(FileName, Line);
1312                                          if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin                                          if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
1313                                                  DivideStrLine(tmp, @Res);                                                  Html.Add(GetResString(Line-1, tmp, @ResLink));
                                                 if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then  
                                                         Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' 投稿日: ' + Res.FDateTime  
                                                 else  
                                                         Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' [' + res.FMailTo + '] 投稿日: ' + Res.FDateTime;  
   
                                                 Body := DeleteFontTag(Res.FBody);  
                                                 Body := CustomStringReplace(Body, '<br> ', #10,true);  
                                                 Body := CustomStringReplace(Body, '<br>', #10,true);  
                                                 Body := CustomStringReplace(Body, '</a>', '',true);  
                                                 Body := THTMLCreate.DeleteLink(Body);  
                                                 Body := CustomStringReplace(Body, '&lt;', '<');  
                                                 Body := CustomStringReplace(Body, '&gt;', '>');  
                                                 Body := CustomStringReplace(Body, '&quot;', '"');  
                                                 Body := CustomStringReplace(Body, '&amp;', '&');  
                                                  Body := CustomStringReplace(Body, '&nbsp;', ' ');  
                                                 Hint.Add(Header, Body);  
1314                                          end;                                          end;
1315                                  end;                                  end;
1316                          end;                          end;
1317                if (Html.Count > 0) then begin
1318                    Hint.Write('<DL>' + Html.Text + '</DL>');
1319                end;
1320                  end;                  end;
1321          finally          finally
1322            Html.Free;
1323          end;          end;
1324  end;  end;
1325    

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.35.6.2

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