<%
'==================================================================================
'oASK问答系统静态页面版
'官方演示站点：
http://ask.officexy.com/'官方支持论坛：
http://club.officexy.com/'联系人：小杨
'联系EMail：
officexy.com@163.com'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、Office学院保留此软件的法律追究权利
'==================================================================================
dim AllFenleiStr, SecondFenleiArray
'SQL的bit字段转换为数字
function Bit2Int(b)
on error resume next
Bit2Int=b
if b=True then
Bit2Int=1
elseif b=False then
Bit2Int=0
else
Bit2Int=b
end if
end function
'根据jie值判断问题类型
Function GetQuestionType(jie)
if jie=0 then
GetQuestionType=\"未解决\"
elseif jie=1 then
GetQuestionType=\"已解决\"
elseif jie=2 or jie=4 then
GetQuestionType=\"已关闭\"
elseif jie=5 then
GetQuestionType=\"已删除\"
else
GetQuestionType=\"状态未知\"
end if
End Function
Function GetPageNav(url, p, maxpage, maxnum, pagesize, Ext)
if ext<>\"\" and left(ext,1)<>\"&\" then ext=\"&\"&ext
GetPageNav = \"总数\"&maxnum&\"，每页\"&pagesize&\"，页次<font color=red>\"&p&\"</font>/\"&maxpage&\"， \"
if p<=1 then
GetPageNav = GetPageNav & \"首页 | 上页 | \"
else
GetPageNav = GetPageNav & \"<a href='\" &url& \"?p=1\" &Ext& \"'>首页</a> | \"
GetPageNav = GetPageNav & \"<a href='\" &url& \"?p=\" &p-1&Ext& \"'>上页</a> | \"
end if
if p>=maxpage then
GetPageNav = GetPageNav & \"下页 | 尾页\"
else
GetPageNav = GetPageNav & \"<a href='\" &url& \"?p=\" &p+1&Ext& \"'>下页</a> | \"
GetPageNav = GetPageNav & \"<a href='\" &url& \"?p=\" &maxpage&Ext& \"'>尾页</a>\"
end if
End Function
Function Escape(ByVal s)
s=replace(s,\"/\",\"%2F\")
s=replace(s,\":\",\"%3A\")
s=replace(s,\"?\",\"%3F\")
s=replace(s,\"&\",\"%26\")
s=replace(s,\"'\",\"%27\")
s=replace(s,\"\"\"\",\"%22\")
s=replace(s,\"#\",\"%23\")
s=replace(s,\"=\",\"%3D\")
s=replace(s,\" \",\"%20\")
Escape=s
End Function
Function UnEscape(ByVal s)
s=replace(s,\"%2F\",\"/\")
s=replace(s,\"%3A\",\":\")
s=replace(s,\"%3F\",\"?\")
s=replace(s,\"%26\",\"&\")
s=replace(s,\"%27\",\"'\")
s=replace(s,\"%22\",\"\"\"\")
s=replace(s,\"%23\",\"#\")
s=replace(s,\"%3D\",\"=\")
s=replace(s,\"%20\",\" \")
UnEscape=s
End Function
'获取短标题
Function GetTitleOfLen(Title, aLen)
if LenB(Title)<=aLen*2 then
GetTitleOfLen=Title
else
GetTitleOfLen=left(Title,aLen-2) & \"...\"
end if
End Function
'获取短标题
Function GetShortTitle(Title)
if Len(Title)<=30 then
GetShortTitle=Title
else
GetShortTitle=left(Title,25) & \"...\"
end if
End Function
'快到期问题
function GetOldQuestion(ClassID, QuestionID)
dim rs,title
set rs=ask.Execute(\"select top 5 * from askQuestion where jie=0 and fenleiid=\"&ClassID&\" and id<>\" & QuestionID & \" order by overtime desc\")
if rs.eof then
GetOldQuestion=\"暂无相关问题\"
else
while not rs.eof
title=HTMLEncode(rs(\"title\"))
GetOldQuestion=GetOldQuestion & \"• <a href='q/q\" & rs(\"id\") & \".htm' target='_blank' title='\"&Title&\"'>\" & GetShortTitle(Title) & \"</a><br>\"
rs.movenext
wend
GetOldQuestion=GetOldQuestion+\"<a href='c.asp?id=\" & ClassID & \"&jie=0' class='lmore' target='_blank'>更多>></a>\"
end if
rs.Close
set rs=Nothing
end function
'用于用户发布的各种信息过滤
Function HTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, \">\", \">\")
fString = replace(fString, \"<\", \"<\")
fString = Replace(fString, CHR(32), \" \") '
fString = Replace(fString, CHR(9), \" \") '
fString = Replace(fString, CHR(34), \""\")
fString = Replace(fString, CHR(39), \"'\") '单引号过滤
fString = Replace(fString, CHR(13), \"\")
fString = Replace(fString, CHR(10) & CHR(10), \"</P><P> \")
fString = Replace(fString, CHR(10), \"<BR> \")
HTMLEncode = fString
End If
End Function
'相关问题
function GetSimilarQuestion(byval key)
dim rs, jie, sql, title
key=\"'%\" & key & \"%'\"
sql = \"select top 10 id,title,topic,jie from askQuestion where title like \" & key & \" or content like \" & key & \" order by sendtime desc\"
set rs=ask.Execute(sql)
while not rs.eof
jie=rs(\"jie\")
if jie=0 then
GetSimilarQuestion=GetSimilarQuestion & \"<img src='img/icn_time.gif' alt='待解决问题'>\"
elseif jie=1 then
GetSimilarQuestion=GetSimilarQuestion & \"<img src='img/icn_ok.gif' alt='已解决问题'>\"
elseif jie=4 then
GetSimilarQuestion=GetSimilarQuestion & \"<img src='img/icn_close.gif' alt='问题已关闭'>\"
elseif jie=5 then
GetSimilarQuestion=GetSimilarQuestion & \"<img src='img/icn_del.gif' alt='问题已删除'>\"
else
GetSimilarQuestion=GetSimilarQuestion & \"<img src='img/icn_time.gif' alt='状态未知'>\"
end if
Title=HTMLEncode(rs(\"title\"))
GetSimilarQuestion=GetSimilarQuestion & \"<a href='q/q\" & rs(\"id\") & \".htm' target='_blank' title='\"&Title&\"'>\" & GetShortTitle(Title) & \"</a><br>\"
rs.movenext
wend
rs.Close
set rs=Nothing
end function
'根据问题/回复的Attach字段的值生成相应的图片代码
function GetAttachHtml(attachid)
if attachid>0 then
dim rs,ext,path,OriginalFile,StoreFile,addtime
set rs=ask.Execute(\"select qid, rid, OriginalFile, addtime from askAttach where id=\" & attachid & \" and OriginalFile IS NOT NULL\")
if not rs.eof then
OriginalFile=rs(\"OriginalFile\")
addtime=rs(\"addtime\")
ext=GetExt(OriginalFile)
StoreFile=WebUrl & \"attach/\" & year(addtime) & \"-\" & month(addtime) & \"/q\" & rs(\"qid\") & \"r\" & rs(\"rid\") & ext
end if
rs.close
set rs=Nothing
if OriginalFile<>\"\" then
Select Case ext
Case \".gif\",\".jpg\",\".jpeg\",\".png\" GetAttachHtml = GetAttachHtml & \"<br><img src='\" & StoreFile & \"'>\"
Case \".swf\" GetAttachHtml = GetAttachHtml & \"<br><a href='\" & StoreFile & \"' target='_blank'>观看动画 \" & OriginalFile & \"</a>\"
'Case \".zip\",\".rar\",\".chm\"
case else GetAttachHtml = GetAttachHtml & \"<br><a href='\" & StoreFile & \"' target='_blank'>下载附件 \" & OriginalFile & \"</a>\"
End Select
end if
end if
end function
'获取文件扩展名
function GetExt(aFile)
dim i
i=InstrRev(aFile,\".\")
if i=0 then
GetExt=\"\"
else
GetExt=LCase(mid(aFile,i))
end if
end function
'检查新建目录
Function CreateNewFolder(aDir)
Dim FSO
Set FSO = Server.CreateObject(Script_FSO)
If FSO.FolderExists(Server.MapPath(aDir)) = False Then
FSO.CreateFolder Server.MapPath(aDir)
End If
Set FSO = Nothing
End Function
'根据积分判断头衔
function GetTouxian(jifen)
if Jifen<fen1 then
GetTouxian=ji1&\" 一级\"
elseif Jifen>=fen1 and Jifen<fen2 then
GetTouxian=ji1&\" 一级\"
elseif Jifen>=fen2 and Jifen<fen3 then
GetTouxian=ji2&\" 二级\"
elseif Jifen>=fen3 and Jifen<fen4 then
GetTouxian=ji3&\" 三级\"
elseif Jifen>=fen4 and Jifen<fen5 then
GetTouxian=ji4&\" 四级\"
elseif Jifen>=fen5 and Jifen<fen6 then
GetTouxian=ji5&\" 五级\"
elseif Jifen>=fen6 and Jifen<fen7 then
GetTouxian=ji6&\" 六级\"
elseif Jifen>=fen7 and Jifen<fen8 then
GetTouxian=ji7&\" 七级\"
elseif Jifen>=fen8 and Jifen<fen9 then
GetTouxian=ji8&\" 八级\"
elseif Jifen>=fen9 and Jifen<fen10 then
GetTouxian=ji9&\" 九级\"
elseif Jifen>=fen10 then
GetTouxian=ji10&\" 十级\"
end if
end function
'从数据库获取头衔
function GetTouxianOfUser(user)
dim rs
set rs=ask.Execute(\"select touxian from askUser where name='\" & user & \"'\")
if not rs.eof then GetTouxianOfUser = rs(0)
rs.Close
set rs=Nothing
end function
'验证码
Function GetSafeCode
Dim test
On Error Resume Next
Set test=Server.CreateObject(\"Adodb.Stream\")
Set test=Nothing
If Err Then
Dim zNum
Randomize timer
zNum = cint(8999*Rnd+1000)
Session(\"oASK_SafeCode\") = zNum
GetSafeCode = zNum
Else
GetSafeCode = \"<img src='DV_getcode.asp' alt='验证码,看不清楚?请点击刷新验证码' style='cursor:pointer;height:20px;' onclick=\"\"this.src='DV_getcode.asp'\"\" align='absmiddle' />\"
End If
End Function
'URL解码函数 by 轻飘飘
Function URLDecode(enStr)
On Error Resume Next
Dim deStr,c,i,v:deStr=\"\"
For i=1 to len(enStr)
c=Mid(enStr,i,1)
If c=\"%\" Then
v=eval(\"&h\"+Mid(enStr,i+1,2))
If v<128 Then
deStr=deStr&Chr(v)
i=i+2
Else
If isvalidhex(Mid(enstr,i,3)) Then
If isvalidhex(Mid(enstr,i+3,3)) Then '这个判断检测是否双字节--不是
v=eval(\"&h\"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&Chr(v)
i=i+5
Else
v=eval(\"&h\"+Mid(enStr,i+1,2)+Cstr(Hex(Asc(Mid(enStr,i+3,1))))) '--是
deStr=deStr&Chr(v)
i=i+3
End If
Else
destr=destr&c
End If
End If
Else
If c=\"+\" Then
deStr=deStr&\" \"
Else
deStr=deStr&c
End If
End If
Next
URLDecode=deStr
End Function
Function IsValidHex(str)
Dim c
IsValidHex=True
str=UCase(str)
If Len(str)<>3 Then
IsValidHex=False
Exit Function
End If
If Left(str,1)<>\"%\" Then
IsValidHex=False
Exit Function
End If
c=Mid(str,2,1)
If Not (((c>=\"0\") And (c<=\"9\")) Or ((c>=\"A\") And (c<=\"Z\"))) Then
IsValidHex=False
Exit Function
End If
c=Mid(str,3,1)
If Not (((c>=\"0\") And (c<=\"9\")) Or ((c>=\"A\") And (c<=\"Z\"))) Then
IsValidHex=False
Exit Function
End If
End Function
%>
程序代码：