Deskmodder.de

Code: Alles auswählen

00:00 - Jedes Programm ein Volltreffer
00:00 - Neue Version von Outpost Firewall im April
00:00 - Linspire Five-0 erschienen
00:00 - Microsoft kassiert für VB-6-Support
00:00 - L'Tur startet Auktionsplattform für Last Minute Reisen

Code: Alles auswählen

'-----------------------------------------INFO---------------------------------------
'  GetRssFeed V1.2 Script
'
'  A small script to get rss feed.
'
'  Installation: Unpack this file into your scripts folder in your samurize
'  installation folder, and add it in your config. Run the GetNews() 
'  function. Two variables needs to be set, num_of_headlines wich is the
'  number of headlines you want returned, and url wich is the url to the
'  rss feed. The last option is if the script should return the channel title,
'  USE: "YES" or "NO".
'
'  Example getNews(5,"http://www.dagbladet.no/rss/oppdatert.xml","YES")
'
'
'  Version updates:
'  - Rewrote script
'  - Added stripping of html codes
'  - Added possibility if returning more info
'  - Added possibility of specifying the returnstring (idea from DeMo's Nforce script)
'  - Added sorting on date, due to some feeds doesn't return titles cronologic
'  - Added possibility to return channel title.
'
'  Writers comment: I know here has already been posted a get slashdot rss
'  feed script, but when I installed samurize yesterday the site was down
'  so I didn't know about it. So I simply wrote my own. This script works
'  with rss version 1.0, the rest I haven't tested. Enjoy the script.
'
'  Contactinfo: http://www.samurize.com/modules/ipboard/index.php?showuser=5373
'------------------------------------------------------------------------------------

'-------------------------------------CONFIGURATION----------------------------------
const NO_ITEMS_FOUND = "No news found....." 'Message to show if no news titles were found
const PERFORM_SORT = "YES" 'Perform sort of result or not, use "YES" or "NO"
'
'I was a bit inspired by DeMos NForce script, so I added a feature where you can
'customize the output through "smart tags"
'You can specify your own result using the following tags
'
'<time> = the time the item was published
'<date> = the date the item was published
'<datetime> = Full date time string of when the item was published
'<title> = The title of the item
'<link> = The link of the item (this will not make it clickable :)
'<description> = The description of the item
'<subject> = The subject of the title (Often used as the category)

const RETURN_FORMAT = "<time> - <title>"

'---------------------------------DO NOT EDIT BELOW----------------------------------
Dim channelTitle, channelLink, channelDescription 'Info regargin feed
Dim aItems() 'Array to dump all items from feed due to sort of feed

function getNews(NUM_OF_TITLES,URL,RETURN_CHANNEL_TITLE)
	parseNews URL
	dim tmpResult, tmpReturnResult
	if UCASE(RETURN_CHANNEL_TITLE)="YES" then
		tmpReturnResult = channelTitle & chr(10)
	else
		tmpReturnResult = ""
	end if
	if isArray(aItems) then
		'Sort on date, due to some feeds not returning cronological
		If PERFORM_SORT="YES" then	QuickSort 4 End If
		For i = 0 to Ubound(aItems,2)
			tmpResult = RETURN_FORMAT
			tmpResult = Replace(tmpResult,"<title>",aItems(0,i))
			tmpResult = Replace(tmpResult,"<link>",aItems(1,i))
			tmpResult = Replace(tmpResult,"<description>",aItems(2,i))
			tmpResult = Replace(tmpResult,"<subject>",aItems(3,i))
			tmpResult = Replace(tmpResult,"<time>",FormatDateTime(aItems(4,i),4))
			tmpResult = Replace(tmpResult,"<date>",FormatDateTime(aItems(4,i),2))
			tmpResult = Replace(tmpResult,"<datetime>",aItems(4,i))
			tmpReturnResult = tmpReturnResult & tmpResult&chr(10)
			if i+1 = CInt(NUM_OF_TITLES) then exit for
		Next
	else
		tmpReturnResult = NO_ITEMS_FOUND
	end if
	getNews = tmpReturnResult
