ufeed.pas

自己写的一个 RSS 阅读器

unit uFeed;

interface

uses SysUtils,uLocalRSS,Classes,MSXML2_TLB,uOpml,Dialogs,WinHTTP,ExtCtrls,
     uRssBase,uRSSFeed,uRDFFeed,uAtomFeed,uHTMLMessage,uW3CDTF,ComCtrls,cxtl;

type
  TFeed = class;
  TFeedItem = class;

  Tfeed = class(TComponent)
  private
    fItems:TList;
  protected
    function Get_Item(index : integer): TFeedItem;
    function Get_Count(): integer;
    procedure Add(item : TObject);overload;

  public
	  constructor Create(AOnwer:TComponent);
    Destructor Destroy; override;
    function Add(otl:TOutlineType):TFeedItem;overload;
    procedure Delete(Index:integer);overload;
    procedure Delete(FeedItem:TFeedItem);overload;
    property Item[Index: Integer]: TFeedItem read Get_Item;
    property Count :Integer read Get_Count;
    procedure Save;

  end;

  TOnHttpDone      = procedure(Sender: TObject; const ContentType: string;FileSize: Integer;
                                Stream: TStream)of object;
  TOnHttpProgress  = Procedure(Sender: TObject; const ContentType: string;
                                FileSize, BytesRead,PercentsDone: integer)of object;
  TOnError      = procedure(Sender: TObject; ErrorStr: string) of object;

  TOnTimeOut    = procedure(Sender: TObject; var TerminateThread: Boolean)of object;

  TOnNewItem    = procedure(Sender: TObject;Item:TLocalRssItem)of object;

  TFeedItem = class(TComponent)
  private
    fFeed:TLocalRssFeed;
    fTreeNode:TcxTreeListNode;
    foutline:TOutlineType;
    TmpDoc:IXMLDOMDocument2;
    TmpFeed:IRSSBase;

    Timer:TTimer;
    TimerIcon:TTimer;
    WinHTTP: TWinHTTP;
    FOnHttpDone:TOnHttpDone;
    FOnHttpProgress:TOnHttpProgress;
    FOnError:TOnError;
    FOnNewItem:TOnNewItem;
    FInterval:Integer;

    FErrorLog:TStringList;
    FHaveError:Boolean;
    FRefreshing:Boolean;
    procedure HttpDone(Sender: TObject; const ContentType: string; FileSize: Integer;
                      Stream: TStream);
    Procedure HttpProgress(Sender: TObject; const ContentType: string;
                           FileSize, BytesRead, ElapsedTime, EstimatedTimeLeft: Integer;
                           PercentsDone: Byte; TransferRate: Single; Stream: TStream);
    procedure HTTPError(Sender: TObject; ErrorCode: Integer; Stream: TStream);
    procedure Timeout(Sender: TObject; var TerminateThread: Boolean);
    
    procedure GoToError(Sender: TObject; ErrorStr: string);
    procedure Set_TreeNode(Value:TcxTreeListNode);
    function Get_Index:integer;
    procedure ExecTimer(Sender:TObject);
    procedure ExecTimerIcon(Sender:TObject);
  public
    constructor Create(AOnwer:TComponent;outline:TOutlineType);
    Destructor Destroy; override;
    procedure StartUpdate;
    property Rss:TLocalRssFeed read fFeed write fFeed;
    property Outline:TOutlineType read foutline write foutline;
    property TreeNode:TcxTreeListNode read fTreeNode write Set_TreeNode;

    property Index :Integer read Get_Index;

    property OnHttpDone:TOnHttpDone read FOnHttpDone write FOnHttpDone;
    property OnHttpProgress:TOnHttpProgress read FOnHttpProgress write FOnHttpProgress;
    property OnError:TOnError read FOnError write FOnError;
    property OnNewItem:TOnNewItem read FOnNewItem write FOnNewItem;

    procedure SetTimerInterval(Value:integer);
    property ErrorLog:TStringList read FErrorLog write FErrorLog;
    property HaveError:Boolean read FHaveError;
    property Refreshing:Boolean read FRefreshing;
    procedure Stop;
  end;

implementation

uses MProperties,ActiveX,uConstants,FastStrings,RegExpr,uMain;

constructor TFeed.Create(AOnwer:TComponent);
var i:Integer;
begin
  inherited Create(AOnwer);
  fItems:=TList.Create;
end;
Destructor TFeed.Destroy;
begin
  fItems.Free;
  inherited destroy;
end;
procedure TFeed.Save;
var i:Integer;
begin
  for  i:= 0 to Count - 1 do    // Iterate
  begin
    if Item[i].Outline.Type_<>'folder' then
      Item[i].Rss.SaveXml(gProperties.ChannelDir + Item[i].Outline.FileName);
  end;
end;
procedure TFeed.Add(item:TObject);
begin
    fItems.Add(item);
end;

function TFeed.Add(otl:TOutlineType):TFeedItem;
var item:TFeedItem;
begin
  item:=TFeedItem.Create(Self,otl);
  fItems.Add(item);
  Result:=item;
