addnewfeed_frm.pas

自己写的一个 RSS 阅读器

unit AddNewFeed_Frm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, JvExStdCtrls, JvHtControls,
  WinHTTP,MSXML2_TLB, JvExComCtrls, JvListView, JvWizard, JvExControls,
  JvComponent,uRSSFeed,uRDFFeed,uAtomFeed,uRssBase,uOpml, Mask, JvExMask,
  JvToolEdit,cxTL, Buttons;

type
  TFmAddNewFeed = class(TForm)
    Image1: TImage;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    EdtFeedUrl: TEdit;
    EdtFeedTitle: TEdit;
    JvHTLabel1: TJvHTLabel;
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    HtmLbSta: TJvHTLabel;
    WinHTTP: TWinHTTP;
    WinHTTPOpml: TWinHTTP;
    BtnOPMLSelAll: TButton;
    BtnOPMLSelNull: TButton;
    JvHTLabel2: TJvHTLabel;
    Button1: TButton;
    OpmlListView: TJvListView;
    OpenDialog1: TOpenDialog;
    Wizard: TJvWizard;
    Page1: TJvWizardInteriorPage;
    Page2: TJvWizardInteriorPage;
    Page3: TJvWizardInteriorPage;
    Page4: TJvWizardInteriorPage;
    Page5: TJvWizardInteriorPage;
    ImgPnl: TPanel;
    Label2: TLabel;
    EdtFilter: TEdit;
    FilterBox: TComboBox;
    Label3: TLabel;
    Button2: TButton;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    JvFilenameEdit1: TJvFilenameEdit;
    procedure FormCreate(Sender: TObject);
    procedure HTTPError(Sender: TObject; ErrorCode: Integer;
      Stream: TStream);
    procedure Progress(Sender: TObject; const ContentType: String;
      DataSize, BytesRead, ElapsedTime, EstimatedTimeLeft: Integer;
      PercentsDone: Byte; TransferRate: Single; Stream: TStream);
    procedure WinHTTPDone(Sender: TObject; const ContentType: String;
      FileSize: Integer; Stream: TStream);
    //OPML
    procedure WinHTTPOpmlDone(Sender: TObject; const ContentType: String;
      FileSize: Integer; Stream: TStream);
    procedure OpmlListViewAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    procedure OPMLSelBtnClick(Sender: TObject);
    procedure Page4BackButtonClick(Sender: TObject; var Stop: Boolean);
    procedure Page1NextButtonClick(Sender: TObject; var Stop: Boolean);
    procedure WizardActivePageChanged(Sender: TObject);
    procedure Page2NextButtonClick(Sender: TObject; var Stop: Boolean);
    procedure Page4NextButtonClick(Sender: TObject; var Stop: Boolean);
    procedure Page2BackButtonClick(Sender: TObject; var Stop: Boolean);
    procedure Page3FinishButtonClick(Sender: TObject; var Stop: Boolean);
    procedure Page5FinishButtonClick(Sender: TObject; var Stop: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    XmlDoc,OPMLDoc:IXMLDOMDocument2;
    RssBase:IRSSBase;
    Opml:TOpmlType;
    ChannelAddToNode:TcxtreeListNode;
    //Rss
    procedure LoadRss;
    //OPML
    procedure LoadOPML;
    procedure GetOpmlInfo;
    procedure GoError(ErrStr:string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FmAddNewFeed: TFmAddNewFeed;
procedure ExecAddNewFeed;

implementation

uses uHTMLMessage,MProperties, uMain,ActiveX,ChooseFolder_Frm,Clipbrd,
     uFeed,uConstants,uW3CDTF;

{$R *.dfm}

procedure ExecAddNewFeed;
var NewFeedDlg:TFmAddNewFeed;
begin
  NewFeedDlg := TFmAddNewFeed.Create(Application.MainForm);
  try
    NewFeedDlg.ShowModal;
  finally
    NewFeedDlg.Free;
  end;
end;

procedure TFmAddNewFeed.FormCreate(Sender: TObject);
begin
  Image1.Picture.Bitmap.Handle := LoadBitmap(HInstance,'NEWFEEDSIDE');
  WinHTTP.Agent := gProperties.UserAgent;
  WinHTTPOpml.Agent := gProperties.UserAgent;
  if gProperties.ProxyMode = PM_Custom then
  begin
    WinHTTP.Proxy.ProxyServer   := gProperties.ProxyServer;
    WinHTTP.Proxy.ProxyPort     := gProperties.ProxyPort;
    WinHTTP.Proxy.ProxyUsername := gProperties.ProxyUsername;
    WinHTTP.Proxy.ProxyPassword := gProperties.ProxyPassword;
    WinHTTP.Proxy.ProxyBypass   := gProperties.ProxyByPass;

    WinHTTPOpml.Proxy.ProxyServer   := gProperties.ProxyServer;
    WinHTTPOpml.Proxy.ProxyPort     := gProperties.ProxyPort;
    WinHTTPOpml.Proxy.ProxyUsername := gProperties.ProxyUsername;
    WinHTTPOpml.Proxy.ProxyPassword := gProperties.ProxyPassword;
    WinHTTPOpml.Proxy.ProxyBypass   := gProperties.ProxyByPass;
  end
  else if (gProperties.ProxyMode = PM_Auto) and (gProperties.IEProxyProxyEnabled) then
  begin 
    WinHTTP.Proxy.ProxyServer   := gProperties.IEProxyHost;
    WinHTTP.Proxy.ProxyPort     := gProperties.IEProxyPort;
    WinHTTP.Proxy.ProxyUsername := '';
    WinHTTP.Proxy.ProxyPassword := '';
    WinHTTP.Proxy.ProxyBypass   := gProperties.ProxyByPass;

    WinHTTPOpml.Proxy.ProxyServer   := gProperties.IEProxyHost;
    WinHTTPOpml.Proxy.ProxyPort     := gProperties.IEProxyPort;
    WinHTTPOpml.Proxy.ProxyUsername := '';
    WinHTTPOpml.Proxy.ProxyPassword := '';
    WinHTTPOpml.Proxy.ProxyBypass   := gProperties.ProxyByPass;
  end;
  XmlDoc := CoDOMDocument.Create;
  OPMLDoc := CoDOMDocument.Create;
end;

procedure TFmAddNewFeed.GoError(ErrStr:string);
begin
  ProgressBar1.Visible := False;
  ProgressBar1.Position := 0;
  HtmLbSta.Caption := '<font color="#FF0000"><B>Error</B></font>: '+ErrStr;
end;

procedure TFmAddNewFeed.HTTPError(Sender: TObject;
  ErrorCode: Integer; Stream: TStream);
begin
  GoError('Http errorCode:'+IntToStr(ErrorCode));
end;

procedure TFmAddNewFeed.Progress(Sender: TObject;
  const ContentType: String; DataSize, BytesRead, ElapsedTime,
  EstimatedTimeLeft: Integer; PercentsDone: Byte; TransferRate: Single;
  Stream: TStream);
begin
  ProgressBar1.Visible := True;
  ProgressBar1.Position := PercentsDone;
end;

//Rss

procedure TFmAddNewFeed.WinHTTPDone(Sender: TObject;
  const ContentType: String; FileSize: Integer; Stream: TStream);
var
  Stm:IStream;
  baseName:string;
begin
  stm := TStreamAdapter.Create(stream);
  XmlDoc.load(Stm);
  if XmlDoc.parseError.errorCode <> 0 then
  begin
    GoError('XML parse Error !');
    Exit;
  end;
    
  baseName := LowerCase(XmlDoc.documentElement.baseName);
  if baseName = 'rss' then
    RssBase := GetRSSFeed(XmlDoc)
  else if baseName = 'rdf' then
    RssBase := GetRDFFeed(XmlDoc)
  else if baseName='feed' then
    RssBase := GetAtomFeed(XmlDoc)
  else
  begin
    GoError('It''s not a feed XML Document !');
    Exit;
  end;
  EdtFeedTitle.Text := RssBase.Title;
  ChannelAddToNode:=MainWindow.ChannelNode;
  Edit1.Text := ChannelAddToNode.Texts[0];
  Wizard.SelectNextPage;
end;

procedure TFmAddNewFeed.LoadRss;
begin
  if Trim(EdtFeedUrl.Text) = '' then
  begin
    HTMLMessage('Error','You have not type the Feed URL yet !',false);
    Exit;
  end;
  ProgressBar1.Visible := True;

  WinHTTP.URL := Trim(EdtFeedUrl.Text);
  WinHTTP.Read();
end;
//OPML
procedure TFmAddNewFeed.LoadOPML;
begin
  if JvFilenameEdit1.FileName = '' then
  begin
    HTMLMessage('Error','You have not type the OPML URL yet !',false);
    Exit;
  end;
  if FileExists(JvFilenameEdit1.FileName) then
  begin
    OPMLDoc.load(JvFilenameEdit1.FileName);
    Opml := Getopml(OPMLDoc);
    GetOpmlInfo;
  end
  else
  begin
    ProgressBar1.Visible := True;
    WinHTTPOpml.URL := Trim(JvFilenameEdit1.Text);
    WinHTTPOpml.Read();
  end;
end;

procedure TFmAddNewFeed.GetOpmlInfo;
  procedure AddToListView(aTitle,aFeedUrl,aDescription,aHTMLUrl:string);
  begin
    with OpmlListView.Items.Add do
      begin
        Checked := False;
        SubItems.Add(aTitle);
        SubItems.Add(aFeedUrl);
        SubItems.Add(aDescription);
        SubItems.Add(aHTMLUrl);
      end;    // with
  end;
  function IncludedStr(SrcStr,FindStr:string):Boolean;
  begin
    if FindStr='' then
    begin
      Result:=True; Exit;
    end;
    Result := Pos(LowerCase(FindStr),LowerCase(SrcStr)) > 0;
  end;
var
  i:Integer;
  STitle,SFeedUrl,SDescription,SHTMLUrl:string;
begin
  OpmlListView.Clear;
  for  i:= 0 to Opml.Body.Items.Count - 1 do    // Iterate
  begin
    STitle := '';
    SFeedUrl := '';
    SDescription := '';
    SHTMLUrl := '';
    STitle := Opml.Body.Items.Item[i].Title;
    SFeedUrl := Opml.Body.Items.Item[i].XmlUrl;
    SDescription := Opml.Body.Items.Item[i].Description ;
    
    if SDescription = '' then
      SDescription := STitle;
    SHTMLUrl := Opml.Body.Items.Item[i].HtmlUrl;
    
    case FilterBox.ItemIndex of    //
      0: begin
           if IncludedStr(STitle,EdtFilter.Text) or IncludedStr(SFeedUrl,EdtFilter.Text)
           or IncludedStr(SDescription,EdtFilter.Text) or IncludedStr(SHTMLUrl,EdtFilter.Text) then
             AddToListView(STitle,SFeedUrl,SDescription,SHTMLUrl);
         end;
      1: begin
           if includedStr(STitle,EdtFilter.Text) then
             AddToListView(STitle,SFeedUrl,SDescription,SHTMLUrl);
         end;
      2: begin
           if includedStr(SFeedUrl,EdtFilter.Text) then
             AddToListView(STitle,SFeedUrl,SDescription,SHTMLUrl);
         end;
      3: begin
           if includedStr(SDescription,EdtFilter.Text) then
             AddToListView(STitle,SFeedUrl,SDescription,SHTMLUrl);
         end;
      4: begin
           if includedStr(SHTMLUrl,EdtFilter.Text) then
             AddToListView(STitle,SFeedUrl,SDescription,SHTMLUrl);
         end;
    end;    // case

    //AddToListView(STitle,SFeedUrl,SDescription,SHTMLUrl);
  end;    // for
  Wizard.SelectNextPage;
end;

procedure TFmAddNewFeed.WinHTTPOpmlDone(Sender: TObject;
  const ContentType: String; FileSize: Integer; Stream: TStream);
var
  Stm:IStream;
begin
  stm := TStreamAdapter.Create(stream);
  OPMLDoc.load(Stm);
  if OPMLDoc.parseError.errorCode <> 0 then
    GoError('OPML Xml document parse error! (ErrorCode:'+IntToStr(OPMLDoc.parseError.errorCode)+')')
  else
  begin
    Opml := Getopml(OPMLDoc);
    GetOpmlInfo;
  end;
end;

procedure TFmAddNewFeed.OPMLSelBtnClick(Sender: TObject);
var i:Integer;
begin
  for  i := 0 to OPMLListView.Items.Count - 1 do    // Iterate
  begin
    case (Sender as TButton).Tag of
    //0:全选 ; 1: 不选 ; 2:反选
      0: OPMLListView.Items.Item[i].Checked := true;
      1: OPMLListView.Items.Item[i].Checked := false;
      2: OPMLListView.Items.Item[i].Checked := not OPMLListView.Items.Item[i].Checked;
    end;
  end;    // for
end;

procedure TFmAddNewFeed.OpmlListViewAdvancedCustomDrawItem(
  Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
begin
  case Item.Index mod 2 = 0 of    //
    true : Sender.Canvas.Brush.Color := clWhite;
    false: Sender.Canvas.Brush.Color := RGB(245,245,245);
  end;    // case
  if item.Checked then
    Sender.Canvas.Brush.Color := RGB(196,196,255);
end;

procedure TFmAddNewFeed.Page4BackButtonClick(Sender: TObject;
  var Stop: Boolean);
begin
  if WinHTTPOpml.Busy then
    WinHTTPOpml.Abort(True,true);
  Wizard.SelectFirstPage;
end;

procedure TFmAddNewFeed.Page1NextButtonClick(Sender: TObject;
  var Stop: Boolean);
begin
  Stop:=True;
  if RadioButton2.Checked then
    Wizard.ActivePageIndex := 3
  else
  begin
    Wizard.SelectNextPage;
  end;
end;

procedure TFmAddNewFeed.WizardActivePageChanged(Sender: TObject);
begin
  ProgressBar1.Visible := False;
  ProgressBar1.Position := 0;
  HtmLbSta.Caption := '';
end;

procedure TFmAddNewFeed.Page2NextButtonClick(Sender: TObject;
  var Stop: Boolean);
begin
  Stop:=True;
  LoadRss;
end;

procedure TFmAddNewFeed.Page4NextButtonClick(Sender: TObject;
  var Stop: Boolean);
begin
  Stop := True;
  LoadOPML;
end;

procedure TFmAddNewFeed.Page2BackButtonClick(Sender: TObject;
  var Stop: Boolean);
begin
  if WinHTTP.Busy then
    WinHTTP.Abort(True,true);
end;

procedure TFmAddNewFeed.Page3FinishButtonClick(Sender: TObject;
  var Stop: Boolean);
var New:TFeedItem;
  i:Integer;
begin
  stop := True;
  New:=MainWindow.AddFeed(ChannelAddToNode,EdtFeedTitle.Text,WinHTTP.URL,RssBase.Description,RssBase.Link,'');
  for i := 0 to RssBase.Items.Count - 1 do    // Iterate
  begin
    with New.Rss.Items.Add do
    begin
      Title       := RssBase.Items.Item[i].Title;
      Link        := RssBase.Items.Item[i].Link;
      PubDate     := RssBase.Items.Item[i].PubDate;
      Author      := RssBase.Items.Item[i].Author;
      Description := replaceUrl(Link,RssBase.Items.Item[i].Description);
      Category    := RssBase.Items.Item[i].Category;
      Guid        := RssBase.Items.Item[i].Guid;
      ReceivedDate:= TW3CDTF.CreateDateTime(Now);
      Readed      := False;
      Flag        := -1;
    end;
  end;    // for
  New.Rss.ExecItemChanged;
  Close;
end;

procedure TFmAddNewFeed.Page5FinishButtonClick(Sender: TObject;
  var Stop: Boolean);
var i,chkCount:Integer;
   desNode:TcxTreeListNode;
begin
  stop := True;
  chkCount:=0;
  desNode:=nil;
  if ExecChooseFolder2 then
  begin
    desNode:=FmChooseFolder.ResultNode;
    with OpmlListView.Items do
      for  i := 0 to Count - 1 do    // Iterate
      begin
        if Item[i].Checked then
        begin
          MainWindow.AddFeed( desNode ,
                              Item[i].SubItems.Strings[0],
                              Item[i].SubItems.Strings[1],
                              Item[i].SubItems.Strings[2],
                              Item[i].SubItems.Strings[3],''); 
          chkCount:=chkCount+1;
        end;
      end;
    if chkCount=0 then
    begin
      HTMLMessage('Information','You have not select any item !',false);
      Exit;
    end;
    Close;
  end;
end;

procedure TFmAddNewFeed.Button2Click(Sender: TObject);
begin
  GetOpmlInfo;
end;

procedure TFmAddNewFeed.BitBtn1Click(Sender: TObject);
begin
  if ExecChooseFolder2 then
  begin
    ChannelAddToNode:=FmChooseFolder.ResultNode;
    Edit1.Text := ChannelAddToNode.Texts[0];
  end;
end;

procedure TFmAddNewFeed.FormShow(Sender: TObject);
begin
    Clipboard.Open;
    EdtFeedUrl.Text := Clipboard.AsText;
    JvFilenameEdit1.Text := Clipboard.AsText;
    Clipboard.Close;
    if Pos('http://',EdtFeedUrl.Text)<=0 then
    begin
      JvFilenameEdit1.Text := '';
      EdtFeedUrl.Text:='';
    end;
end;

end.