<%
Dim siteinfo,setting,UserRole,regForm
Function CreateEditor(EditorName, EditorValue, EditorType, EditorAttr)
	Select Case LCase(EditorType)
    Case "fckeditor"
        Dim oFCKeditor
        Set oFCKeditor = New FCKeditor
        oFCKeditor.Config("AutoDetectLanguage") = False
        oFCKeditor.Config("DefaultLanguage") = "zh-cn"
		oFCKeditor.BasePath=siteinfo(1)&"Inc/Editor/"
        oFCKeditor.Value = EditorValue
        oFCKeditor.Width = EditorAttr(0)
        oFCKeditor.Height = EditorAttr(1)
        oFCKeditor.ToolbarSet = EditorAttr(2)
        CreateEditor = oFCKeditor.Create(EditorName)
        Set oFCKeditor = Nothing
    Case Else
        CreateEditor = "<textarea name='" & EditorName & "' id='" & EditorName & "' cols='" & EditorAttr(0) & "' rows='" & EditorAttr(1) & "' class='" & EditorAttr(2) & "'>" & Server.HTMLEncode(EditorName & "") & "</textarea>"
    End Select
End Function

Function RexHtml(ByVal str)
    Dim strInfo, arrInfo, i,staTitle,funTitle,arry
    strInfo = AskD.RegExpTest("{k_([\s\S]*?)}", str)
    If strInfo <> "" Then
            arrInfo = Split(strInfo, "|")
            For i = 0 To UBound(arrInfo) - 1
              If InStr(arrInfo(i), "(") > 0 Then
              '替换函数标签^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
                   funTitle = AskD.tempTitle(arrInfo(i))  '调用函数(temptitle)取函数名称
                   arry = AskD.tempInfo(arrInfo(i))       '调用函数(tempinfo)取参数列表
                   staTitle = Eval(funTitle & "(" & arry & ")")
               '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
              Else
                   '替换静态标签和无参函数标签^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
                   staTitle = AskD.staticTitle(arrInfo(i)) '调用函数(statictitle)取变量名称
                   staTitle = eval(staTitle)
              End If
                   If IsNull(staTitle) Then staTitle = ""
                   str = Replace(str, arrInfo(i), staTitle) '取变量值
           Next
     End If
     If AskD.RegExists("{k_([\s\S]*?)}", str) Then str = RexHtml(str) '再次替换
     RexHtml = str
End Function

