home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / ExtremeRSS19413910182005.psc / ExtremeRSS / frmMain.frm < prev    next >
Text File  |  2005-08-22  |  29KB  |  898 lines

  1. VERSION 5.00
  2. Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Object = "{38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0"; "COMCT332.OCX"
  5. Begin VB.Form frmMain 
  6.    BorderStyle     =   1  'Fixed Single
  7.    Caption         =   "Extreme RSS"
  8.    ClientHeight    =   9000
  9.    ClientLeft      =   2415
  10.    ClientTop       =   735
  11.    ClientWidth     =   12000
  12.    BeginProperty Font 
  13.       Name            =   "Verdana"
  14.       Size            =   8.25
  15.       Charset         =   0
  16.       Weight          =   400
  17.       Underline       =   0   'False
  18.       Italic          =   0   'False
  19.       Strikethrough   =   0   'False
  20.    EndProperty
  21.    Icon            =   "frmMain.frx":0000
  22.    LinkTopic       =   "Form1"
  23.    MaxButton       =   0   'False
  24.    ScaleHeight     =   9000
  25.    ScaleWidth      =   12000
  26.    StartUpPosition =   2  'CenterScreen
  27.    Begin VB.ComboBox cboCategory 
  28.       Height          =   315
  29.       Left            =   80
  30.       TabIndex        =   1
  31.       Text            =   "C:\RSS"
  32.       Top             =   1065
  33.       Width           =   3975
  34.    End
  35.    Begin MSComctlLib.ImageList ImgList 
  36.       Left            =   4560
  37.       Top             =   7800
  38.       _ExtentX        =   1005
  39.       _ExtentY        =   1005
  40.       BackColor       =   -2147483643
  41.       ImageWidth      =   16
  42.       ImageHeight     =   16
  43.       MaskColor       =   12632256
  44.       _Version        =   393216
  45.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  46.          NumListImages   =   9
  47.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  48.             Picture         =   "frmMain.frx":09EA
  49.             Key             =   ""
  50.          EndProperty
  51.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  52.             Picture         =   "frmMain.frx":0F84
  53.             Key             =   ""
  54.          EndProperty
  55.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  56.             Picture         =   "frmMain.frx":131E
  57.             Key             =   ""
  58.          EndProperty
  59.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  60.             Picture         =   "frmMain.frx":16B8
  61.             Key             =   ""
  62.          EndProperty
  63.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  64.             Picture         =   "frmMain.frx":1A52
  65.             Key             =   ""
  66.          EndProperty
  67.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  68.             Picture         =   "frmMain.frx":1DEC
  69.             Key             =   ""
  70.          EndProperty
  71.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  72.             Picture         =   "frmMain.frx":2186
  73.             Key             =   ""
  74.          EndProperty
  75.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  76.             Picture         =   "frmMain.frx":2520
  77.             Key             =   ""
  78.          EndProperty
  79.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  80.             Picture         =   "frmMain.frx":2ABA
  81.             Key             =   ""
  82.          EndProperty
  83.       EndProperty
  84.    End
  85.    Begin SHDocVwCtl.WebBrowser webFeeds 
  86.       Height          =   7320
  87.       Left            =   4100
  88.       TabIndex        =   4
  89.       Top             =   1065
  90.       Width           =   7835
  91.       ExtentX         =   13820
  92.       ExtentY         =   12912
  93.       ViewMode        =   0
  94.       Offline         =   0
  95.       Silent          =   0
  96.       RegisterAsBrowser=   0
  97.       RegisterAsDropTarget=   1
  98.       AutoArrange     =   0   'False
  99.       NoClientEdge    =   0   'False
  100.       AlignLeft       =   0   'False
  101.       NoWebView       =   0   'False
  102.       HideFileNames   =   0   'False
  103.       SingleClick     =   0   'False
  104.       SingleSelection =   0   'False
  105.       NoFolders       =   0   'False
  106.       Transparent     =   0   'False
  107.       ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
  108.       Location        =   ""
  109.    End
  110.    Begin VB.ListBox lstHeadlines 
  111.       Height          =   4155
  112.       Left            =   80
  113.       TabIndex        =   3
  114.       Top             =   4530
  115.       Width           =   3975
  116.    End
  117.    Begin MSComctlLib.StatusBar StatusBar 
  118.       Align           =   2  'Align Bottom
  119.       Height          =   300
  120.       Left            =   0
  121.       TabIndex        =   7
  122.       Top             =   8700
  123.       Width           =   12000
  124.       _ExtentX        =   21167
  125.       _ExtentY        =   529
  126.       _Version        =   393216
  127.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  128.          NumPanels       =   3
  129.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  130.             Style           =   6
  131.             Alignment       =   1
  132.             AutoSize        =   2
  133.             Object.Width           =   1958
  134.             MinWidth        =   1411
  135.             TextSave        =   "22/08/2005"
  136.          EndProperty
  137.          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  138.             Object.Width           =   4410
  139.             MinWidth        =   4410
  140.          EndProperty
  141.          BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  142.             AutoSize        =   1
  143.             Object.Width           =   14684
  144.          EndProperty
  145.       EndProperty
  146.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  147.          Name            =   "Verdana"
  148.          Size            =   8.25
  149.          Charset         =   0
  150.          Weight          =   400
  151.          Underline       =   0   'False
  152.          Italic          =   0   'False
  153.          Strikethrough   =   0   'False
  154.       EndProperty
  155.    End
  156.    Begin VB.FileListBox fileFeeds 
  157.       Height          =   2625
  158.       Left            =   80
  159.       TabIndex        =   2
  160.       Top             =   1620
  161.       Width           =   3975
  162.    End
  163.    Begin ComCtl3.CoolBar CoolBar2 
  164.       Align           =   1  'Align Top
  165.       Height          =   420
  166.       Left            =   0
  167.       TabIndex        =   6
  168.       Top             =   390
  169.       Width           =   12000
  170.       _ExtentX        =   21167
  171.       _ExtentY        =   741
  172.       BandCount       =   2
  173.       FixedOrder      =   -1  'True
  174.       _CBWidth        =   12000
  175.       _CBHeight       =   420
  176.       _Version        =   "6.7.9782"
  177.       Caption1        =   "Address"
  178.       Child1          =   "cboAddress"
  179.       MinHeight1      =   360
  180.       Width1          =   1095
  181.       NewRow1         =   0   'False
  182.       Child2          =   "ToolBar2"
  183.       MinHeight2      =   330
  184.       NewRow2         =   0   'False
  185.       BandStyle2      =   1
  186.       Begin VB.ComboBox cboAddress 
  187.          BeginProperty Font 
  188.             Name            =   "Verdana"
  189.             Size            =   9.75
  190.             Charset         =   0
  191.             Weight          =   400
  192.             Underline       =   0   'False
  193.             Italic          =   0   'False
  194.             Strikethrough   =   0   'False
  195.          EndProperty
  196.          Height          =   360
  197.          Left            =   735
  198.          TabIndex        =   0
  199.          Top             =   30
  200.          Width           =   11145
  201.       End
  202.       Begin MSComctlLib.Toolbar ToolBar2 
  203.          Height          =   330
  204.          Left            =   11970
  205.          TabIndex        =   9
  206.          Top             =   45
  207.          Width           =   30
  208.          _ExtentX        =   53
  209.          _ExtentY        =   582
  210.          ButtonWidth     =   1138
  211.          ButtonHeight    =   582
  212.          Style           =   1
  213.          TextAlignment   =   1
  214.          ImageList       =   "ImgList"
  215.          _Version        =   393216
  216.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  217.             NumButtons      =   1
  218.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  219.                Caption         =   "Go"
  220.                Key             =   "Go"
  221.                Object.ToolTipText     =   "Go to RSS feed"
  222.                ImageIndex      =   1
  223.             EndProperty
  224.          EndProperty
  225.       End
  226.    End
  227.    Begin ComCtl3.CoolBar CoolBar1 
  228.       Align           =   1  'Align Top
  229.       Height          =   390
  230.       Left            =   0
  231.       TabIndex        =   5
  232.       Top             =   0
  233.       Width           =   12000
  234.       _ExtentX        =   21167
  235.       _ExtentY        =   688
  236.       BandCount       =   1
  237.       _CBWidth        =   12000
  238.       _CBHeight       =   390
  239.       _Version        =   "6.7.9782"
  240.       Child1          =   "ToolBar1"
  241.       MinHeight1      =   330
  242.       Width1          =   3975
  243.       NewRow1         =   0   'False
  244.       Begin MSComctlLib.Toolbar ToolBar1 
  245.          Height          =   330
  246.          Left            =   30
  247.          TabIndex        =   8
  248.          Top             =   30
  249.          Width           =   11880
  250.          _ExtentX        =   20955
  251.          _ExtentY        =   582
  252.          ButtonWidth     =   609
  253.          ButtonHeight    =   582
  254.          Style           =   1
  255.          ImageList       =   "ImgList"
  256.          _Version        =   393216
  257.          BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  258.             NumButtons      =   9
  259.             BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  260.                Key             =   "Save"
  261.                Object.ToolTipText     =   "Save feed"
  262.                ImageIndex      =   6
  263.             EndProperty
  264.             BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  265.                Key             =   "Rename"
  266.                Object.ToolTipText     =   "Rename feed"
  267.                ImageIndex      =   7
  268.             EndProperty
  269.             BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  270.                Key             =   "Delete"
  271.                ImageIndex      =   8
  272.             EndProperty
  273.             BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  274.                Key             =   "Open"
  275.                Object.ToolTipText     =   "Open feed"
  276.                ImageIndex      =   9
  277.             EndProperty
  278.             BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  279.                Key             =   "Create"
  280.                Object.ToolTipText     =   "Create new folder"
  281.                ImageIndex      =   2
  282.             EndProperty
  283.             BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  284.                Key             =   "DeleteFolder"
  285.                Object.ToolTipText     =   "Delete folder"
  286.                ImageIndex      =   3
  287.             EndProperty
  288.             BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  289.                Style           =   3
  290.             EndProperty
  291.             BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  292.                Key             =   "Exit"
  293.                Object.ToolTipText     =   "Exit Extreme RSS"
  294.                ImageIndex      =   4
  295.             EndProperty
  296.             BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  297.                Key             =   "About"
  298.                Object.ToolTipText     =   "About Extreme RSS"
  299.                ImageIndex      =   5
  300.             EndProperty
  301.          EndProperty
  302.       End
  303.    End
  304.    Begin VB.Label lblDefault 
  305.       AutoSize        =   -1  'True
  306.       Caption         =   "To open this feed in your default browser, click here."
  307.       Height          =   195
  308.       Left            =   7020
  309.       TabIndex        =   14
  310.       Top             =   8460
  311.       Width           =   4545
  312.    End
  313.    Begin VB.Image ImgURL 
  314.       Height          =   240
  315.       Left            =   11640
  316.       Picture         =   "frmMain.frx":2E54
  317.       Top             =   8445
  318.       Width           =   240
  319.    End
  320.    Begin VB.Label lblSubscribed 
  321.       Caption         =   "Subscribed Feeds"
  322.       Height          =   255
  323.       Left            =   80
  324.       TabIndex        =   13
  325.       Top             =   1410
  326.       Width           =   2055
  327.    End
  328.    Begin VB.Label lblCategory 
  329.       Caption         =   "Category(s)"
  330.       Height          =   195
  331.       Left            =   80
  332.       TabIndex        =   12
  333.       Top             =   855
  334.       Width           =   1305
  335.    End
  336.    Begin VB.Label lblDescription 
  337.       Caption         =   "Description"
  338.       Height          =   255
  339.       Left            =   4110
  340.       TabIndex        =   11
  341.       Top             =   855
  342.       Width           =   945
  343.    End
  344.    Begin VB.Label lblHeadlines 
  345.       Caption         =   "Feed headlines"
  346.       Height          =   165
  347.       Left            =   80
  348.       TabIndex        =   10
  349.       Top             =   4320
  350.       Width           =   1935
  351.    End
  352.    Begin VB.Menu File 
  353.       Caption         =   "&File"
  354.       Begin VB.Menu Close 
  355.          Caption         =   "&Close"
  356.       End
  357.    End
  358.    Begin VB.Menu Help 
  359.       Caption         =   "&Help"
  360.       Begin VB.Menu About 
  361.          Caption         =   "&About"
  362.       End
  363.    End
  364. End
  365. Attribute VB_Name = "frmMain"
  366. Attribute VB_GlobalNameSpace = False
  367. Attribute VB_Creatable = False
  368. Attribute VB_PredeclaredId = True
  369. Attribute VB_Exposed = False
  370. Option Explicit
  371. Dim oRSS As MSXML2.DOMDocument
  372. Dim oItemList() As MSXML2.IXMLDOMNode
  373.  
  374. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  375.  
  376. Dim strURL As String
  377. Dim strFeed As String
  378. Dim strPubDate As String
  379. Dim strHeadlines As String
  380. Dim FeedURL As String
  381.  
  382. ' Global FileSystemObject settings
  383. Dim FSys As New FileSystemObject
  384. Dim FSysFile As Object
  385. Dim FSysFolder As Object
  386.  
  387. Private WithEvents m_frmSysTray As frmSysTray
  388. Attribute m_frmSysTray.VB_VarHelpID = -1
  389.  
  390. Private Sub Form_Load()
  391.     
  392.     ' Set the caption for the form.
  393.     Me.Caption = "Extreme RSS v" & App.Major & "." & App.Minor & "." & _
  394.                  App.Revision
  395.                  
  396.     ' Set a few bits up.
  397.     CoolBar2.Bands(2).MinWidth = 700
  398.     StatusBar.Panels(1).Width = 100
  399.     fileFeeds.Pattern = "*"
  400.     cboCategory.AddItem "C:\RSS"
  401.     
  402.     ' Check the HTML directory is there.
  403.     Call CheckHTML
  404.     ' Call SystemTray to enable system tray goodness.
  405.     Call SystemTray
  406.     ' Write the HTML file incase it has been deleted.
  407.     Call WriteHTML
  408.     ' Write the HTML file incase it has been delete.
  409.     Call WriteFeeds
  410.     ' Get the directory where all the saved feeds will be stored.
  411.     Call GetDirectory
  412.     ' Now populate the Category Combo with the sub directories in C:\RSS
  413.     Call FillCategory
  414.     
  415.     ' Now navigate to the default HTML page.
  416.     webFeeds.Navigate App.Path & "\HTML\ExtremeRSS.html"
  417.     
  418. End Sub
  419.  
  420. Private Function GetRSS()
  421.     
  422.     ' This just makes sure everything is nice and clean.
  423.     lstHeadlines.Clear
  424.     webFeeds.Navigate "about:blank"
  425.     strHeadlines = ""
  426.     strURL = ""
  427.     strFeed = ""
  428.     strPubDate = ""
  429.     DoEvents
  430.     
  431.     ' Disbale fileFeeds and let the user know we are getting the feeds.
  432.     fileFeeds.Enabled = False
  433.     StatusBar.Panels(2).Text = "Please wait getting feeds..."
  434.     DoEvents
  435.     
  436.     Dim oItems As MSXML2.IXMLDOMNodeList
  437.     Dim i As Integer
  438.     Dim oNode As IXMLDOMNode
  439.     
  440.     Set oRSS = New MSXML2.DOMDocument
  441.     oRSS.async = False
  442.     oRSS.Load (cboAddress.Text)
  443.     
  444.     Set oItems = oRSS.selectNodes("rss/channel/item")
  445.  
  446.     i = -1
  447.     
  448.     ReDim oItemList(oItems.length)
  449.     
  450.     For Each oNode In oItems
  451.         i = i + 1
  452.         lstHeadlines.AddItem oNode.selectSingleNode("title").Text
  453.         Set oItemList(i) = oNode
  454.     Next oNode
  455.     
  456.     ' Let the user know we are done.
  457.     fileFeeds.Enabled = True
  458.     StatusBar.Panels(2).Text = "Retrieved " & lstHeadlines.ListCount & " feeds."
  459.     DoEvents
  460.     
  461.     ' Display a ballon tip! :)
  462.     m_frmSysTray.ShowBalloonTip _
  463.     "Retrieved " & lstHeadlines.ListCount & " feeds.", _
  464.     "Extreme RSS", _
  465.     NIIF_INFO
  466.  
  467. End Function
  468.  
  469. Private Function GetHeadlines()
  470.  
  471.     Dim oNode As MSXML2.IXMLDOMNode
  472.     Set oNode = oItemList(lstHeadlines.ListIndex)
  473.  
  474.         strHeadlines = oNode.selectSingleNode("title").Text
  475.         strURL = oNode.selectSingleNode("link").Text
  476.         strFeed = oNode.selectSingleNode("description").Text
  477.     
  478.     
  479.     Dim oTestNode As MSXML2.IXMLDOMNode
  480.     Set oTestNode = oNode.selectSingleNode("pubDate|dc:date")
  481.     If oTestNode Is Nothing Then
  482.     
  483.         ' If the Node does not exist we simply display No Information.
  484.         strPubDate = "No Information"
  485.         
  486.     Else
  487.     
  488.         ' Next statement finds the first node matching any of the tags in the list
  489.         strPubDate = oNode.selectSingleNode("pubDate|dc:date").Text
  490.         
  491.     End If
  492.        
  493.     ' Now we write the info to the HTML page.
  494.     Call WriteFeeds
  495.  
  496.     ' Now we display the web page to the user.
  497.     webFeeds.Navigate App.Path & "\HTML\ExtremeFeeds.html"
  498.    
  499. End Function
  500.  
  501. Private Function OpenFeed()
  502.  
  503.     ' This just put the address of you favorite feeds in the address bar
  504.     ' when you open them.
  505.     Dim InStream As TextStream
  506.     Set InStream = FSys.OpenTextFile(frmMain.cboCategory & "\" & fileFeeds.FileName)
  507.     Dim noth As String
  508.         FeedURL = InStream.ReadLine
  509.         InStream.Close '< -EOF
  510.         
  511.     cboAddress.Text = FeedURL
  512.     cboAddress.Text = Replace(cboAddress.Text, Chr(10), "")
  513.     cboAddress.Text = Replace(cboAddress.Text, Chr(13), "")
  514.     cboAddress.Text = Trim(cboAddress.Text)
  515.     fileFeeds.Refresh
  516.     
  517.     ' Now we check that the address has gone in ok.
  518.     Call CheckAddress
  519.     
  520. End Function
  521.  
  522. Private Function CheckHTML()
  523.  
  524.     ' Make sure the HTML directory is there.
  525.     If FSys.FolderExists(App.Path & "\HTML") Then
  526.         Exit Function
  527.     Else
  528.         FSys.CreateFolder (App.Path & "\HTML")
  529.     End If
  530.  
  531. End Function
  532.  
  533.  
  534. Private Sub lstHeadlines_Click()
  535.     
  536.     ' This gets the headlines and displayed them in webFeeds.
  537.     Call GetHeadlines
  538.     
  539. End Sub
  540.  
  541. Private Function GetDirectory()
  542.  
  543.     ' Make sure that C:\RSS is there, if not create it.
  544.     If FSys.FolderExists(cboCategory) Then
  545.         fileFeeds.Path = cboCategory
  546.     Else
  547.         FSys.CreateFolder ("C:\RSS")
  548.         fileFeeds.Path = cboCategory
  549.     End If
  550.     
  551. End Function
  552.  
  553. Private Sub FillCategory()
  554.  
  555.     ' Clear the Combo just incase.
  556.     cboCategory.Clear
  557.     
  558.     ' Now loop through C:\RSS and add the folder to the Combo.
  559.     For Each FSysFolder In FSys.GetFolder("C:\RSS\").SubFolders
  560.         cboCategory.AddItem FSysFolder
  561.     Next
  562.     
  563.     ' Now add the Default directory and select it.
  564.     cboCategory.AddItem "C:\RSS"
  565.     cboCategory.SelText = "C:\RSS"
  566.  
  567. End Sub
  568.  
  569. Private Function DeleteFeed()
  570.  
  571.     ' This deletes the selected feed.
  572.     Dim iDeleteFeed As Integer
  573.     
  574.     If fileFeeds.FileName = "" Then
  575.         MsgBox "No feed to delete!", vbInformation, "Cannot delete"
  576.     Else
  577.         iDeleteFeed = MsgBox("Are you sure you want to delete " & fileFeeds.FileName & "?", vbYesNo + vbQuestion, "Confirm delete")
  578.         If iDeleteFeed = vbYes Then
  579.             FSys.DeleteFile (frmMain.cboCategory & "\" & fileFeeds.FileName)
  580.             Call FillCategory
  581.             fileFeeds.Refresh
  582.         End If
  583.     End If
  584.     
  585. End Function
  586.  
  587. Private Function DeleteFolder()
  588.     
  589.     ' This deletes the selected folder.
  590.     Dim iDeleteFolder As Integer
  591.     
  592.     If cboCategory.Text = "" Then
  593.         MsgBox "No folder to delete!", vbInformation, "Cannot delete"
  594.     Else
  595.         iDeleteFolder = MsgBox("Are you sure you want to delete " & cboCategory & "?", vbYesNo + vbQuestion, "Confirm delete")
  596.         If iDeleteFolder = vbYes Then
  597.             FSys.DeleteFolder cboCategory
  598.             Call FillCategory
  599.             fileFeeds.Refresh
  600.         End If
  601.     End If
  602.  
  603. End Function
  604.  
  605. Private Sub cboAddress_Click()
  606.  
  607.     ' This calls GetRSS which gets the feed from the internet.
  608.     Call GetRSS
  609.  
  610. End Sub
  611.  
  612. Private Sub cboAddress_KeyPress(KeyAscii As Integer)
  613.     
  614.     ' Call GetRSS when return is pressed.
  615.     On Error Resume Next
  616.     If KeyAscii = vbKeyReturn Then
  617.         Call GetRSS
  618.     End If
  619.     
  620. End Sub
  621.  
  622. Private Sub cboCategory_Click()
  623.     
  624.     ' Tidy up a bit.
  625.     lstHeadlines.Clear
  626.     cboAddress.Text = ""
  627.     webFeeds.Navigate "about:blank"
  628.     strHeadlines = ""
  629.     strURL = ""
  630.     strFeed = ""
  631.     strPubDate = ""
  632.     DoEvents
  633.     
  634.     ' Set the fileFeeds path to that listed in cboCategory.
  635.     If FSys.FolderExists(cboCategory) Then
  636.         fileFeeds.Path = cboCategory
  637.     End If
  638.     
  639. End Sub
  640.  
  641. Private Sub ImgURL_Click()
  642.     
  643.     ' This is for users who do not want the full article to be opened in IE.
  644.     ' this just opens the URL in the users default browser when the button is clicked.
  645.     Dim retValue As Long
  646.     
  647.     If strURL <> "" Then
  648.         retValue = ShellExecute(frmMain.hwnd, "Open", strURL, 0&, 0&, 0&)
  649.     Else
  650.         MsgBox "No feed to open!", vbInformation, "No feed available"
  651.     End If
  652.     
  653. End Sub
  654.  
  655. Private Function CheckAddress()
  656.     
  657.     ' This just checks that the address is not blank when called.
  658.     If cboAddress.Text = "" Then
  659.         MsgBox "No URL to open!", vbInformation, "No URL"
  660.         Exit Function
  661.     End If
  662.  
  663. End Function
  664.  
  665. Private Sub About_Click()
  666.     
  667.     ' Display about information when About is clicked.
  668.     MsgBox "Extreme RSS v" & App.Major & "." & App.Minor & "." & _
  669.             App.Revision & vbNewLine & vbNewLine & _
  670.            "Written by Martin Dunsmore", vbInformation, "Extreme RSS"
  671.  
  672. End Sub
  673.  
  674. Private Sub Close_Click()
  675.     
  676.     ' Do I have to really?
  677.     Unload frmCreate
  678.     Unload frmRename
  679.     Unload frmSave
  680.     Unload frmMain
  681.     End
  682.     
  683. End Sub
  684.  
  685. Private Sub ToolBar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  686.     
  687.     ' This the Toolbar buttons.
  688.     On Error Resume Next
  689.      
  690.     Select Case Button.Key
  691.         Case "Save"
  692.             ' Call the save feeds form to save a feed.
  693.             Call SaveFeed
  694.         Case "Rename"
  695.             ' Call the rename form to rename a feed.
  696.             If fileFeeds.FileName = "" Then
  697.                 MsgBox "You must select a file before you can rename one!", vbInformation, "No file selected"
  698.             Else
  699.                 frmRename.Show
  700.             End If
  701.         Case "Delete"
  702.             ' This will delete a feed.
  703.             Call DeleteFeed
  704.         Case "Open"
  705.             ' Open feed again.
  706.             Call OpenFeed
  707.             Call GetRSS
  708.         Case "Create"
  709.             ' Create a new folder.
  710.             frmCreate.Show
  711.         Case "DeleteFolder"
  712.             ' Delete a folder.
  713.             Call DeleteFolder
  714.         Case "Exit"
  715.             ' Really?
  716.             Unload frmCreate
  717.             Unload frmRename
  718.             Unload frmSave
  719.             Unload frmMain
  720.             End
  721.         Case "About"
  722.             ' Same as other About message.
  723.             MsgBox "Extreme RSS v" & App.Major & "." & App.Minor & "." & _
  724.                    App.Revision & vbNewLine & vbNewLine & _
  725.                    "Written by Martin Dunsmore", vbInformation, "Extreme RSS"
  726.     End Select
  727.     
  728. End Sub
  729.  
  730. Private Function SaveFeed()
  731.     
  732.     ' Call the save feed form. First we check that the address is not blank.
  733.     If cboAddress <> "" Then
  734.         frmSave.Show
  735.     Else
  736.         MsgBox "No RSS feed to save!", vbInformation, "No feed to save"
  737.     End If
  738.  
  739. End Function
  740.  
  741. Private Sub ToolBar2_ButtonClick(ByVal Button As MSComctlLib.Button)
  742.     
  743.     ' This the go button, this will open a feed that has been typed in.
  744.     On Error Resume Next
  745.      
  746.     Select Case Button.Key
  747.         Case "Go"
  748.             Call GetRSS
  749.     End Select
  750.     
  751. End Sub
  752.  
  753. Private Sub fileFeeds_Click()
  754.     
  755.     ' Just display what feed is currently active in the title abr.
  756.     Me.Caption = "Extreme RSS - " & cboCategory & "\" & fileFeeds.FileName
  757.     
  758. End Sub
  759. Private Sub fileFeeds_DblClick()
  760.     
  761.     ' Just display what feed is currently active in the title abr.
  762.     Me.Caption = "Extreme RSS - " & cboCategory & "\" & fileFeeds.FileName
  763.     
  764.     ' As it is a double click we will open the feed.
  765.     Call OpenFeed
  766.     Call GetRSS
  767.     
  768. End Sub
  769.  
  770. Private Sub SystemTray()
  771.  
  772.     ' Minimize to System Tray stuff
  773.     Set m_frmSysTray = New frmSysTray
  774.     With m_frmSysTray
  775.         .AddMenuItem "&Open Extreme RSS", "open", True
  776.         .AddMenuItem "&Minimize to Tray", "minimize"
  777.         .AddMenuItem "-"
  778.         .AddMenuItem "&Close", "close"
  779.         .ToolTip = "Extreme RSS"
  780.         .IconHandle = Me.Icon.Handle
  781.     End With
  782.  
  783. End Sub
  784.  
  785. Private Sub webFeeds_StatusTextChange(ByVal Text As String)
  786.     
  787.     ' Show status of webFeeds in the StatusBar.
  788.     StatusBar.Panels(3).Text = Text
  789.  
  790. End Sub
  791.  
  792. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  793.     
  794.     ' Minimize to System Tray stuff.
  795.     Unload m_frmSysTray
  796.     Set m_frmSysTray = Nothing
  797.     
  798. End Sub
  799.  
  800. Private Sub m_frmSysTray_MenuClick(ByVal lIndex As Long, ByVal sKey As String)
  801.     
  802.     ' Minimize to System Tray stuff.
  803.     Select Case sKey
  804.         Case "open"
  805.             Me.Show
  806.             Me.ZOrder
  807.         Case "minimize"
  808.             Me.Hide
  809.         Case "close"
  810.             Unload Me
  811.     End Select
  812.  
  813. End Sub
  814.  
  815. Private Sub m_frmSysTray_SysTrayDoubleClick(ByVal eButton As MouseButtonConstants)
  816.     
  817.     ' Minimize to System Tray stuff.
  818.     If frmMain.Visible = False Then
  819.         Me.Show
  820.         Me.ZOrder
  821.     Else
  822.         Me.Hide
  823.     End If
  824.     
  825. End Sub
  826.  
  827. Private Sub m_frmSysTray_SysTrayMouseDown(ByVal eButton As MouseButtonConstants)
  828.     
  829.     ' Minimize to System Tray stuff.
  830.     If (eButton = vbRightButton) Then
  831.         m_frmSysTray.ShowMenu
  832.     End If
  833.     
  834. End Sub
  835.  
  836. Private Function WriteFeeds()
  837.     
  838.     ' This is the HTML that will display the feed.
  839.     Open App.Path & "\HTML\ExtremeFeeds.html" For Output As #1
  840.     Print #1, "<html>"
  841.     Print #1, "<head>"
  842.     Print #1, "<title>" & strHeadlines & "</title>"
  843.     Print #1, "<style type=""text/css"">"
  844.     Print #1, "<!--"
  845.     Print #1, "body,td,th {color: #383C45;font-family: Verdana, Arial, Helvetica, sans-serif;}"
  846.     Print #1, "body {background-color: #F4F5F9;margin-left: 5px;margin-top: 5px;margin-right: 5px;margin-bottom: 5px;}"
  847.     Print #1, "a:link {color: #2F4D8B;text-decoration: none;}"
  848.     Print #1, "a:visited {text-decoration: none;color: #2F4D8B;}"
  849.     Print #1, "a:hover {text-decoration: underline;color: #2F4D8B;}"
  850.     Print #1, "a:active {text-decoration: none;color: #2F4D8B;}"
  851.     Print #1, ".style2 {font-size: xx-small;color: #797C83;}"
  852.     Print #1, "-->"
  853.     Print #1, "</style></head>"
  854.     Print #1, "<body><table width=""100%"">"
  855.     Print #1, "<tr>"
  856.     Print #1, "<td width=""2%""><img src=""Bullet.jpg"" border=""0""></td>"
  857.     Print #1, "<td width=""98%""><a href=" & strURL & " target=""_blank""><strong>" & strHeadlines & "</strong></a></td>"
  858.     Print #1, "</tr>"
  859.     Print #1, "<tr>"
  860.     Print #1, "<td> </td>"
  861.     Print #1, "<td><span class=""style2""><strong>Published Date:</strong> " & strPubDate & "</span></td>"
  862.     Print #1, "</tr>"
  863.     Print #1, "<tr>"
  864.     Print #1, "<td> </td>"
  865.     Print #1, "<td>" & strFeed & "</td>"
  866.     Print #1, "</tr>"
  867.     Print #1, "</table>"
  868.     Print #1, "</body>"
  869.     Print #1, "</html>"
  870.     Close #1
  871.  
  872. End Function
  873.  
  874. Private Function WriteHTML()
  875.  
  876.     ' This is the HTML you see when you first open the application.
  877.     Open App.Path & "\HTML\ExtremeRSS.html" For Output As #1
  878.     Print #1, "<html>"
  879.     Print #1, "<head>"
  880.     Print #1, "<title>Extreme RSS</title>"
  881.     Print #1, "<style type=""text/css"">"
  882.     Print #1, "<!--"
  883.     Print #1, "body {background-color: #F4F5F9;margin-left: 5px;margin-top: 5px;margin-right: 5px;margin-bottom: 5px;font-family: Verdana, Arial, Helvetica, sans-serif;}"
  884.     Print #1, ".style1 {font-size: xx-large;font-weight: bold;}"
  885.     Print #1, "-->"
  886.     Print #1, "</style></head>"
  887.     Print #1, "<body>"
  888.     Print #1, "<div align=""center"">"
  889.     Print #1, "<p class=""style1""><u>Extreme RSS</u></p>"
  890.     Print #1, "<p>Written by Martin Dunsmore</p>"
  891.     Print #1, "<p>v" & App.Major & "." & App.Minor & "." & App.Revision & "</p>"
  892.     Print #1, "</div>"
  893.     Print #1, "</body>"
  894.     Print #1, "</html>"
  895.     Close #1
  896.  
  897. End Function
  898.