end function 'getNews

Sub parseNews(url)
	Dim intCnt, result
	result = ""
	set source = CreateObject("MSXML2.DOMDocument")
	source.async = false
	source.validateOnParse = false
	source.resolveExternals = false
	source.load(url)
	If source.parseError.errorCode <> 0 Then
		parseRss = source.parseError.errorCode
		exit sub
	End if
	set baseEl = source.documentElement.selectSingleNode("channel")
	set titleEl = baseEl.selectSingleNode("title")
	if NOT titleEl is Nothing then
		'Get channel information
		channelTitle=getText("title", baseEl)
		channelLink=getText("link", baseEl)
		channelDesc=getText("description", baseEl)
		'Dump items to array
		Set objLst = source.getElementsByTagName("item")
		noOfHeadlines = objLst.length
		intCnt=0
		For i = 0 To (noOfHeadlines - 1)
			Redim Preserve aItems(4,i)
			Set objHdl = objLst.item(i)
			'title=getText("title", objHdl)
			aItems(0,i)=getText("title", objHdl)
			aItems(1,i)=getText("link", objHdl)
			aItems(2,i)=getText("description", objHdl)
			aItems(3,i)=getText("dc:subject", objHdl)
			aItems(4,i)=formatTheDate(getText("dc:date", objHdl))
			intCnt=intCnt+1
			'if intCnt=CInt(num_of_headlines) then exit for
		Next
	End If
	Set source = nothing
	Set baseEl = nothing
	set titleEl = nothing
	Set objLst = nothing
	Set objHdl = nothing
end sub

Private function getText(ttg, xmlObj)
	dim tmpText
	tmpText=""
	set xEl = xmlObj.selectSingleNode(ttg)
	if not xEl is Nothing then
		tmpText=xEl.text
		if left(tmpText,1)="-" then tmpText=Right(tmpText,len(tmpText)-1)
		tmpText=stripHTML(Trim(tmpText))
	end if
	getText=tmpText
	set xEl = nothing
end function

Private Function formatTheDate(tmpDate)
	Dim iYear, iMonth, iDay, iHour, iMin, iSec, resDate
	If Trim(""&tmpDate)<>"" then
		iYear = Left(tmpDate,4)
		iMonth = Mid(tmpDate,6,2)
		iDay = Mid(tmpDate,9,2)
		iHour = Mid(tmpDate,12,2)
		iMin = Mid(tmpDate,15,2)
		iSec = Mid(tmpDate,18,2)		
		resDate = DateSerial(iYear,iMonth,iDay)
		resDate = DateAdd("h",iHour,resDate)
		resDate = DateAdd("n",iMin,resDate)
		resDate = DateAdd("s",iSec,resDate)
	formatTheDate=resDate
	Else
		formatTheDate=Date()
	end if
End Function 'formatTheDate

Sub SwapRows(row1,row2)
  '== This proc swaps two rows of an array 
  Dim x,tempvar
  For x = 0 to Ubound(aItems,1)
    tempvar = aItems(x,row1)    
    aItems(x,row1) = aItems(x,row2)
    aItems(x,row2) = tempvar
  Next
End Sub  'SwapRows

Sub QuickSort(field)
 Dim bolSorted,i
 bolSorted = true
 For i = 0 to ubound(aItems,2)-1
		if aItems(field,i)<aItems(field,i+1) then
			SwapRows i,i+1
			bolSorted=false
		End if
 Next
	if bolSorted=false then call QuickSort(field)
End Sub  'QuickSort

Private Function stripHTML(strHTML)
  Dim objRegExp, strOutput
  Set objRegExp = New Regexp
  objRegExp.IgnoreCase = True
  objRegExp.Global = True
  objRegExp.Pattern = "<(.|\n)+?>"
  strOutput = objRegExp.Replace(strHTML, "")
  stripHTML = strOutput
  Set objRegExp = Nothing
End Function

Code: Alles auswählen

const RETURN_FORMAT = "<time> - <title>"

Code: Alles auswählen

const RETURN_FORMAT = "<title>"