Function GetDaohang(n) 'n=1 顶部导航，n=2底部导航
    If IsObject(Application("Daohangxml")) = False Then Call AskD.DoDaohangXml
    
    Dim ReXml, str, xs, target, PStr
    Set ReXml = Application("Daohangxml")
    For Each xs In ReXml.documentElement.selectNodes("row[@type=" & n & "]")
        If xs.selectSingleNode("@newwin").Text = "1" Then target = " target=""_blank""" Else  target = ""
        If n = 1 Then
            If xs.selectSingleNode("@navurl").Text <> "" Then
               PStr = "<li><a href=""" & xs.selectSingleNode("@navurl").Text & """" & target & ">" & xs.selectSingleNode("@navname").Text & "</a></li><li><img src=""" & siteInfo(1) & "Template/" & siteInfo(11) & "/images/d.gif"" alt=""""/></li>" & vbCrLf
            Else
               PStr = "<li>" & xs.selectSingleNode("@navname").Text & "</li><li><img src=""" & siteInfo(1) & "Template/" & siteInfo(11) & "/images/d.gif"" alt=""""/></li>" & vbCrLf
            End If
        Else
            If xs.selectSingleNode("@navurl").Text <> "" Then
               PStr = "<a href=""" & xs.selectSingleNode("@navurl").Text & """" & target & ">" & xs.selectSingleNode("@navname").Text & "</a>｜"
            Else
               PStr = xs.selectSingleNode("@navname").Text & "｜"
            End If
        End If
        
        If Request.Cookies("Muser") = "" Then
           If xs.selectSingleNode("@show2").Text <> "2" Then
              str = str & PStr
           End If
        Else
           If xs.selectSingleNode("@show2").Text <> "1" Then
              str = str & PStr
           End If
        End If
    Next
    Set xs = Nothing
    Set ReXml = Nothing
    GetDaohang = str
End Function

Public Function RexHtml_IF(ByVal str)
    Dim Reg
        Set Reg = New RegExp
        Reg.IgnoreCase = True
        Reg.Global = True
        On Error Resume Next
        Dim Matches, Match
        Dim TestIF
        
        Reg.Pattern = "{ElseIf([\s\S]*?):(.+?)}([\s\S]*?){Else\1}([\s\S]*?){/ElseIf\1}"
        Set Matches = Reg.Execute(str)
        For Each Match In Matches
            Execute ("If " & Match.SubMatches(1) & " Then TestIf = True Else TestIf = False")
            If TestIF Then str = Replace(str, Match.Value, Match.SubMatches(2)) Else str = Replace(str, Match.Value, Match.SubMatches(3)) ' 替换
            If Err Then Response.Write "<font color=red>执行Else" & Match.SubMatches(0) & "标签失败 [" & Match.SubMatches(1) & "]" & Err.Description & "</font>": Err.Clear: Response.End
        Next
        
        Reg.Pattern = "{If([\s\S]*?):(.+?)}([\s\S]*?){/If\1}"
        Set Matches = Reg.Execute(str)
        For Each Match In Matches
            Execute ("If " & Match.SubMatches(1) & " Then TestIf = True Else TestIf = False")
            If TestIF Then str = Replace(str, Match.Value, Match.SubMatches(2)) Else str = Replace(str, Match.Value, "") ' 替换
            If Err Then Response.Write "<font color=red>执行IF" & Match.SubMatches(0) & "标签失败 [" & Match.SubMatches(1) & "]" & Err.Description & "</font>": Err.Clear: Response.End
        Next
        
    Set Matches = Nothing
    Set Reg = Nothing
    
    If AskD.RegExists("{ElseIf([\s\S]*?):(.+?)}([\s\S]*?){Else\1}([\s\S]*?){/ElseIf\1}", str) Or AskD.RegExists("{If([\s\S]*?):(.+?)}([\s\S]*?){/If\1}", str) Then str = RexHtml_IF(str) '再次替换
    
    RexHtml_IF = str
End Function

Sub SendMsg(str)
Call Workload(Request.Cookies("adminID"), 1, str)
Response.Write ("<table class=""tableBorder"" cellspacing=""1"" cellpadding=""2"" width=""96%"" align=""center"" border=""0"">" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<th height=""25"" align=""left"">快" & "问知" & "道信" & "息提" & "示</th>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<td style=""height:30px"" class=""TableRow2""><img src=""Images/Sigh.gif""/> " & str & "</td>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<td class=tablerow1><font color=""red"">“快问知道”问答系统--您的真心伙伴！为您互联网事业增添活力。<a href=""http://www.kuaishow.com"" target=""_blank"">KuasiShow.Com</a></font></td>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<td align=""center"" class=""TableRow1""><input type=""button"" name=""button2"" id=""button2"" value=""返回管理首页"" onClick=""location.href='?'""></td>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("</table>" & vbCrLf)
'Response.End()
End Sub

Sub Workload(wId, wType, wText)
    Conn.Execute ("insert into " & predb & "Workload(wid,wtype,wtext,wtime) values(" & wId & "," & wType & ",'" & wText & "','" & Now() & "')")
End Sub

Function expask()
	If IsArray(Application("expask")) = False Then
       Call ClsExpask
    Else
      If DateDiff("s", Application("expask")(1), Now()) > CLng(setting(37)) Then Call ClsExpask
    End If
    expask = Application("expask")(0)	
End Function

Sub ClsExpask()
Dim rs,str,sql,Cachevalue(1)
    str=str&"<ul>"&vbcrlf
	set rs= Server.CreateObject("adodb.recordset")
	sql="select top 10 askid,title,asktime,classid,classname from "&predb&"Ask a inner join "&predb&"Class b on a.sclass=b.classid where a.ispass=1 and state=0 Order by AskTime asc"
	rs.open sql,conn,1,1
	do while not rs.eof
	
	str=str&"<li class=""hit1"">[<a href="""
    IF setting(34)=0 Then
	str=str&"List.asp?classid="&rs("CLassID")
	Else
	str=str&siteInfo(1)&"List-"&rs("CLassID")&".html"
	End IF
	str=str&""">"&AskD.leftstr(rs("classname"),8)&"</a>]</li>"&vbcrlf
	str=str&"<li class=""hit2""><a title="""&formatdatetime(rs("asktime"),vbshortdate)&""" href="""
  IF setting(34)=0 Then
  str=str&"ask.asp?id="&rs("askid")&""
  Else
  str=str&siteInfo(1)&"ask-"&rs("askid")&".html"
  End IF
  str=str&""">"&AskD.leftstr(rs("title"),22)&"</a></li>"&vbcrlf
	rs.movenext
	loop
	rs.close
	set rs=nothing
    str=str&"</ul>"&vbcrlf
    Cachevalue(0)=str
	Cachevalue(1)=now()
	
	Application.Lock()
	Application("expask")=Cachevalue
	Application.UnLock()
End Sub

Function xgAsk()
	const pk=3 '截取字符数
	dim rs,sql,key,i,strsql,str

	sql="select top 6 askid,title,asktime,classid,classname from "&predb&"ask a inner join "&predb&"Class b on a.sclass=b.classid where ispass=1 and state<>0 and ("
		strsql="title like '%"&left(title,pk)&"%'"
	for i=pk+1 to len(title)
		key=mid(title,i,pk)
		if len(key)<pk then exit for
		strsql=strsql&" or title like '%"&key&"%'"
	next
	sql=sql&strsql
	sql=sql&") order by askid desc"
	
	set rs = Server.CreateObject("adodb.recordset")
	rs.open sql,conn,1,1
	str=""
	str=str&"<ul>"&vbcrlf
	if not(rs.bof and rs.eof) then
	do while not rs.eof
	
	str=str&"<li class=""lm1"">[<a href="""
    IF setting(34)=0 Then
	str=str&"List.asp?classid="&rs("CLassID")
	Else
	str=str&siteInfo(1)&"List-"&rs("CLassID")&".html"
	End IF
	str=str&""">"&AskD.leftstr(rs("classname"),10)&"</a>]</li>"&vbcrlf
	str=str&"<li class=""lm2""><a title="""&formatdatetime(rs("asktime"),vbshortdate)&""" href="""
  IF setting(34)=0 Then
  str=str&"ask.asp?id="&rs("askid")&""
  Else
  str=str&siteInfo(1)&"ask-"&rs("askid")&".html"
  End IF
  str=str&""">"&AskD.leftstr(rs("title"),80)&"</a></li>"&vbcrlf
  str=str&"<li class = ""lm3"">"&AskD.Ftime(rs("asktime"))&"</li>"&vbcrlf
	rs.movenext
	loop
	rs.close
	set rs=nothing
  else
    str=str&"<li>…暂无相关问题…</li>"&vbcrlf
  end if
	str=str&"</ul>"&vbcrlf
	xgAsk=str
End Function

Sub chkFlag(fn)
IF Request.Cookies("adminflag")<>"0" and instr(Request.Cookies("adminflag"),","&fn&",")=0 Then
Response.Write ("<table class=""tableBorder"" cellspacing=""1"" cellpadding=""2"" width=""96%"" align=""center"" border=""0"">" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<th height=""25"" align=""left"">快" & "问知" & "道信" & "息提" & "示</th>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<td style=""height:30px"" class=""TableRow2""><img src=""../Admin/Images/Sigh.gif""/>您没有该项目的管理权限！</td>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<td class=tablerow1><font color=""red"">“快问知道”问答系统--您的真心伙伴！为您互联网事业增添活力。<a href=""http://www.kuaishow.com"" target=""_blank"">KuasiShow.Com</a></font></td>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("<tr>" & vbCrLf)
Response.Write ("<td align=""center"" class=""TableRow1""><input type=""button"" name=""button2"" id=""button2"" value=""返回管理首页"" onClick=""location.href='?'""></td>" & vbCrLf)
Response.Write ("</tr>" & vbCrLf)
Response.Write ("</table>" & vbCrLf)
Response.End()
End IF
End Sub

Function FriendSite()
Dim rs,str
IF application("friendsite")="" Then
	set rs=conn.execute("select top 9 * from "&predb&"FriendSite where linktype=1 order by id desc")
	if not(rs.bof and rs.eof) then
	str=str&"<div class=""flo"">"&vbcrlf
	str=str&"<ul>"&vbcrlf
	do while not rs.eof
	str=str&"<li><a href=""http://"&rs("siteurl")&""" target=""_blank""><img src="""&rs("logourl")&""" alt="""" border=""0""/></a></li>"&vbcrlf
	rs.movenext
	loop
	str=str&"</ul>"&vbcrlf
	str=str&"</div>"&vbcrlf
	end if
	set rs=nothing
	
	set rs=conn.execute("select * from "&predb&"FriendSite where linktype=2 order by id desc")
	if not(rs.bof and rs.eof) then
	str=str&"<div class=""flx"">"&vbcrlf
	str=str&"<ul>"&vbcrlf
	do while not rs.eof
	str=str&"<li><a href=""http://"&rs("siteurl")&""" target=""_blank"">"&AskD.Leftstr(rs("sitename"),12)&"</a></li>"&vbcrlf
	rs.movenext
	loop
	str=str&"</ul>"&vbcrlf
	str=str&"</div>"&vbcrlf
	end if
	set rs=nothing
	IF str="" Then str=" "
	application.Lock()
	application("friendsite")=str
	application.UnLock()
