<%
Dim Rs,newrss
Class Rss
' ******************* input parameter ********************
'***********************************************
' Connection object used by Setconn Web site
' SetSQL must fill in the SQL query statement. Using the TOP keyword in SQL statements is highly recommended
' The fields contained in the SQL statement [news ID, title, content, time, static page name]
' Note: Do not reverse order
' If the news is not a generated static page, then there is no last item, the Setpagetype value is 1
' Setwebname Required Site name
' Setweburl must fill in the address of the website
' Setwebdes ' descriptive information about the required web site
' Setpagetype required information displays the link type of page 1 is dynamic page ID 0 is a static page
' Setmaxinfo the number of mandatory display information, if the data >setmaxinfo will display setmaxinfo data. Using the TOP keyword in SQL statements is highly recommended
' Setcontentshow information profile setting. Note: This parameter is an array (Showcontenttype,showcontentlen)
' Showcontenttype [Number type] is the content display method [parameter (0,1) 0 is a percentage display information, 1 is by word]
' Showcontentlen the length of the content displayed by the Showcontenttype determines the actual length
' ***************** output parameter ********************
' Showrss Display RSS
'======================================================
' For example
' Set newrss=new Rss
' Set Newrss.setconn=article_conn
' newrss.setsql= ' select top newsid,title,content,dateandtime,n_fname from article where typeid=1 order by NewSID Desc "
' Newrss.setwebname= ' in ' Test '
' Newrss.setweburl= ' http://www.jb51.net '
' Newrss.setmaxinfo=10
' Newrss.setinfourl= ' http://www.jb51.net '
' Newrss.setpagetype= 0 '
' newrss.setcontentshow= 1,200 '
' Newrss.showrss ()
' Set newrss=nothing
'======================================================
Private Conn,sql,webname,weburl,webdes,er,maxinfo,i,infourl,pagetype
Private Showcontenttype,showcontentlen
Private Allcontent,allcontentlen
Private Sub Class_Initialize ()
Maxinfo=20
' Pagetype=1
Showcontenttype=0
Showcontentlen=20
Er=false
End Sub
Private Sub Class_Terminate ()
If IsObject (Rs) then Set rs=nothing
End Sub
Public Property Let ErrMsg (msg)
If Er Then
Response.Clear ()
Response.Write (msg)
Response.End ()
End If
End Property
Public Property Let Setwebname (Webname_)
Webname=webname_
End Property
Public Property Let Setweburl (Weburl_)
Weburl=weburl_
End Property
Public Property Let Setwebdes (Webdes_)
Webdes=webdes_
End Property
Public Property Let Setinfourl (Infourl_)
Infourl=infourl_
End Property
Public Property Let Setpagetype (Pagetype_)
Pagetype=pagetype_
End Property
Public Property Let Setmaxinfo (Maxinfo_)
Maxinfo=maxinfo_
End Property
Public Property Let Setcontentshow (Contentshow_)
Dim Arrcontentshow
Arrcontentshow=split (Contentshow_, ",")
If Ubound (arrcontentshow) <>1 Then er=true:errmsg= "Information display parameter settings are incorrect!!"
Showcontenttype=arrcontentshow (0)
Showcontentlen=arrcontentshow (1)
If not IsNumeric (showcontenttype) or showcontenttype= "" Then showcontenttype=0
If not IsNumeric (Showcontentlen) or showcontentlen= "" Then
If showcontenttype=0 Then showcontentlen=20 Else showcontentlen=200
Else
If showcontenttype=0 and (showcontentlen>100 or showcontentlen<10) Then showcontentlen=20
End If
End Property
Public Property Set Setconn (Conn_)
If TypeName (conn_) = "Connection" Then
Set Conn=conn_
Else
Er=true
errmsg= "Database connection Error"
Exit Property
End If
End Property
Public Property Let SetSQL (Sql_)
Sql=sql_
End Property
Public Property Get Rsshead ()
rsshead= "<?xml version=" "1.0" "encoding=" "gb2312" "?>"
rsshead=rsshead& "<rss>"
rsshead=rsshead& "<channel>"
rsshead=rsshead& "<title>" &WebName& "</title>"
rsshead=rsshead& "<link>" &WebUrl& "</link>"
rsshead=rsshead& "<description>" &WebDes& "</description>"
End Property
Private Property Get Rssbottom ()
Rssbottom= "</channel>"
rssbottom=rssbottom& "</rss>"
End Property
Public Sub Showrss ()
On Error Resume Next
Dim Rs
Dim showinfourl,showcontent,content
If TypeName (Conn) <> "Connection" Then er=true:errmsg= "wrong Connection object"
If sql= "" or isnull (sql) = "" or isempty (sql) = "Then er=true:errmsg=" does not have an executable SQL statement "
If webname= "" or isnull (WebName) = "" or IsEmpty (WebName) = "Then er=true:errmsg=" please set RSS title "
If Weburl= "" or isnull (weburl) = "" or IsEmpty (weburl) = "Then er=true:errmsg=" please set the link to the Web site "
If infourl= "" or isnull (infourl) = "" or IsEmpty (infourl) = "" Then er=true:errmsg= "please set link information"
If pagetype= "" or isnull (pagetype) = "" or IsEmpty (pagetype) = "" Then er=true:errmsg= "please set link type"
Set rs=server.createobject ("ADODB. RecordSet ")
Rs.Open sql,conn,1,1
If ERR Then
Er=true
Errmsg= the database could not be opened <br/> Check that your SQL statement is correct
Exit Sub
End If
Response.Charset = "gb2312"
Response.contenttype= "Text/xml"
Response.Write (Rsshead)
For I =1 to Maxinfo
'*****************************
Showinfourl=infourl
If showinfourl= "" or IsNull (Showinfourl) or IsEmpty (Showinfourl) Then
Showinfourl= "#"
Else
If pagetype Then showinfourl=showinfourl&rs (0) Else Showinfourl=showinfourl&rs (4)
End If
'*****************************
Allcontent=losehtml (Rs (2))
Allcontentlen=bytelen (allcontent)
Showcontent=int (Showcontentlen)
If showcontenttype=0 Then showcontent=allcontentlen*showcontent/100
Content=server.htmlencode (Titleb (allcontent,showcontent))
Response.Write ("<item>")
Response.Write ("<title>")
Response.Write (Rs (1))
Response.Write ("</title>")
Response.Write ("<link>")
Response.Write (Showinfourl)
Response.Write ("</link>")
Response.Write ("<description>")
Response.Write (Content)
Response.Write ("</description>")
Response.Write ("<pubDate>")
Response.Write (Return_rfc822_date (Rs (3), "GMT"))
Response.Write ("</pubDate>")
Response.Write ("</item>")
If rs.eof or I>cint (maxinfo) Then Exit for
Rs.movenext
Next
Response.Write (Rssbottom)
End Sub
Function losehtml (CONTENTSTR)
Dim Clstemplosestr,regex
Clstemplosestr = Cstr (CONTENTSTR)
Set regEx = New RegExp
Regex.pattern = "<\/*[^<>]*>"
Regex.ignorecase = True
Regex.global = True
Clstemplosestr = Regex.Replace (Clstemplosestr, "")
losehtml = Clstemplosestr
End Function
Function return_rfc822_date (ByVal mydate, ByVal TimeZone)
Dim Myday, Mydays, Mymonth, myyear
Dim myhours, Myminutes, Myseconds
MyDate = CDate (mydate)
Myday = Enweekdayname (mydate)
Mydays = Right ("A" & Day (MyDate), 2)
Mymonth = Enmonthname (mydate)
Myyear = year (mydate)
Myhours = Right ("& Hour" (MyDate), 2)
Myminutes = Right ("& Minute" (MyDate), 2)
Myseconds = Right ("& Second" (MyDate), 2)
Return_rfc822_date = myday& "," & _
mydays& "" & _
mymonth& "" & _
myyear& "" & _
myhours& ":" & _
myminutes& ":" & _
myseconds& "" & _
"" & TimeZone
End Function
Function Enweekdayname (inputdate)
Dim result
Select case Weekday (inputdate,1)
Case 1:result= "Sun"
Case 2:result= "Mon"
Case 3:result= "Tue"
Case 4:result= "Wed"
Case 5:result= "Thu"
Case 6:result= "Fri"
Case 7:result= "Sat"
End Select
Enweekdayname = result
End Function
Function Enmonthname (inputdate)
Dim result
Select case Month (inputdate)
Case 1:result= "the"
Case 2:result= "Feb"
Case 3:result= "Mar"
Case 4:result= "APR"
Case 5:result= ' may '
Case 6:result= "June"
Case 7:result= "June"
Case 8:result= "Aug"
Case 9:result= "Sep"
Case 10:result= "OCT"
Case 11:result= "Nov"
Case 12:result= "Dec"
End Select
Enmonthname = result
End Function
function Titleb (Str,strlen)
Dim Bstrlen
Bstrlen=strlen
If IsEmpty (str) or isnull (str) or str= "" Then
Titleb=str
Exit function
Else
Dim l,t,c,i
L=len (str)
T=0
For I=1 to L
C=abs (ASC (str,i,1))
If c>255 Then
T=t+2
Else
T=t+1
End If
If T>=bstrlen Then
Titleb=left (Str,i)
Exit For
Else
titleb=str& ""
End If
Next
End If
End Function
function Bytelen (str)
Dim lenstr,lentemp,i
Lenstr=0
Lentemp=len (str)
Dim strtemp
For I=1 to Lentemp
STRTEMP=ASC (Mid (str,i,1))
If strtemp>255 or strtemp<=0 then
Lenstr=lenstr+2
Else
Lenstr=lenstr+1
End If
Next
Bytelen=lenstr
End Function
End Class
%>
