%
'
' Fiel:首页 ====
'
' Date:2006-1-21
'
' Author: 薛正 MSN:Veryer@Tom.com QQ:258191
'
'
'去除任何HTML标签
Function stripHTML(strHTML)
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML, "")
stripHTML = strOutput
Set objRegExp = Nothing
End Function
'截取字符串
Function cut(str, ll)
If IsNull(str) Or str = "" Then
cut = str
Exit Function
End If
l = Len(str)
If l < ll Then
cut = str
Else
t = 0
For i = 1 To l
s = Mid(str, i, 1)
c = Asc(s)
If c < 0 Then c = c + 65536
If c > 255 Then
t = t + 1
Else
t = t + 0.5
End If
cut = cut & s
If t >= ll - 2 Then
cut = cut & "..."
Exit For
End If
Next
End If
End Function
Set DBC = New DataBaseClass
Set Conn = DBC.OpenConnection()
Set DBC = Nothing
strSQL = "select top 1 a.title,a.content,a.newsid,a.FileExtName,a.PicPath,a.filename,b.ClassEName,b.SaveFilePath from News a inner join NewsClass b on a.ClassID=b.ClassID where a.PicNewsTF=1 order by a.id desc"
Set Rs = Conn.Execute(strSQL)
if Not Rs.Eof Then
Title = rs("Title")
Content = cut(stripHTML(Cstr(rs("Content"))),170)
pic = Rs("PicPath")
url = rs("SaveFilePath") & "/" & rs("ClassEName") & "/" & rs("filename") & "." & rs("FileExtName")
End if
'// --------------- 遍历出所有分类 -----------------------
Dim TempClassListStr
TempClassListStr = ClassList
Function ClassList()
Dim Rs
Set Rs = Conn.Execute("select ClassID,ClassCName,ClassEName,SaveFilePath,ClassEName from newsclass where ParentID = '061111610194526' and DelFlag=0 order by AddTime desc")
do while Not Rs.Eof
ClassList = ClassList & "" & chr(10) & chr(13)
ClassList = ClassList & ChildClassList(Rs("ClassID"),"")
Rs.MoveNext
loop
Rs.Close
Set Rs = Nothing
End Function
Function ChildClassList(ClassID,Temp)
Dim TempRs,TempStr
Set TempRs = Conn.Execute("Select ClassID,ClassCName,ChildNum,ClassEName,SaveFilePath,ClassEName from NewsClass where ParentID = '" & ClassID & "' and DelFlag=0 order by AddTime desc ")
TempStr = Temp & " - "
do while Not TempRs.Eof
if TempRs("ChildNum") = 0 then
ChildClassList = ChildClassList & ""& chr(10) & chr(13)
else
ChildClassList = ChildClassList & ""& chr(10) & chr(13)
end if
'ChildClassList = ChildClassList & ChildClassList(TempRs("ClassID"),TempStr)
TempRs.MoveNext
loop
TempRs.Close
Set TempRs = Nothing
End Function
'// ---------------- 代码结束 ----------------------------------
Rs.Close() : Set Rs = Nothing
Set Conn = Nothing
%>