admin_classcommon.asp

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

<%
Class Class_Common  

   Private LangXML, CommonRegExp
    
   Private Sub Class_Initialize()  
      Set LangXML = Server.CreateObject("Microsoft.XMLDOM")
	  LangXML.async = False
	  LangXML.load(Server.MapPath(InstallDir &"Language/lang.xml")) 
	  
	  Set CommonRegExp = New RegExp
	  CommonRegExp.IgnoreCase = True 
      CommonRegExp.Global = True
   End Sub
   
   Private Sub Class_Terminate()
      Set LangXML = Nothing
	  Set CommonRegExp = Nothing
   End Sub
   
   Public Function ReplaceText(ByVal StrText, ByVal StrPattern, ByVal RContent)
      Dim Match, Matches, ReturnString 	  
	  CommonRegExp.Pattern = StrPattern
      Set Matches = CommonRegExp.Execute(StrText)
	  ReturnString = StrText
      For Each Match in Matches
		 ReturnString = Replace(StrText, Match.Value, RContent)
      Next
	  
	  Set Matches = Nothing	  
	  ReplaceText = ReturnString
   End Function
   
   Public Sub CreateFile(ByVal FileContent, ByVal FilePath, ByVal IsCover)
      Dim FSO, ObjectFile
	  Set FSO = Server.CreateObject(Object_FSO)
	  Set ObjectFile = FSO.CreateTextFile(Server.MapPath(FilePath), IsCover)
	  ObjectFile.Write FileContent
	  ObjectFile.Close
	  Set ObjectFile = Nothing
	  Set FSO = Nothing
   End Sub
      
   Public Function RequestDefineField(ByVal ChannelID)
      Dim FieldCmd, rsField, RowCount, i, RetString
	  RetString = ""
	  Call InitCommonCmd(FieldCmd, rsField, "EL_Field", "FieldName, FieldType", "ChannelID="& ChannelID)
	  rsField.Close()
	  RowCount = FieldCmd(0)
	  rsField.Open()
	  For i = 1 To RowCount
		 Select Case rsField(1)
		   Case 1, 2, 3, 4:
		      RetString = Join2String(RetString, rsField(0) &"='"& ELRequest(rsField(0), 3) &"'", ",")
		   Case 5, 6, 7:
		      RetString = Join2String(RetString, rsField(0) &"="& ELRequest(rsField(0), 3), ",")
		 End Select
		 If i<RowCount Then rsField.MoveNext()
	  Next
	  rsField.Close()
	  Set rsField = Nothing
	  Set FieldCmd = Nothing
	  RequestDefineField = RetString
   End Function
   
   Public Function ShowDefinedField_Js(ByVal ChannelID, FormName)
      Dim FieldCmd, rsField, RowCount, i, RetString
	  RetString = ""
	  Call InitCommonCmd(FieldCmd, rsField, "EL_Field", "FieldName, Title, FieldType, Need", "ChannelID="& ChannelID)
	  rsField.Close()
	  RowCount = FieldCmd(0)
	  rsField.Open()
	  For i = 1 To RowCount
	     If rsField(3).value = True Then
		    Select Case rsField(2)
			   Case 1, 2, 4:
			      RetString = RetString &"if("& FormName &"."& rsField(0) &".value.trim()==""""){"& VBCRLF
				  RetString = RetString &"   alert(""请输入"& rsField(1) &""");"& VBCRLF
				  RetString = RetString &"   "& FormName &"."& rsField(0) &".focus();"& VBCRLF
				  RetString = RetString &"   return false;"& VBCRLF
				  RetString = RetString &"}"& VBCRLF
			   Case 5, 6:
			      RetString = RetString &"if("& FormName &"."& rsField(0) &".value.trim()==""""){"& VBCRLF
				  RetString = RetString &"   alert(""请输入"& rsField(1) &""");"& VBCRLF
				  RetString = RetString &"   "& FormName &"."& rsField(0) &".focus();"& VBCRLF
				  RetString = RetString &"   return false;"& VBCRLF
				  RetString = RetString &"}else if(!CheckNum("& FormName &"."& rsField(0) &".value)){"& VBCRLF
				  RetString = RetString &"   alert(""您输入的"& rsField(1) &"必须为数字"");"& VBCRLF
				  RetString = RetString &"   "& FormName &"."& rsField(0) &".focus();"& VBCRLF
				  RetString = RetString &"   return false;"& VBCRLF
				  RetString = RetString &"}"
			End Select	     
		 End If
		 If i<RowCount Then rsField.MoveNext()
	  Next
	  rsField.Close()
	  Set rsField = Nothing
	  Set FieldCmd = Nothing
	  ShowDefinedField_Js = RetString
   End Function
   
   Public Function ShowDefinedField(ByVal ChannelID, ByVal ChannelModule, ByVal InfoID, Cols)
      Dim FieldCmd, rsField, RowCount, i, RetString, DefaultValue
	  RetString = ""
	  Call InitCommonCmd(FieldCmd, rsField, "EL_Field", "FieldName, Title, Hint, FieldType, ArrOptions, DefaultValue", "ChannelID="& ChannelID)
	  rsField.Close()
	  RowCount = FieldCmd(0)
	  rsField.Open()
	  For i = 1 To RowCount
	     RetString = RetString &"<tr><td class='td_ItemName'><strong>"& rsField(1) &"</strong><br>"& EL_Common.HTMLEncode(rsField(2)) &"</td>"
		 RetString = RetString &"<td class='td_25' colspan='"& Cols &"'>"
		 If InfoID > 0 Then
		    Select Case ChannelModule
			  Case 1: DefaultValue = GetFieldValue(rsField(0), "EL_Article", "ChannelID="& ChannelID &" AND ArticleID="& InfoID)
			  Case 2: DefaultValue = GetFieldValue(rsField(0), "EL_Hotel", "ChannelID="& ChannelID &" AND HotelID="& InfoID)
			  Case 3: DefaultValue = GetFieldValue(rsField(0), "EL_Product", "ChannelID="& ChannelID &" AND ProductID="& InfoID)
			  Case 4: DefaultValue = GetFieldValue(rsField(0), "EL_Flight", "ChannelID="& ChannelID &" AND FlightID="& InfoID)
			  Case 5: DefaultValue = GetFieldValue(rsField(0), "EL_Sight", "ChannelID="& ChannelID &" AND SightID="& InfoID)
			  Case 6: DefaultValue = GetFieldValue(rsField(0), "EL_Photo", "ChannelID="& ChannelID &" AND PhotoID="& InfoID)
			  Case 7: DefaultValue = GetFieldValue(rsField(0), "EL_Shop", "ChannelID="& ChannelID &" AND ProductID="& InfoID)
			  Case 8: DefaultValue = GetFieldValue(rsField(0), "EL_Car", "ChannelID="& ChannelID &" AND CarID="& InfoID)
			End Select		    
		 Else
		    DefaultValue = rsField(5)			
		 End If
		 DefaultValue = ServerHTMLEncode(DefaultValue)
		 Select Case rsField(3)
		   Case 1: 
		      RetString = RetString &"<input type='text' name='"& rsField(0) &"' id='"& rsField(0) &"' value="""& DefaultValue &""" size=50> "			  
		   Case 2: 
		      RetString = RetString &"<textarea  name='"& rsField(0) &"' id='"& rsField(0) &"' cols=70 rows=5>"& DefaultValue &"</textarea>"
		   Case 3:
		      Dim arr, k
			  arr = Split(rsField(4), VBCRLF)
			  RetString = RetString &"<select name='"& rsField(0) &"' id='"& rsField(0) &"'>"
			  For k = 0 To UBound(arr)
			    If arr(k) = DefaultValue Then
				   RetString = RetString &"<option value='"& arr(k) &"' selected>"& arr(k) &"</option>"
				Else
				   RetString = RetString &"<option value='"& arr(k) &"'>"& arr(k) &"</option>"
				End If
			  Next
			  RetString = RetString &"</select>"
		   Case 4: 
		      RetString = RetString &"<input type='text' name='"& rsField(0) &"' id='"& rsField(0) &"' value="""& DefaultValue &"""> "
		   Case 5: 
		      RetString = RetString &"<input type='text' name='"& rsField(0) &"' id='"& rsField(0) &"' value="""& DefaultValue &""" size=10> "
		   Case 6: 
		      RetString = RetString &"<input type='text' name='"& rsField(0) &"' id='"& rsField(0) &"' value="""& DefaultValue &""" size=10> "
		   Case 7:  
		      If DefaultValue = "" Or IsNULL(DefaultValue) Then
			     DefaultValue = "0"
			  End If
		      RetString = RetString &"<input name='"& rsField(0) &"' id='"& rsField(0) &"' type='radio' class='nomargin' value='"& EL_True &"' "& SetObjectChecked("1", DefaultValue) &"> 是 "
			  RetString = RetString &"<input name='"& rsField(0) &"' id='"& rsField(0) &"' type='radio' class='nomargin' value='"& EL_False &"' "& SetObjectChecked("0", DefaultValue) &"> 否 "
		 End Select
		 RetString = RetString &"</td></tr>"
		 If i<RowCount Then rsField.MoveNext()
	  Next
	  rsField.Close()
	  Set rsField = Nothing
	  Set FieldCmd = Nothing
	  ShowDefinedField = RetString
   End Function
   
   Public Function GetFieldValue(ByVal FieldName, ByVal TableName, ByVal SQLCondition)
      Dim FValueCmd, rsFValue, ArrField, i, length
	  ArrField = Split(FieldName, ",")
	  length = UBOUND(ArrField)
	  Call InitCommonCmd(FValueCmd, rsFValue, TableName, FieldName, SQLCondition)
	  rsFValue.Close()
	  If FValueCmd(0) <> 1 Then	     
	     If length = 0 Then
		    GetFieldValue = ""
		 Else
		    ReDim arrTemp(length)
			For i = 0 To length
			   arrTemp(i) = ""
			Next
			GetFieldValue = arrTemp
		 End If		 
	  Else
	     rsFValue.Open()
		 If length = 0 Then		    
		    GetFieldValue = rsFValue(0)
		 Else
		    ReDim arrTemp(length)
		    For i = 0 To length
		       arrTemp(i) = rsFValue(i)
		    Next
			GetFieldValue = arrTemp
		 End If
		 rsFValue.Close()
	  End If
	  Set rsFValue = Nothing
	  Set FValueCmd = Nothing
   End Function
   
   Public Function TemplateList(ByVal ChannelID, ByVal TemplateType, ByVal DefaultID)
      Dim TemplateCmd, rsTemplate, i, RowCount, RetString
	  RetString = ""
	  Call InitCommonCmd(TemplateCmd, rsTemplate, "EL_Template", "TemplateID, TemplateName", "ChannelID="& ChannelID &" AND TemplateType="& TemplateType)
	  rsTemplate.Close()
	  RowCount = TemplateCmd(0)
	  rsTemplate.Open()
	  For i = 1 To RowCount
	     If ELClng(DefaultID) = rsTemplate(0) Then
	        RetString = RetString &"<option value='"& rsTemplate(0) &"' selected>"& rsTemplate(1) &"</option>"
		 Else
		    RetString = RetString &"<option value='"& rsTemplate(0) &"'>"& rsTemplate(1) &"</option>"
		 End If
	     If i<RowCount Then rsTemplate.MoveNext
	  Next
	  rsTemplate.Close()
	  Set rsTemplate = Nothing
	  Set TemplateCmd = Nothing
	  TemplateList = RetString
   End Function
   
   Public Function SkinList(ByVal DefaultID)
      Dim SkinCmd, rsSkin, i, RowCount, RetString
	  RetString = ""
	  Call InitCommonCmd(SkinCmd, rsSkin, "EL_Skin", "SkinID,SkinName", "1=1")
	  rsSkin.Close()
	  RowCount = SkinCmd(0)
	  rsSkin.Open()
	  For i = 1 To RowCount
	     If ELClng(DefaultID) = rsSkin(0) Then
	        RetString = RetString &"<option value='"& rsSkin(0) &"' selected>"& rsSkin(1) &"</option>"
		 Else
		    RetString = RetString &"<option value='"& rsSkin(0) &"'>"& rsSkin(1) &"</option>"
		 End If
	     If i<RowCount Then rsSkin.MoveNext
	  Next
	  rsSkin.Close()
	  Set rsSkin = Nothing
	  Set SkinCmd = Nothing
	  SkinList = RetString
   End Function
   
   Public Function ShowNearInfo(ByVal TableName, ByVal IDField, ByVal TitleField, ByVal StrCondition, ByVal OrderField, ByVal InfoID, ByVal URL)
      Dim NearCmd, PrevID, PrevTitle, NextID, NextTitle, RetString
	  Call InitCommand(NearCmd, "EL_SP_NearInfo")
	  With NearCmd
	    .Parameters.Append .CreateParameter("@TableName", 200, 1, 100, TableName)
		.Parameters.Append .CreateParameter("@IDField", 200, 1, 100, IDField)
		.Parameters.Append .CreateParameter("@TitleField", 200, 1, 100, TitleField)
		.Parameters.Append .CreateParameter("@StrCondition", 200, 1, LenParameter(StrCondition), StrCondition)
		.Parameters.Append .CreateParameter("@OrderField", 200, 1, 100, OrderField)
		.Parameters.Append .CreateParameter("@InfoID", 3, 1, 4, InfoID)
		.Parameters.Append .CreateParameter("@PrevID", 3, 2, 4)
		.Parameters.Append .CreateParameter("@PrevTitle", 200, 2, 255)
		.Parameters.Append .CreateParameter("@NextID", 3, 2, 4)
		.Parameters.Append .CreateParameter("@NextInfo", 200, 2, 255)
		.Execute()
	  End With
	  PrevID = NearCmd(6)
	  PrevTitle = NearCmd(7)
	  NextID = NearCmd(8)
	  NextTitle = NearCmd(9)
	  Set NearCmd = Nothing
	  RetString = "·上一"& EL_Channel.ItemUnit & EL_Channel.ItemName &"："
	  If PrevID = "" OR IsNULL(PrevID) Then
	     RetString = RetString &"<span class=graytext>没有了</span><br> "
	  Else
	     RetString = RetString &"<a href="""& URL & PrevID &""">"& HTMLEncode(PrevTitle) &"</a><br> "
	  End If
	  RetString = RetString &"·下一"& EL_Channel.ItemUnit & EL_Channel.ItemName &"："
	  If NextID = "" OR IsNULL(NextID) Then
	     RetString = RetString &"<span class=graytext>没有了</span>"
	  Else
	     RetString = RetString &"<a href="""& URL & NextID &""">"& HTMLEncode(NextTitle) &"</a>"
	  End If
	  ShowNearInfo = RetString
   End Function
   
   Public Sub CheckChannel(ByVal ChannelID, ChannelModule)
      If ChannelID < 1 OR EL_Channel.ChannelModule <> ChannelModule Then
	     ShowErrorMsg("频道ID错误")
		 Call ApplicationTerminate()
	  End If
   End Sub   
   
   Public Function GetParentPath(ByVal URL, ByVal ClassID)
      Dim ParentCmd, ArrParent, i
	  Dim RetString, ScriptName
	  ClassID = ELClng(ClassID)
	  If ClassID = 0 Then Exit Function
	  Call InitCommand(ParentCmd, "EL_SP_ClassParentPath")
	  With ParentCmd
	     .Parameters.Append .CreateParameter("RETURN", 2, 4)
		 .Parameters.Append .CreateParameter("@ClassID", 3, 1, 4, ClassID)
		 .Parameters.Append .CreateParameter("@ChannelID", 3, 1, 4, EL_Channel.ChannelID)
		 .Parameters.Append .CreateParameter("@Ret", 200, 2, 4000)
		 .Execute()
	  End With
	  If ParentCmd(0) = 0 Then
	     Set ParentCmd = Nothing
		 Exit Function
	  End If
	  ArrParent = Split(ParentCmd(3).value, "$")
	  RetString = ""
	  ScriptName = EL_CurrentScriptName &"?"& URL
	  For i = UBound(ArrParent) To 0 Step -1
	     Dim arrTemp
		 arrTemp = Split(ArrParent(i), "|")
	     RetString = RetString &">> <a href="& ScriptName &"&ClassID="& arrTemp(0) &">"& arrTemp(1) &"</a> "
	  Next
	  Set ParentCmd = Nothing
	  GetParentPath = RetString
   End Function  
   
   Public Function GetAllChildID(ByVal ParentID)
      Dim ChildCmd
	  Call InitCommand(ChildCmd, "EL_SP_GetAllChildID")
	  With ChildCmd
	     .Parameters.Append .CreateParameter("@ParentID", 3, 1, 4, ParentID)
		 .Parameters.Append .CreateParameter("@AllChildID", 200, 2, 8000)
		 .Execute()
	  End With
	  GetAllChildID = ChildCmd(1)
	  Set ChildCmd = Nothing
   End Function
   
   Public Function ShowClassList(ByVal URL, ByVal ParentID, ByVal ClassID)
      Dim RetString, ClassCmd, RowCount, rsClass
	  Dim ClassA, TempParentID
	  ParentID = ELClng(ParentID)
	  ClassID = ELClng(ClassID)
	  Call InitCommand(ClassCmd, "EL_SP_ClassList")
	  With ClassCmd
	     .Parameters.Append .CreateParameter("RETURN", 3, 4, 4)
		 .Parameters.Append .CreateParameter("@ParentID", 3, 1, 4, ParentID)
		 .Parameters.Append .CreateParameter("@ChannelID", 3, 1, 4, EL_Channel.ChannelID)
		 Set rsClass = .Execute()
	  End With
	  rsClass.Close()
	  RetString = "<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""1"" class=""Border"">"