浏览器

开发平台：
Visual Basic

AddRss.frm：源码内容
							VERSION 5.00
Begin VB.Form frmAddRss 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "添加RSS"
   ClientHeight    =   1920
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5535
   ControlBox      =   0   'False
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1920
   ScaleWidth      =   5535
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdNewGroup 
      Caption         =   "新建组"
      Height          =   360
      Left            =   4560
      TabIndex        =   7
      Top             =   1020
      Width           =   900
   End
   Begin VB.ComboBox cmbGroup 
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   720
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   1020
      Width           =   3795
   End
   Begin VB.CommandButton cmdGetTitle 
      Caption         =   "自动获取"
      Height          =   360
      Left            =   4560
      TabIndex        =   1
      Top             =   120
      Width           =   900
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   360
      Left            =   4560
      TabIndex        =   9
      Top             =   1500
      Width           =   900
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   360
      Left            =   3600
      TabIndex        =   8
      Top             =   1500
      Width           =   900
   End
   Begin VB.TextBox txtUrl 
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   720
      TabIndex        =   3
      Top             =   540
      Width           =   4755
   End
   Begin VB.TextBox txtTitle 
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   720
      TabIndex        =   0
      Top             =   120
      Width           =   3795
   End
   Begin VB.Label Label3 
      Caption         =   "组"
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   180
      TabIndex        =   6
      Top             =   1080
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "地址"
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   60
      TabIndex        =   4
      Top             =   600
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "标题"
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   60
      TabIndex        =   2
      Top             =   180
      Width           =   1035
   End
End
Attribute VB_Name = "frmAddRss"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : frmAddRss
' DateTime  : 2005-8-19 15:06
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Option Explicit
Public RssTitle$
Public RssUrl$
Private m_lRssGroupIndex As Long
Public IsCancel As Boolean
Private WithEvents m_XMLDoc As MSXML2.DOMDocument
Attribute m_XMLDoc.VB_VarHelpID = -1
Private m_LoadingTitle As Boolean
Private Sub cmdCancel_Click()
IsCancel = True
Me.Hide
End Sub
Private Sub cmdGetTitle_Click()
If m_LoadingTitle Then
    m_XMLDoc.abort
    cmdGetTitle.Caption = "自动获取"
    txtTitle.Text = ""
    txtTitle.Enabled = True
    
    m_LoadingTitle = False
Else
    cmdGetTitle.Caption = "取消"
    txtTitle.Enabled = False
    txtTitle.Text = "获取中..."
    
    Set m_XMLDoc = New MSXML2.DOMDocument
    m_XMLDoc.Load txtUrl.Text
    
    m_LoadingTitle = True
End If
End Sub
Private Sub cmdNewGroup_Click()
Dim tStr$
tStr = Trim$(InputBox("请输入组名称:", "新建组", "新建组"))
If LenB(tStr) > 0 Then
    AddEmptyGroup tStr
    Call LoadGroups
    Call SaveGroup(RssGCnt, True)
    Me.RssGroupIndex = RssGCnt
End If
End Sub
Private Sub cmdOk_Click()
If SetRss Then
    IsCancel = False
    Me.Hide
Else
    MsgBox "标题或地址不能为空", vbInformation Or vbOKOnly
End If
End Sub
Private Function SetRss() As Boolean
RssTitle = Trim(txtTitle.Text)
RssUrl = Trim(txtUrl.Text)
m_lRssGroupIndex = cmbGroup.ListIndex + 1
SetRss = ((Len(RssTitle) > 0) And (Len(RssUrl) > 0) And Not m_LoadingTitle)
End Function
Private Sub Form_Initialize()
m_LoadingTitle = False
End Sub
Private Sub Form_Load()
Call LoadGroups
If Clipboard.GetFormat(vbCFText) Then
    txtUrl.Text = Clipboard.GetText()
End If
End Sub
Private Sub m_XmlDoc_onreadystatechange()
On Error Resume Next
If m_XMLDoc.readyState = 4 Then
    Err.Clear
    txtTitle.Text = m_XMLDoc.selectSingleNode("rss").selectSingleNode("channel").selectSingleNode("title").Text
    If Err.Number <> 0 Then
        txtTitle.Text = ""
    End If
    
    cmdGetTitle.Caption = "自动获取"
    txtTitle.Enabled = True
    
    m_LoadingTitle = False
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadGroups
' DateTime  : 2005-6-13 21:26
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Private Sub LoadGroups()
Dim i&
cmbGroup.Clear
For i = 1 To RssGCnt
    cmbGroup.AddItem RssGroups(i).Title
Next i
End Sub
'---------------------------------------------------------------------------------------
' Procedure : RssGroupIndex
' DateTime  : 2005-6-13 21:28
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Public Property Get RssGroupIndex() As Long
    RssGroupIndex = m_lRssGroupIndex
End Property
'---------------------------------------------------------------------------------------
' Procedure : RssGroupIndex
' DateTime  : 2005-6-13 21:28
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Public Property Let RssGroupIndex(ByVal lRssGroupIndex As Long)
On Error Resume Next
    m_lRssGroupIndex = lRssGroupIndex
    Err.Clear
    cmbGroup.ListIndex = m_lRssGroupIndex - 1
    If Err.Number <> 0 Then
        cmbGroup.ListIndex = 0
    End If
End Property

						