<% Server.ScriptTimeOut = 9999999 Dim NeedCheckComeUrl If NeedCheckComeUrl = True Then Call CheckComeUrl End If Dim ObjInstalled_FSO, fso ObjInstalled_FSO = IsObjInstalled("Scripting.FileSystemObject") If ObjInstalled_FSO = True Then Set fso = Server.CreateObject("Scripting.FileSystemObject") Else Response.Write "
  • FSO组件不可用,各种与FSO相关的功能都将出错!请运行Install.asp或者到后台网站配置处设置好FSO组件名称。
  • " End If 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 Sub CheckComeUrl() Dim ComeUrl, TrueSiteUrl, cUrl ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER")) TrueSiteUrl = Trim(Request.ServerVariables("HTTP_HOST")) If ComeUrl = "" Then Response.Write "

    不允许直接输入地址访问此页面

    " Response.End Else cUrl = Trim("http://" & TrueSiteUrl) & ScriptName If LCase(Left(ComeUrl, InStrRev(ComeUrl, "/"))) <> LCase(Left(cUrl, InStrRev(cUrl, "/"))) Then Response.Write "

    不允许从外部链接访问此页面

    " Response.End End If End If End Sub '检查登录 Dim AdminID, AdminName, AdminPassword, RndPassword, AdminLoginCode Dim rsGetAdmin, sqlGetAdmin AdminName = ReplaceBadChar(Trim(Request.Cookies("AdminName"))) AdminPassword = ReplaceBadChar(Trim(Request.Cookies("AdminPassword"))) 'RndPassword = ReplaceBadChar(Trim(Request.Cookies("RndPassword"))) 'AdminLoginCode = ReplaceBadChar(Trim(Request.Cookies("AdminLoginCode"))) If AdminName = "" Or AdminPassword = "" Then 'Or RndPassword = "" Or (AdminLoginCode <> SiteManageCode) 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 If rsGetAdmin("status") = False Then response.write "用户已锁定!" response.End Call CloseConn End If Public Sub ShowJS_Manage(ItemName) Dim strJS Response.Write "" & vbCrLf End Sub Public Function GetRootClass() Dim sqlRoot, rsRoot, strRoot sqlRoot = "select ClassID,ClassName,RootID,Child from class where ChannelID=" & ChannelID & " and ParentID=0 and ClassType=1 order by RootID" Set rsRoot = Conn.Execute(sqlRoot) If rsRoot.BOF And rsRoot.EOF Then strRoot = "沒有分類" Else strRoot = "| " Do While Not rsRoot.EOF If rsRoot(2) = RootID Then strRoot = strRoot & "" & rsRoot(1) & " | " Else strRoot = strRoot & "" & rsRoot(1) & " | " End If rsRoot.MoveNext Loop End If rsRoot.Close Set rsRoot = Nothing GetRootClass = strRoot End Function Public Function GetChild_Root() Dim sqlChild, rsChild, arrParentPath, isCurrent, strChild, i If RootID <= 0 Then GetChild_Root = "" Exit Function End If sqlChild = "select ClassID,ClassName,Child from class where ChannelID=" & ChannelID & " and Depth=1 and RootID=" & RootID & " order by OrderID" Set rsChild = Conn.Execute(sqlChild) If Not (rsChild.BOF And rsChild.EOF) Then i = 1 arrParentPath = Split(ParentPath, ",") strChild = "" Do While Not rsChild.EOF If Depth <= 1 Then If rsChild(0) = ClassID Then isCurrent = True Else isCurrent = False End If Else If PE_CLng(arrParentPath(2)) = rsChild(0) Then isCurrent = True Else isCurrent = False End If End If If isCurrent = True Then strChild = strChild & "  " & rsChild(1) & "" Else strChild = strChild & "  " & rsChild(1) & "" End If If rsChild(2) > 0 Then strChild = strChild & "(" & rsChild(2) & ")" End If If i Mod 8 = 0 Then strChild = strChild & "
    " Else strChild = strChild & "  " End If rsChild.MoveNext i = i + 1 Loop strChild = strChild & "" End If rsChild.Close Set rsChild = Nothing GetChild_Root = strChild End Function Function GetNewID(SheetName, FieldName) Dim mrs Set mrs = Conn.Execute("select max(" & FieldName & ") from " & SheetName & "") If IsNull(mrs(0)) Then GetNewID = 1 Else GetNewID = mrs(0) + 1 End If Set mrs = Nothing End Function Public Function ShowClassPath() If ParentPath = "" Or IsNull(ParentPath) Then ShowClassPath = "不属于任何区域" Exit Function End If Dim strPath If Depth > 0 Then Dim rsPath Set rsPath = Conn.Execute("select * from class where ClassID in (" & ParentPath & ") order by Depth") Do While Not rsPath.EOF strPath = strPath & rsPath("ClassName") & " >> " rsPath.MoveNext Loop rsPath.Close Set rsPath = Nothing End If strPath = strPath & ClassName ShowClassPath = strPath End Function Function GetClass_Option(ShowType, CurrentID) Dim rsClass, sqlClass, strClass_Option, tmpDepth, i, ClassNum Dim arrShowLine(20) ClassNum = 1 'CurrentID = PE_CLng(CurrentID) For i = 0 To UBound(arrShowLine) arrShowLine(i) = False Next sqlClass = "Select * from class where ChannelID=" & ChannelID & " 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 ClassNum = ClassNum + 1 tmpDepth = rsClass("Depth") If rsClass("NextID") > 0 Then arrShowLine(tmpDepth) = True Else arrShowLine(tmpDepth) = False End If If ShowType = 1 Then If rsClass("ClassType") = 2 Then strClass_Option = strClass_Option & "" ClassNum = ClassNum + 1 rsClass.MoveNext Loop End If rsClass.Close Set rsClass = Nothing If ShowType = 3 And AdminPurview = 1 Then strClass_Option = strClass_Option & "" End If If ShowType = 0 And AdminPurview = 1 Then strClass_Option = strClass_Option & "" End If GetClass_Option = strClass_Option 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 " " Response.Write " " Response.Write " " Response.Write " " Response.Write " " Response.Write " " Response.Write " " Response.Write " " Response.Write " " Response.Write "
    批量移动" & ChannelShortName & "
    " Response.Write " 指定" & ChannelShortName & "ID:
    " Response.Write " 指定区域的" & ChannelShortName & ":

    " Response.Write " " Response.Write " " Response.Write "
    移动到>>" Response.Write " 目标区域:(不能指定为外部区域)
    " Response.Write "
    " Response.Write "

    " Response.Write " " Response.Write " " Response.Write "   " Response.Write " " Response.Write "

    " Response.Write "
    " Response.Write "" & vbCrLf End Sub 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 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 %>