%
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 "
"
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
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 "" & 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
%>