End IF
FriendSite=application("friendsite")
End Function

Function xsFen()
	dim rs,str
	IF Request.Cookies("Muser")="" Then Exit Function
	set rs=conn.execute("select Score from "&predb&"user where id="&Request.Cookies("Muser"))
	uScore=rs("Score")
	set rs=nothing
	If xShang="" Then
	str=str&"<option value=""0"">0</option>"&vbcrlf
	End If
	If uScore>=5 and xShang<5 Then
    str=str&"<option value=""5"">5</option>"&vbcrlf
	End If
	If uScore>=10 and xShang<10 Then
	str=str&"<option value=""10"">10</option>"&vbcrlf
	End If
	If uScore>=15 and xShang<15 Then
	str=str&"<option value=""15"">15</option>"&vbcrlf
	End If
	If uScore>=20 and xShang<20 Then
	str=str&"<option value=""20"">20</option>"&vbcrlf
	End If
	If uScore>=30 and xShang<30 Then
	str=str&"<option value=""30"">30</option>"&vbcrlf
	End If
	If uScore>=40 and xShang<40 Then
    str=str&"<option value=""40"">40</option>"&vbcrlf
	End If
	If uScore>=50 and xShang<50 Then
	str=str&"<option value=""50"">50</option>"&vbcrlf
	End If
	If uScore>=75 and xShang<75 Then
	str=str&"<option value=""75"">75</option>"&vbcrlf
	End If
	If uScore>=100 and xShang<100 Then
	str=str&"<option value=""100"">100</option>"&vbcrlf
	End If
