<%
Action = Trim(Request("Action"))
MaxPerPage = 20
ChannelID = Request("ChannelID")
if channelid = "" then channelid = 1
'检查管理员是否登录
Dim AdminID, AdminName, AdminPassword, AdminLoginCode, AdminPurview, PurviewPassed
Dim rsGetAdmin, sqlGetAdmin
AdminName = ReplaceBadChar(Trim(Request.Cookies("AdminName")))
AdminPassword = ReplaceBadChar(Trim(Request.Cookies("AdminPassword")))
if useSiteManageCode = true then
AdminLoginCode = ReplaceBadChar(Trim(Request.Cookies("AdminLoginCode")))
else
AdminLoginCode = SiteManageCode
end if
If AdminName = "" Or AdminPassword = "" Or AdminLoginCode <> SiteManageCode Then
Call CloseConn
Response.redirect "login.asp"
End If
sqlGetAdmin = "select * from t_user_info where uid='" & AdminName & "' and pwd='" & AdminPassword & "'"
Set rsGetAdmin = Server.CreateObject("adodb.recordset")
rsGetAdmin.Open sqlGetAdmin, Conn, 1, 1
If rsGetAdmin.BOF And rsGetAdmin.EOF Then
rsGetAdmin.Close
Set rsGetAdmin = Nothing
Call CloseConn
Response.redirect "login.asp"
End If
AdminID = rsGetAdmin("ID")
AdminName = rsGetAdmin("uid")
'**************************************************
'函数名：IsObjInstalled
'作 用：检查组件是否已经安装
'参 数：strClassString ----组件名
'返回值：True ----已经安装
' False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = CreateObject(strClassString)
If Err.Number = 0 Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
dim ObjInstalled_FSO, fso
ObjInstalled_FSO = IsObjInstalled("Scripting.FileSystemObject")
If ObjInstalled_FSO = True Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Else
Response.Write "
"
End If
Sub ShowPageTitle(strTitle)
Response.Write "
" & vbCrLf
Response.Write "
" & strTitle & "
" & vbCrLf
Response.Write "
" & vbCrLf
End Sub
'**************************************************
'函数名：ShowJS_Manage
'作 用：通用频道管理js验证(多项诓全选,删除提示,移动)
'参 数：ItemName ---- 项目名称
'返回值：javascript 验证
'**************************************************
Public Sub ShowJS_Manage(ItemName)
Dim strJS
Response.Write "" & vbCrLf
End Sub
Sub ShowContentManagePath(RootName)
Response.Write "您现在的位置： " & ChannelName & "管理 >> " & RootName & " >> "
If ClassID > 0 Then
If ParentID > 0 Then
Dim sqlPath, rsPath
sqlPath = "select ClassID,ClassName from Class where ClassID in (" & ParentPath & ") order by Depth"
Set rsPath = Conn.Execute(sqlPath)
Do While Not rsPath.EOF
Response.Write "" & rsPath(1) & " >> "
rsPath.MoveNext
Loop
rsPath.Close
Set rsPath = Nothing
End If
Response.Write "" & ClassName & " >> "
End If
If ManageType = "My" Then
Response.Write "" & AdminName & " 添加的" & ChannelShortName & ""
Else
If Keyword = "" Then
Select Case Status
Case -2
Response.Write "退稿"
Case -1
Response.Write "草稿"
Case 0
Response.Write "待审核的" & ChannelShortName & "！"
Case 1
Response.Write "已审核的" & ChannelShortName & "！"
Case Else
Response.Write "所有" & ChannelShortName & "！"
End Select
Else
Select Case strField
Case "Title"
Response.Write "标题中含有 " & Keyword & " "
Case "Content"
Response.Write "内容中含有 " & Keyword & " "
Case "Author"
Response.Write "作者姓名中含有 " & Keyword & " "
Case "Inputer"
Response.Write "" & Keyword & " 添加"
Case "Editor"
Response.Write "" & Keyword & " 审核"
Case "Keyword"
Response.Write "关键字为 " & Keyword & " "
Case "UpdateTime"
Response.Write "更新时间为 " & Keyword & " "
Case "SoftName", "PhotoName"
Response.Write "名称中含有 " & Keyword & " "
Case "SoftIntro", "PhotoIntro"
Response.Write "内容中含有 " & Keyword & " "
Case Else
Response.Write "名称中含有 " & Keyword & " "
End Select
Select Case Status
Case -2
Response.Write "的退稿"
Case -1
Response.Write "的草稿"
Case 0
Response.Write "并且未审核的" & ChannelShortName & "！"
Case 1
Response.Write "并且已审核的" & ChannelShortName & "！"
Case Else
Response.Write "的" & ChannelShortName & "！"
End Select
End If
End If
End Sub
'**************************************************
'函数名：ShowPage
'作 用：显示“上一页 下一页”等信息
'参 数：sFileName ----链接地址
' TotalNumber ----总数量
' MaxPerPage ----每页数量
' CurrentPage ----当前页
' ShowTotal ----是否显示总数量
' ShowAllPages ---是否用下拉列表显示所有页面以供跳转。
' strUnit ----计数单位
' ShowMaxPerPage ----是否显示每页信息量选项框
'返回值：“上一页 下一页”等信息的HTML代码
'**************************************************
Function ShowPage(sfilename, totalnumber, MaxPerPage, CurrentPage, ShowTotal, ShowAllPages, strUnit, ShowMaxPerPage)
Dim TotalPage, strTemp, strUrl, i
If totalnumber = 0 Or MaxPerPage = 0 Or IsNull(MaxPerPage) Then
ShowPage = ""
Exit Function
End If
If totalnumber Mod MaxPerPage = 0 Then
TotalPage = totalnumber \ MaxPerPage
Else
TotalPage = totalnumber \ MaxPerPage + 1
End If
If CurrentPage > TotalPage Then CurrentPage = TotalPage
strTemp = "
"
If ShowTotal = True Then
strTemp = strTemp & "共 " & totalnumber & " " & strUnit & " "
End If
If ShowMaxPerPage = True Then
strUrl = JoinChar(sfilename) & "MaxPerPage=" & MaxPerPage & "&"
Else
strUrl = JoinChar(sfilename)
End If
If CurrentPage = 1 Then
strTemp = strTemp & "首页 上一页 "
Else
strTemp = strTemp & "首页 "
strTemp = strTemp & "上一页 "
End If
If CurrentPage >= TotalPage Then
strTemp = strTemp & "下一页 尾页"
Else
strTemp = strTemp & "下一页 "
strTemp = strTemp & "尾页"
End If
strTemp = strTemp & " 页次：" & CurrentPage & "/" & TotalPage & "页 "
If ShowMaxPerPage = True Then
strTemp = strTemp & " " & strUnit & "/页"
Else
strTemp = strTemp & " " & MaxPerPage & "" & strUnit & "/页"
End If
If ShowAllPages = True Then
If TotalPage > 20 Then
strTemp = strTemp & " 转到第页"
Else
strTemp = strTemp & " 转到："
End If
End If
strTemp = strTemp & "
"
ShowPage = strTemp
End Function
Function JoinChar(ByVal strUrl)
If strUrl = "" Then
JoinChar = ""
Exit Function
End If
If InStr(strUrl, "?") < Len(strUrl) Then
If InStr(strUrl, "?") > 1 Then
If InStr(strUrl, "&") < Len(strUrl) Then
JoinChar = strUrl & "&"
Else
JoinChar = strUrl
End If
Else
JoinChar = strUrl & "?"
End If
Else
JoinChar = strUrl
End If
End Function
Function FilterArrNull(ByVal ArrString, ByVal CompartString)
Dim arrContent, arrTemp, i
If CompartString = "" Or ArrString = "" Then
FilterArrNull = ArrString
Exit Function
End If
If InStr(ArrString, CompartString) = 0 Then
FilterArrNull = ArrString
Exit Function
Else
arrContent = Split(ArrString, CompartString)
For i = 0 To UBound(arrContent)
If Trim(arrContent(i)) <> "" Then
If arrTemp = "" Then
arrTemp = Trim(arrContent(i))
Else
arrTemp = arrTemp & CompartString & Trim(arrContent(i))
End If
End If
Next
End If
FilterArrNull = arrTemp
End Function
Sub ShowForm_MoveToClass()
Dim tChannelID, BatchInfoID
tChannelID = Trim(Request("tChannelID"))
If tChannelID = "" Then
tChannelID = ChannelID
Else
tChannelID = CLng(tChannelID)
End If
BatchInfoID = ReplaceBadChar(Request("Batch" & ModuleName & "ID"))
If BatchInfoID = "" Then
BatchInfoID = ReplaceBadChar(Request(ModuleName & "ID"))
End If
Response.Write ""
Response.Write "" & vbCrLf
End Sub
'**************************************************
'函数名：GetClass_Channel
'作 用：区域下拉菜单(不检查权限)
'参 数：iChannelID ---- 频道ID
'返回值：区域下拉菜单
'**************************************************
Function GetClass_Channel(iChannelID)
Dim rsClass, sqlClass, strClass_Option, tmpDepth, i
Dim arrShowLine(20)
For i = 0 To UBound(arrShowLine)
arrShowLine(i) = False
Next
sqlClass = "Select * from Class where ChannelID=" & iChannelID & " order by RootID,OrderID"
Set rsClass = Conn.Execute(sqlClass)
If rsClass.BOF And rsClass.EOF Then
strClass_Option = strClass_Option & ""
Else
Do While Not rsClass.EOF
tmpDepth = rsClass("Depth")
If rsClass("NextID") > 0 Then
arrShowLine(tmpDepth) = True
Else
arrShowLine(tmpDepth) = False
End If
If rsClass("ClassType") = 2 Then
strClass_Option = strClass_Option & ""
rsClass.MoveNext
Loop
End If
rsClass.Close
Set rsClass = Nothing
strClass_Option = strClass_Option & ""
GetClass_Channel = strClass_Option
End Function
'**************************************************
'函数名：GetChannel_Option
'作 用：频道下拉菜单
'参 数：iModuleType ---- 频道类型
' iChannelID ---- 频道ID
'返回值：频道下拉菜单目
'**************************************************
Function GetChannel_Option(iModuleType, iChannelID)
Dim rsGetAdmin, rsChannel
Dim strChannel
Set rsChannel = Conn.Execute("select * from Channel where ChannelID=" & iChannelID & " order by OrderID")
Do While Not rsChannel.EOF
If rsChannel(0) = iChannelID Then
strChannel = strChannel & ""
Else
strChannel = strChannel & ""
End If
rsChannel.MoveNext
Loop
rsChannel.Close
Set rsChannel = Nothing
GetChannel_Option = strChannel
End Function
'**************************************************
'函数名：ShowJS_Main
'作 用：页面管理js(多项诓全选,删除提示)
'参 数：ItemName ---- 项目名称
'返回值：javascript 验证
'**************************************************
Public Sub ShowJS_Main(ItemName)
Response.Write "" & vbCrLf
End Sub
'**************************************************
'函数名：FoundInArr
'作 用：检测数组中是否有指定的数值
'参 数：strArr ----- 调入的数组
' strItem ----- 检测的字符
' strSplit ----- 分割字符
'返回值：True ----有
' False ----没有
'**************************************************
Function FoundInArr(strArr, strItem, strSplit)
Dim arrTemp, arrTemp2, i, j
FoundInArr = False
If IsNull(strArr) Or IsNull(strItem) Or Trim(strArr) = "" Or Trim(strItem) = "" Then
Exit Function
End If
If IsNull(strSplit) Or strSplit = "" Then
strSplit = ","
End If
If InStr(Trim(strArr), strSplit) > 0 Then
If InStr(Trim(strItem), strSplit) > 0 Then
arrTemp = Split(strArr, strSplit)
arrTemp2 = Split(strItem, strSplit)
For i = 0 To UBound(arrTemp)
For j = 0 To UBound(arrTemp2)
If LCase(Trim(arrTemp2(j))) <> "" And LCase(Trim(arrTemp(i))) <> "" And LCase(Trim(arrTemp2(j))) = LCase(Trim(arrTemp(i))) Then
FoundInArr = True
Exit Function
End If
Next
Next
Else
arrTemp = Split(strArr, strSplit)
For i = 0 To UBound(arrTemp)
If LCase(Trim(arrTemp(i))) = LCase(Trim(strItem)) Then
FoundInArr = True
Exit Function
End If
Next
End If
Else
If LCase(Trim(strArr)) = LCase(Trim(strItem)) Then
FoundInArr = True
End If
End If
End Function
%>