end;

procedure TFeed.Delete(index:integer);
var theFileName:string;
  outline:TOutlineType;
  node:IXMLDOMNode;
begin
  theFileName := gProperties.ChannelDir+TFeedItem(fItems.Items[Index]).Outline.FileName;
  if FileExists(theFileName) then
    DeleteFile(theFileName);
  node:=TFeedItem(fItems.Items[Index]).Outline.Node ;
  node.parentNode.removeChild(node);
  fItems.Delete(Index);
end;
procedure TFeed.Delete(FeedItem:TFeedItem);
var i:Integer;
begin
  for  i:= 0 to fItems.Count - 1 do    // Iterate
  begin
    if TFeedItem(fItems.Items[i]) = FeedItem then
    begin
      Delete(i);
      Break;
    end;
  end;    // for
end;

function TFeed.Get_Item(Index:integer):TFeedItem;
begin
  Result:= TFeedItem(fItems[index]);
end;
function TFeed.Get_Count:Integer;
begin
  Result:=fItems.Count;
end;




{TFeedItem}
constructor TFeedItem.Create(AOnwer:TComponent;outline:TOutlineType);
var
  doc:IXMLDOMDocument2;
begin
  inherited Create(AOnwer);
  FRefreshing := False;
  FErrorLog:=TStringList.Create;
  FErrorLog.Clear;
  foutline:=outline;
  FHaveError :=False;
  if (foutline.Type_='folder') then
  begin
    WinHTTP := nil;
    fFeed := nil;
    Timer := nil;
    TimerIcon := nil;
  end
  else
  begin
    doc:=CoDOMDocument.Create;
    TmpDoc:=CoDOMDocument.Create;

    if not FileExists(gProperties.ChannelDir + foutline.FileName) then
      CreateEmptyRssXml(gProperties.ChannelDir,foutline.FileName);  //本地rss文件不存在时,创建空白的

    doc.load(gProperties.ChannelDir + foutline.FileName);
    if doc.parseError.errorCode<>0 then
    begin
      CreateEmptyRssXml(gProperties.ChannelDir,foutline.FileName);  //本地rss文件解析出错时,创建空白的
      doc.load(gProperties.ChannelDir + foutline.FileName);
    end;


    fFeed := TLocalRssFeed.Create(self,Doc);

    WinHTTP:=TWinHTTP.Create(self);
    WinHTTP.OnDone:=HttpDone;
    WinHTTP.OnHTTPError:=HTTPError;
    WinHTTP.OnProgress:=HttpProgress;
    WinHTTP.OnWaitTimeoutExpired := Timeout;
    WinHTTP.Agent := gProperties.UserAgent;
    WinHTTP.Timeouts.ReceiveTimeout := 10000;
    WinHTTP.Timeouts.SendTimeout := 10000;
    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;
    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;
    end;

    Timer := TTimer.Create(nil);

    FInterval := foutline.RefreshInterval;
    if FInterval<0 then
       Timer.Enabled := False
    else
    begin
      if FInterval=0 then
        Timer.Interval := gProperties.DefauleRefreshInterval * 60000
      else
        Timer.Interval := FInterval * 60000;
      Timer.OnTimer := ExecTimer;
      Timer.Enabled := True;
    end;

    TimerIcon := TTimer.Create(nil);
    TimerIcon.Interval :=250;
    TimerIcon.Enabled := False;
    TimerIcon.OnTimer := ExecTimerIcon; 
  end;
end;

Destructor TFeedItem.Destroy;
begin
  Timer.Free;
  WinHTTP.Free;
  FErrorLog.Free;
  fFeed.Free;
  foutline.Free;
  inherited destroy;
end;

procedure TFeedItem.StartUpdate;
begin
  Timer.Enabled:=False;
  FRefreshing := True;
  FOnHttpProgress(WinHTTP, '', 0, 0,0);
  WinHTTP.URL:=fOutline.XmlUrl;
  WinHTTP.Read;
  Self.TreeNode.ImageIndex := 9;
  TimerIcon.Enabled :=True;
end;

procedure TFeedItem.Stop;
begin
  WinHTTP.Abort(False,True);
  FRefreshing := False;
  TimerIcon.Enabled := False;
  fTreeNode.ImageIndex := 2;
  fTreeNode.SelectedIndex := 2;
end;


procedure TFeedItem.SetTimerInterval(Value:integer);
begin
  Timer.Enabled := False;
  FInterval := Value;
  Timer.Interval := Value * 60000;
  if Value<0 then
    Timer.Enabled := False
  else
    Timer.Enabled := True;
end;

procedure TFeedItem.ExecTimer(Sender:TObject);
begin
  Self.OnHttpDone:=MainWindow.Event_UpdateDone;
  Self.OnHttpProgress := MainWindow.Event_UpdateProgress;
  Self.OnError := MainWindow.Event_Error;
  Self.StartUpdate;
end;

