admin_classcommon.asp

依蓝旅游网站管理系统Elan2008.SP2

	  ClassA = ""
	  RowCount = ClassCmd(0)
	  If RowCount < 1 Then
	     RetString = "<tr><td class='top_25'>您还没有添加"& EL_Channel.ClassItemName &"，<a href='Admin_Class.asp?ChannelID="& EL_Channel.ChannelID &"&Action=Add' class='white'>点击添加"& EL_Channel.ClassItemName &"</a></td></tr>"
	  Else
	     Dim i, ScriptName
		 ScriptName = EL_CurrentScriptName &"?"& URL
		 rsClass.Open()
		 If ParentID = 0 Then 
		    RetString = RetString &"<tr><td class='top_25'>| "
			ClassA = "white"
		 End If
		 TempParentID = 0
		 For i = 1 To RowCount
		    Dim Temp, TempAllChild
			TempAllChild = GetAllChildID(rsClass(0))
			Temp = FoundInArray(Split(TempAllChild, ","), ClassID)
			If Temp = True Or ClassID = rsClass(0) Then TempParentID = rsClass(0)
		    If ClassID = rsClass(0) Or Temp = True Then
		       RetString = RetString &"<a href='"& ScriptName &"&ClassID="& rsClass(0) &"' class='"& ClassA &"'><span class=redtext>"& rsClass(1) &"</span></a> | "
			Else
			   RetString = RetString &"<a href='"& ScriptName &"&ClassID="& rsClass(0) &"' class='"& ClassA &"'>"& rsClass(1) &"</a> | "
			End If
			If (i Mod 10) = 0 And i<RowCount Then RetString = RetString &"</td></tr><tr><td class='top_25'>| "
		    If i<RowCount Then rsClass.MoveNext
		 Next
		 RetString = RetString &"</td></tr>"
		 rsClass.Close()
		 If TempParentID<>0 And GetAllChildID(TempParentID)<>"" Then
		    Set rsClass = Nothing
		    RetString = RetString &"<tr><td class='item_25'>"
			Call DeleteCmdParameters(ClassCmd, 3)
			With ClassCmd
			   .Parameters.Append .CreateParameter("RETURN", 3, 4, 4)
			   .Parameters.Append .CreateParameter("@ParentID", 3, 1, 4, TempParentID)
			   .Parameters.Append .CreateParameter("@ChannelID", 3, 1, 4, EL_Channel.ChannelID)
			   Set rsClass = .Execute()
			End With 
			rsClass.Close()
			RowCount = ClassCmd(0)
			rsClass.Open()
			For i = 1 To RowCount
			   Dim arr
			   arr = Split(GetAllChildID(rsClass(0)), ",")
			   If ClassID = rsClass(0) Or FoundInArray(arr, ClassID)=True Then
		          RetString = RetString &"<a href='"& ScriptName &"&ClassID="& rsClass(0) &"'><span class=redtext>"& rsClass(1) &"("& UBound(arr)+1 &")</span></a>&nbsp;&nbsp;"
			   Else
			      RetString = RetString &"<a href='"& ScriptName &"&ClassID="& rsClass(0) &"'>"& rsClass(1) &"("& UBound(arr)+1 &")</a>&nbsp;&nbsp;"
			   End If
			   If (i Mod 10) = 0 And i<RowCount Then RetString = RetString &"</td></tr><tr><td class='td_25'>"
			   If i<RowCount Then rsClass.MoveNext
			Next
			RetString = RetString &"</td></tr>"
			rsClass.Close()
		 End If
	  End If
	  RetString = RetString &"</table>"
	  Set rsClass = Nothing
	  Set ClassCmd = Nothing
	  ShowClassList = RetString
   End Function
   
   Public Function Data2Options(ByVal TableName, ByVal ValueField, ByVal TextField, ByVal DefaultValue, ByVal SqlCondition)
      Dim OptCmd, rsOpt, RowCount, i, RetString
	  Dim SqlField, Value, Text
	  If ValueField = TextField Then 
	     SqlField = ValueField
	  Else
	     SqlField = ValueField &","& TextField
	  End If
	  Call InitCommonCmd(OptCmd, rsOpt, TableName, SqlField, SqlCondition)
	  rsOpt.Close()
	  RowCount = OptCmd(0)
	  If RowCount = 0 Then
	     Data2Options = ""
		 Set rsOpt = Nothing
		 Set OptCmd = Nothing
		 Exit Function
	  Else
	     RetString = ""
		 rsOpt.Open()
	     For i = 1 To RowCount
		    If ValueField = TextField Then
			   Value = rsOpt(0)
			   Text = Value
			Else
			   Value = rsOpt(0)
			   Text = rsOpt(1)
			End If
			If FoundInArray(Split(DefaultValue, ","), Value) Then
		       RetString = RetString &"<option value='"& EL_Common.HTMLEncode(Value) &"' selected>"& ServerHTMLEncode(Text) &"</option>"
			Else
			   RetString = RetString &"<option value='"& EL_Common.HTMLEncode(Value) &"'>"& ServerHTMLEncode(Text) &"</option>"
			End If
			If i < RowCount Then rsOpt.MoveNext()
		 Next
		 rsOpt.Close()
	  End If
	  Set rsOpt = Nothing
	  Set OptCmd = Nothing
	  Data2Options = RetString
   End Function
   
   Public Function Join2String(ByVal Str1, ByVal Str2, StrSeprate)
      If Str1="" OR IsNULL(Str1) Then
	     Join2String = Str2
	  Else
	     If Str2="" OR IsNULL(Str2) Then
		    Join2String = Str1
		 Else
		    Join2String = Str1 & StrSeprate & Str2
		 End If
	  End If
   End Function
      
   Public Function ShowBoolean(ByVal bValue, TrueText, FalseText)
      If LCase(TypeName(bValue)) <> "boolean" Then
	     ShowBoolean = ""
		 Exit Function
	  End If
	  If bValue = True Then
	     ShowBoolean = TrueText
	  Else
	     ShowBoolean = FalseText
	  End If
   End Function
   
   Public Function CheckIsPictrue(ByVal str)
      CheckIsPictrue = False
	  If Trim(str) = "" Or IsNULL(str) Then Exit Function
	  Dim Temp, ArrExt, i
	  ArrExt = Split("jpg|bmp|gif|png", "|")
	  Temp = Right(str, Len(str)-InstrRev(str, "."))
	  For i = 0 To Ubound(ArrExt)
	     If Temp = ArrExt(i) Then
		    CheckIsPictrue = True
			Exit Function
		 End If
	  Next
   End Function
   
   Public Function PictrueURL(ByVal URL, ByVal FilePath)
      PictrueURL = InstallDir &"Images/nopic.gif"
      If Trim(URL) = "" Or IsNULL(URL) Then Exit Function
	  URL = Trim(replace(LCase(URL), "\", "/"))
	  If Instr(URL, "http://") = 1 Or Left(URL, 1) = "/"Then
	     PictrueURL = URL
	  Else
	     PictrueURL = FilePath & URL
	  End If
   End Function
   
   Public Function FoundInArray(ByVal arr, ByVal FoundValue)
      FoundInArray = False
	  If IsArray(arr) = False Or Trim(FoundValue)="" Or IsNULL(FoundValue) Then Exit Function
	  If UBound(arr) < 0 Then Exit Function
      Dim i
	  For i = 0 To UBound(arr)
	     If Trim(arr(i)) = Trim(FoundValue) Then
		    FoundInArray = True
			Exit Function
		 End If
	  Next
   End Function
   
   Public Function SetObjectChecked(StrValue, DefaultValue)
      If Trim(StrValue) = Trim(DefaultValue) Then
         SetObjectChecked = "checked"
      Else
         SetObjectChecked = ""
      End If
   End Function
   
   Public Function SetObjectSelected(StrValue, DefaultValue)
      If Trim(StrValue) = Trim(DefaultValue) Then
         SetObjectSelected = "Selected"
      Else
         SetObjectSelected = ""
      End If
   End Function
   
   Public Function ShowClassTree(ByVal ChannelID, ByVal ParentID, ByVal DefaultClassID, ParentString)
	  Dim ClassCmd, rsClass
	  Dim RowCount, MaxOrderID, ParentMaxOrderID, ParentOrderID, i
	  Dim Result, TempString, Selected
	  Call InitCommand(ClassCmd, "EL_SP_ClassTree")
	  With ClassCmd
	     .Parameters.Append .CreateParameter("RETURN", 3, 4, 4)
		 .Parameters.Append .CreateParameter("@ChannelID", 3, 1, 4, ChannelID)
		 .Parameters.Append .CreateParameter("@ParentID", 3, 1, 4, ParentID)
		 .Parameters.Append .CreateParameter("@MaxOrderID", 3, 2, 4)
		 .Parameters.Append .CreateParameter("@ParentMaxOrderID", 3, 2, 4)
		 .Parameters.Append .CreateParameter("@ParentOrderID", 3, 2, 4)
		 .Parameters.Append .CreateParameter("@MinOrderID", 3, 2, 4)
		 Set rsClass = .Execute
	  End With
	  rsClass.Close()
	  If ClassCmd(0) = 0 Then
	     ShowClassTree = ""
		 Set rsClass = Nothing
		 Set ClassCmd = Nothing
		 Exit Function
	  End If
	  RowCount = ClassCmd(0)
	  MaxOrderID = ClassCmd(3)
	  ParentMaxOrderID = ClassCmd(4)
	  ParentOrderID = ClassCmd(5)
	  rsClass.Open()
	  Result = ""
	  For i=1 To RowCount
	     TempString = ""
		 Selected = ""
		 If ParentID <> 0 Then 
		    If ParentString <> "" Then
	           If ParentMaxOrderID = ParentOrderID Then
		          TempString = Left(ParentString,Len(ParentString)-1) &"&nbsp;"
		       Else
		          TempString = Left(ParentString,Len(ParentString)-1) &"│"
		       End If
	        Else
	           TempString = ParentString
	        End If
		    If rsClass(2) >= MaxOrderID Then
			   TempString = TempString &"&nbsp;└"
			Else
			   TempString = TempString &"&nbsp;├"
			End If
		 End If
		 If rsClass(0) = ELClng(DefaultClassID) Then Selected = "selected"
		 If EL_Admin.Purview = 1 Or EL_Admin.Purview = 2 Then
		    Result = Result &"<option value='"& rsClass(0) &"' "& Selected &">"& TempString & rsClass(1) &"</option>"
		 Else
		    If EL_Admin.CheckAdminPurview(rsClass(0), 2) = True Then
			   Result = Result &"<option value='"& rsClass(0) &"' "& Selected &" style='background-color:green;color:#FFFFFF;'>"& TempString & rsClass(1) &"</option>"
			Else
			   Result = Result &"<option value='"& rsClass(0) &"' "& Selected &">"& TempString & rsClass(1) &"</option>"
			End If
		 End If
		 Result = Result & ShowClassTree(ChannelID, rsClass(0), DefaultClassID, TempString)
		 If i<RowCount Then rsClass.MoveNext
	  Next
	  rsClass.Close()
	  Set rsClass = Nothing
	  Set ClassCmd = Nothing
	  ShowClassTree = Result
   End Function
   
   Public Sub ShowSuccessMsg(SuccessMsg)
      Dim strSuccess
      strSuccess = strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"
      strSuccess = strSuccess & "<br><table cellpadding=5 cellspacing=1 border=0 width=400 style='border:1px solid #70777b' align=center>"
      strSuccess = strSuccess & "  <tr align='center' style='background:#0650D2;color:#FFFFFF;font-size:12px;'><td height='22'><strong>恭喜你！</strong></td></tr>"
      strSuccess = strSuccess & "  <tr style='background:#F0F1F5;font-size:12px;'><td height='100' valign='top'><br>" & SuccessMsg & "</td></tr>"
      strSuccess = strSuccess & "  <tr align='center' style='background:#F0F1F5;font-size:12px;'><td>"
      If ComeURL <> "" Then
         strSuccess = strSuccess & "<a href='" & ComeURL & "'>【返回上一页】</a>"
      Else
         strSuccess = strSuccess & "<a href='javascript:window.opener=null;window.close();'>【关闭】</a>"
      End If
      strSuccess = strSuccess & "</td></tr>"
      strSuccess = strSuccess & "</table><br>"
      strSuccess = strSuccess & "</body></html>"
      Response.Write strSuccess
   End Sub
   
   Public Sub ShowErrorMsg(ErrorMsg)
      Dim strError
      strError = strError & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
      strError = strError & "<br><table cellpadding=5 cellspacing=1 border=0 width=400 style='border:1px solid #70777b' align=center>" & vbCrLf
      strError = strError & "  <tr align='center' style='background:#0650D2;color:#FFFFFF;font-size:12px;'><td height='25'><strong>错误信息</strong></td></tr>" & vbCrLf
      strError = strError & "  <tr style='background:#F0F1F5;font-size:12px;'><td height='100' valign='top'><font color=red>" & ErrorMsg & "</font></td></tr>" & vbCrLf
      strError = strError & "  <tr align='center' style='background:#F0F1F5;font-size:12px;'><td>"
      If ComeURL <> "" Then
         strError = strError & "<a href='javascript:history.back()'>【返回上一页】</a>"
      Else
        strError = strError & "<a href='javascript:window.opener=null;window.close();'>【关闭】</a>"
      End If
      strError = strError & "</td></tr>" & vbCrLf
      strError = strError & "</table><br>" & vbCrLf
      strError = strError & "</body></html>" & vbCrLf
      Response.Write strError
   End Sub
   
   Public Sub InitCommand(ObjectCmd, SpName)
      Set ObjectCmd = Server.CreateObject("ADODB.COMMAND")
	  With ObjectCmd
	     .ActiveConnection = Conn
		 .CommandText = SpName
		 .CommandType = 4
		 .Prepared = True
	  End With
   End Sub
   
   Public Sub InitCommonCmd(ObjectCmd, ObjectRecordSet, TableName, ArrFields, StrCondition)
      Set ObjectCmd = Server.CreateObject("ADODB.COMMAND")
	  With ObjectCmd
	     .ActiveConnection = Conn
		 .CommandText = "EL_SP_CommonPROC"
		 .CommandType = 4
		 .Prepared = True
		 .Parameters.Append .CreateParameter("RETURN", 3, 4, 4)
		 .Parameters.Append .CreateParameter("@TableName", 200, 1, StrLength(TableName), TableName)
		 .Parameters.Append .CreateParameter("@ArrFields", 200, 1, StrLength(ArrFields), ArrFields)
		 .Parameters.Append .CreateParameter("@StrCondition", 200, 1, StrLength(StrCondition), StrCondition)
		 Set ObjectRecordSet = .Execute()
	  End With
   End Sub
   
   Public Sub DeleteCmdParameters(ObjectCmd, ParametersCount)
      Dim i
	  For i=ParametersCount-1 To 0 Step -1
		  ObjectCmd.Parameters.Delete i
	  Next
   End Sub
   
   Public Function LenParameter(strParameter)
      If Trim(strParameter)="" Or IsNULL(strParameter) Then
	     LenParameter = 1
	  Else
	     LenParameter = Len(strParameter)
	  End If	  
   End Function
   
   Public Function ReplaceBadChar(ByVal bString)
      If bString = "" Or IsNull(bString) Then
          ReplaceBadChar = ""
          Exit Function
      End If
	  If EL_BadChar = "" Then Exit Function
      Dim ArrBadChar, TempString, i
      ArrBadChar = Split(EL_BadChar, ",")
      TempString = bString
      For i = 0 To UBound(ArrBadChar)
        TempString = Replace(TempString, ArrBadChar(i), "")
      Next
      ReplaceBadChar = TempString
   End Function