浏览器

开发平台：
Visual Basic

AddMulRss.frm：源码内容
							VERSION 5.00
Begin VB.Form frmAddMulRss 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "批量添加RSS"
   ClientHeight    =   1155
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6120
   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     =   1155
   ScaleWidth      =   6120
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   360
      Left            =   5100
      TabIndex        =   3
      Top             =   660
      Width           =   900
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   360
      Left            =   4020
      TabIndex        =   2
      Top             =   660
      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            =   1020
      TabIndex        =   0
      Top             =   120
      Width           =   4935
   End
   Begin VB.Label Label1 
      Caption         =   "OPML 地址"
      Height          =   435
      Left            =   120
      TabIndex        =   1
      Top             =   180
      Width           =   915
   End
End
Attribute VB_Name = "frmAddMulRss"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : frmAddMulRss
' DateTime  : 2005-8-19 15:06
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Option Explicit
Private WithEvents m_XMLDoc As MSXML2.DOMDocument
Attribute m_XMLDoc.VB_VarHelpID = -1
Public IsCancel As Boolean
Private Sub cmdCancel_Click()
If Not m_XMLDoc Is Nothing Then
    m_XMLDoc.abort
End If
IsCancel = True
Me.Hide
End Sub
Private Sub cmdOk_Click()
cmdOk.Caption = "加载中..."
cmdOk.Enabled = False
Set m_XMLDoc = New MSXML2.DOMDocument
m_XMLDoc.Load txtUrl.Text
End Sub
Private Sub Form_Load()
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
    If AddOPML(m_XMLDoc) Then
        IsCancel = False
        Me.Hide
    Else
        MsgBox "error...", vbOKOnly Or vbInformation
        Call cmdCancel_Click
    End If
End If
End Sub
Private Function AddOPML(vXMLDoc As MSXML2.DOMDocument) As Boolean
'On Error Resume Next
Dim tTitle$
Dim tNode As MSXML2.IXMLDOMNode
Dim tNodes As MSXML2.IXMLDOMNodeList
Dim nodeAB As IXMLDOMAttribute
Dim i&
tTitle = Trim$(vXMLDoc.selectSingleNode("opml").selectSingleNode("head").selectSingleNode("title").Text)
Err.Clear
Set tNode = vXMLDoc.selectSingleNode("opml").selectSingleNode("body").selectSingleNode("outline")
If Err.Number <> 0 Then
    AddOPML = False
    Exit Function
End If
If Len(tTitle) = 0 Then
    Err.Clear
    Set nodeAB = tNode.Attributes.getNamedItem("title")
    If Err.Number = 0 Then
        tTitle = Trim$(nodeAB.Value)
    End If
End If
Set tNodes = tNode.selectNodes("outline")
Call AddEmptyGroup(tTitle)
With RssGroups(RssGCnt)
    .Count = tNodes.Length
    ReDim .Rssz(0 To .Count)
    
    For i = 1 To .Count
        Set nodeAB = Nothing
        Set nodeAB = tNodes.Item(i - 1).Attributes.getNamedItem("title")
        .Rssz(i).Title = nodeAB.Value
        
        Set nodeAB = Nothing
        Set nodeAB = tNodes.Item(i - 1).Attributes.getNamedItem("xmlUrl")
        .Rssz(i).Link = nodeAB.Value
    Next i
End With
Call SaveGroup(RssGCnt, True)
AddOPML = True
End Function

						