procedure TFeedItem.ExecTimerIcon(Sender:TObject);
begin
  if Self.TreeNode.ImageIndex = 18 then
    Self.TreeNode.ImageIndex := 9
  else
    Self.TreeNode.ImageIndex := Self.TreeNode.ImageIndex + 1;
  Self.TreeNode.SelectedIndex := Self.TreeNode.ImageIndex;
end;

procedure TFeedItem.HttpDone(Sender: TObject; const ContentType: string; FileSize: Integer; Stream: TStream);
var
  Stm:IStream;
  baseName:string;
  i,NewCount:Integer;
  r:TRegExpr;
  URLPath:string;
  NewItem:TLocalRssItem;
begin
  FRefreshing := False;
  stm := TStreamAdapter.Create(stream);
  TmpDoc.load(Stm);
  if TmpDoc.parseError.errorCode<>0 then
  begin
    GoToError(Sender,'XML parse Error:'+IntToStr(TmpDoc.parseError.errorCode));
    FOnHttpDone(Sender,ContentType,FileSize,Stream);
    Exit;
  end;
    
  baseName:=LowerCase(TmpDoc.documentElement.baseName);
  if baseName = 'rss' then
    TmpFeed := GetRSSFeed(TmpDoc)
  else if baseName = 'rdf' then
    TmpFeed := GetRDFFeed(TmpDoc)
  else if baseName = 'feed' then
    TmpFeed:=GetAtomFeed(TmpDoc)
  else
  begin
    GoToError(Sender,'Unknow feed type');
    FOnHttpDone(Sender,ContentType,FileSize,Stream);
    Exit;
  end;

  fFeed.Title:= TmpFeed.Title;
  fFeed.Link:=TmpFeed.Link;
  fFeed.Description:=TmpFeed.Description;
  fFeed.Creator:=TmpFeed.Creator;

  fFeed.LastUpdate:=TW3CDTF.Create(DateTimeToStr(Now));
  NewCount := 0;
  for i := 0 to TmpFeed.Items.Count - 1 do    // Iterate
  begin
    if (fFeed.Items.IndexOfTitle(TmpFeed.Items.Item[i].Title)<0) and (TmpFeed.Items.Item[i].Title<>'') then
    begin
      NewItem := fFeed.Items.Add;
      with NewItem do
      begin
        Title       := TmpFeed.Items.Item[i].Title;
        Link        := TmpFeed.Items.Item[i].Link;
        PubDate     := TmpFeed.Items.Item[i].PubDate;
        Author      := TmpFeed.Items.Item[i].Author;
        Description := replaceUrl(Link,TmpFeed.Items.Item[i].Description);
        Category    := TmpFeed.Items.Item[i].Category;
        Guid        := TmpFeed.Items.Item[i].Guid;
        ReceivedDate:= TW3CDTF.CreateDateTime(Now);
        Readed      := False;
        Flag        := -1;
      end;
      FOnNewItem(Self,NewItem);
      Inc(NewCount);
    end;
  end;    // for
  if (NewCount>0) and (gProperties.ShowDesktopAlter)then
    MainWindow.Event_ShowDesktopAlert(Self.TreeNode,fFeed.Title + ' received ' + IntToStr(NewCount) + ' item(s)');

  FOnHttpDone(Sender,ContentType,FileSize,Stream);
  fFeed.ExecItemChanged;
  if FInterval>=0 then
    Timer.Enabled:=True;
  TimerIcon.Enabled :=False;
end;

Procedure TFeedItem.HttpProgress(Sender: TObject; const ContentType: string;
                           FileSize, BytesRead, ElapsedTime, EstimatedTimeLeft: Integer;
                           PercentsDone: Byte; TransferRate: Single; Stream: TStream);
begin
  FOnHttpProgress(Sender,ContentType,FileSize,BytesRead,PercentsDone);
end;
procedure TFeedItem.Timeout(Sender: TObject; var TerminateThread: Boolean);
begin
  GoToError(Sender , 'Error : Timeout');
end;


procedure TFeedItem.HTTPError(Sender: TObject; ErrorCode: Integer; Stream: TStream);
begin
  GoToError(Sender,'Http error : '+IntToStr(ErrorCode));
end;

procedure TFeedItem.GoToError(Sender: TObject; ErrorStr: string);
begin
  Self.ErrorLog.Add(#13#10+DateTimeToStr(Now)+#13#10+ErrorStr);
  FHaveError := True;
  FRefreshing := False;
  WinHTTP.Abort(False,True);
  TimerIcon.Enabled := False;
  FOnError(Sender,ErrorStr);
end;

procedure TFeedItem.Set_TreeNode(Value:TcxTreeListNode);
begin
  fTreeNode:=Value;
  if foutline.Type_<>'folder' then
  begin
     fTreeNode.ImageIndex := 2;
     fTreeNode.SelectedIndex := 2;
  end;
end;

function TFeedItem.Get_Index:Integer;
var i:Integer;
begin
  for  i:= 0 to TFeed(Self.Owner).fItems.Count - 1 do    // Iterate
  begin
    if TFeedItem(TFeed(Self.Owner).fItems.Items[i])=Self then
    begin
       Result := i;
       Break;
    end;
  end;    // for
end;

end.