Új hozzászólás Aktív témák
-
Gh0sT
addikt
Hát, jól van... Mondjuk nem teljesen tiszta, de nagyjából felfogtam...
Akkor közzé teszem azt, ami nekem leszedi, és az lenne a kérdés, hogy ki segítene átírni a fentieknek megfelelően:
'-----------------------------------------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 = ''<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
Tényleg hülye vagyok hozzá, szóval elmagyarázni senki ne próbálja, csak ha nagyon egyszerű...
Még nézegetem a kódot, de nem hiszem, hogy okosabb leszek tőle...
[Szerkesztve]Soha nem késő, hogy azzá válj, aki lehettél volna.
-
Gh0sT
addikt
Ryu kolléga megoldotta a problémát. Ha esetleg valakinek ilyenre lenne szüksége, akkor itt a PH!-s RSS immáron dátum és idő nélkül: Bővebben: link
Soha nem késő, hogy azzá válj, aki lehettél volna.
Még nézegetem a kódot, de nem hiszem, hogy okosabb leszek tőle...