xsFen=str
End Function

Sub GetIndexClass()
    If IsArray(Application("IndexClass")) = False Then
       Call ClsIndexClass
    Else
      If DateDiff("s", Application("IndexClass")(0), Now()) > CLng(setting(37)) Then Call ClsIndexClass
    End If
    IndexClass = Application("IndexClass")
End Sub

Sub ClsIndexClass()
Dim rs, sql, rs1, i, p, str, Cachevalue(1)
Dim row, col, r
row = setting(53)
col = setting(54)
If row = 0 Then row = 1
If col = 0 Then col = 22
    Set rs = Server.CreateObject("Adodb.recordset")
        rs.cursorlocation = 3
        sql = "select * from " & predb & "Class where esNum=0 order by esPai ASC"
        rs.open sql, conn, 0, 1
        i = 0
        Do While Not rs.EOF
        i = i + 1
        If CLng(setting(7)) > 0 And i > CLng(setting(7)) Then Exit Do
        str = str & "<div class=""big""><a href="""
    If setting(34) = "0" Then
    str = str & "List.asp?classid=" & rs("CLassID")
    Else
    str = str & "List-" & rs("CLassID") & ".html"
    End If
    str = str & """>" & rs("ClassName") & "</a></div>" & vbCrLf
        str = str & "<div class=""small"">" & vbCrLf
        str = str & "<ul>" & vbCrLf
    
    Set rs1 = conn.Execute("select * from " & predb & "Class where esNum=" & rs("CLassID") & " order by esPai ASC")
    p = 0
	r = 0
    Do While Not rs1.EOF
            
    str = str & "<li><a href="""
    If setting(34) = "0" Then
    str = str & "List.asp?classid=" & rs1("CLassID")
    Else
    str = str & "List-" & rs1("CLassID") & ".html"
    End If
    str = str & """>" & rs1("ClassName") & "</a></li>" & vbCrLf
    
    p = AskD.checklen(rs1("ClassName")) + p
    If p >= clng(col) Then
        r = r + 1
        If r >= clng(row) Then Exit Do
       p = 0
       str = str & "</ul><ul>"
    End If
    
    rs1.movenext
    Loop
    rs1.Close
        Set rs1 = Nothing
	IF row<2 Then
    str = str & "<li><a href="""
    If setting(34) = 0 Then
    str = str & "List.asp?classid=" & rs("CLassID")
    Else
    str = str & "List-" & rs("CLassID") & ".html"
    End If
    str = str & """>&raquo;</a></li>" & vbCrLf
    End IF
    str = str & "</ul>" & vbCrLf
    str = str & "</div>" & vbCrLf
    str = str & "<div class=""line""></div>" & vbCrLf
    rs.movenext
    Loop
    rs.Close
    Set rs = Nothing
    Cachevalue(0) = Now()
    Cachevalue(1) = str
    Application.Lock
    Application("IndexClass") = Cachevalue
    Application.UnLock
End Sub
%>