style.aspx

医院网站的后台管理程序

	"	}" & VBCrlf & _
	"	var sValue=sel.options[nIndex].value;" & VBCrlf & _
	"	var sHTML=sel.options[nIndex].innerHTML;" & VBCrlf & _
	"	sel.options[nIndex].value=sel.options[nIndex-1].value;" & VBCrlf & _
	"	sel.options[nIndex].innerHTML=sel.options[nIndex-1].innerHTML;" & VBCrlf & _
	"	sel.options[nIndex-1].value=sValue;" & VBCrlf & _
	"	sel.options[nIndex-1].innerHTML=sHTML;" & VBCrlf & _
	"	sel.selectedIndex=nIndex-1;" & VBCrlf & _
	"}" & VBCrlf & _
	"" & VBCrlf & _
	"function Down() {" & VBCrlf & _
	"	var sel=document.myform.d_b2;" & VBCrlf & _
	"	var nIndex = sel.selectedIndex;" & VBCrlf & _
	"	var nLen = sel.length;" & VBCrlf & _
	"	if ((nLen<1)||(nIndex==nLen-1)) return;" & VBCrlf & _
	"	if (nIndex<0) {" & VBCrlf & _
	"		alert(""请选择一个要移动的已选按钮！"");" & VBCrlf & _
	"		return;" & VBCrlf & _
	"	}" & VBCrlf & _
	"	var sValue=sel.options[nIndex].value;" & VBCrlf & _
	"	var sHTML=sel.options[nIndex].innerHTML;" & VBCrlf & _
	"	sel.options[nIndex].value=sel.options[nIndex+1].value;" & VBCrlf & _
	"	sel.options[nIndex].innerHTML=sel.options[nIndex+1].innerHTML;" & VBCrlf & _
	"	sel.options[nIndex+1].value=sValue;" & VBCrlf & _
	"	sel.options[nIndex+1].innerHTML=sHTML;" & VBCrlf & _
	"	sel.selectedIndex=nIndex+1;" & VBCrlf & _
	"}" & VBCrlf & _
	"" & VBCrlf & _
	"function checkform() {" & VBCrlf & _
	"	var sel=document.myform.d_b2;" & VBCrlf & _
	"	var nLen = sel.length;" & VBCrlf & _
	"	var str="""";" & VBCrlf & _
	"	for (var i=0;i<nLen;i++) {" & VBCrlf & _
	"		if (i>0) str+=""|"";" & VBCrlf & _
	"		str+=sel.options[i].value;" & VBCrlf & _
	"	}" & VBCrlf & _
	"	document.myform.d_button.value=str;" & VBCrlf & _
	"	return true;" & VBCrlf & _
	"}" & VBCrlf & _
	"" & VBCrlf & _
	"</s" & "cript>")


	Dim s_SubmitButton
	If nStyleIsSys = 1 Then
		s_SubmitButton = ""
	Else
		s_SubmitButton = "<input type=submit name=b value=' 保存设置 '>"
	End If
	Response.Write ("<table border=0 cellpadding=5 cellspacing=0 align=center>" & _
		"<form action='?action=buttonsave&id=" & sStyleID & "&toolbarid=" & sToolBarID & "' method=post name=myform onsubmit='return checkform()'>" & _
		"<tr align=center><td>可选按钮</td><td></td><td>已选按钮</td><td></td></tr>" & _
		"<tr align=center>" & _
			"<td><select name='d_b1' size=20 style='width:250px' ondblclick='Add()'>" & s_Option1 & "</select></td>" & _
			"<td><input type=button name=b1 value=' → ' onclick='Add()'><br><br><input type=button name=b1 value=' ← ' onclick='Del()'></td>" & _
			"<td><select name='d_b2' size=20 style='width:250px' ondblclick='Del()'>" & s_Option2 & "</select></td>" & _
			"<td><input type=button name=b3 value='↑' onclick='Up()'><br><br><br><input type=button name=b4 value='↓' onclick='Down()'></td>" & _
		"</tr>" & _
		"<input type=hidden name='d_button' value=''>" & _
		"<tr><td colspan=4 align=right>" & s_SubmitButton & "</td></tr>" & _
		"</form></table>")


	Response.Write ("<table border=0 cellspacing=1 align=center class=list>" & _
		"<tr><th colspan=4>以下是按钮图片对照表（部分下拉框或特殊按钮可能没图）：</th></tr>")
	n = 0
	Dim m
	m = 0
	For i = 1 To UBound(aButton)
		If aButton(i, 8) = 1 Then
			m = m + 1
			n = m Mod 4
			If n = 1 Then
				Response.Write ("<tr>")
			End If
			Response.Write ("<td>")
			If aButton(i, 3) <> "" Then
				Response.Write ("<img border=0 align=absmiddle src='../buttonimage/" & sStyleDir & "/" & aButton(i, 3) & "'>")
			End If
			Response.Write (aButton(i, 2))
			Response.Write ("</td>")
			If n = 0 Then
				Response.Write ("</tr>")
			End If
		End If
	Next
	If n > 0 Then
		For i = 1 To 4 - n
			Response.Write ("<td>&nbsp;</td>")
		Next
		Response.Write ("</tr>")
	End if
	Response.Write ("</table>")
End Sub

Function Code2Title(s_Code)
	Dim i
	Code2Title = ""
	For i = 1 To UBound(aButton)
		If UCase(aButton(i, 1)) = UCase(s_Code) Then
			Code2Title = aButton(i, 2)
			Exit Function
		End If
	Next
End Function

Sub DoButtonSave()
	Dim s_Button, nToolBarID, aCurrToolbar
	s_Button = Trim(Request("d_button"))

	nToolBarID = Clng(sToolBarID)
	aCurrToolbar = Split(aToolbar(nToolBarID), "|||")
	aToolbar(nToolBarID) = aCurrToolbar(0) & "|||" & s_Button & "|||" & aCurrToolbar(2) & "|||" & aCurrToolbar(3)

	Call WriteConfig()
	Call WriteStyle(Clng(sStyleID))

	Call ShowMessage("<b><span class=red>工具栏按钮设置保存成功！</span></b><li><a href='?action=stylepreview&id=" & sStyleID & "' target='_blank'>预览此样式</a><li><a href='?action=toolbar&id=" & sStyleID & "'>返回工具栏管理</a><li><a href='?action=buttonset&id=" & sStyleID & "&toolbarid=" & sToolBarID & "'>重新设置此工具栏下的按钮</a>")

End Sub

Function InitSelect(s_FieldName, a_Name, a_Value, v_InitValue, s_AllName)
	Dim i
	InitSelect = "<select name='" & s_FieldName & "' size=1>"
	If s_AllName <> "" Then
		InitSelect = InitSelect & "<option value=''>" & s_AllName & "</option>"
	End If

	For i = 0 To UBound(a_Name)
		InitSelect = InitSelect & "<option value=""" & inHTML(a_Value(i)) & """"
		If a_Value(i) = v_InitValue Then
			InitSelect = InitSelect & " selected"
		End If
		InitSelect = InitSelect & ">" & outHTML(a_Name(i)) & "</option>"
	Next
	InitSelect = InitSelect & "</select>"
End Function



Sub WriteStyle(n_StyleID)
	Dim sConfig
	Dim aTmpStyle

	sConfig = ""
	aTmpStyle = Split(aStyle(n_StyleID), "|||")
	sConfig = sConfig & "config.ButtonDir = """ & aTmpStyle(1) & """;" & Vbcrlf
	sConfig = sConfig & "config.StyleUploadDir = """ & aTmpStyle(3) & """;" & Vbcrlf
	sConfig = sConfig & "config.InitMode = """ & aTmpStyle(18) & """;" & Vbcrlf
	sConfig = sConfig & "config.AutoDetectPasteFromWord = """ & aTmpStyle(17) & """;" & Vbcrlf
	sConfig = sConfig & "config.BaseUrl = """ & aTmpStyle(19) & """;" & Vbcrlf
	sConfig = sConfig & "config.BaseHref = """ & aTmpStyle(22) & """;" & Vbcrlf
	sConfig = sConfig & "config.AutoRemote = """ & aTmpStyle(24) & """;" & Vbcrlf
	sConfig = sConfig & "config.ShowBorder = """ & aTmpStyle(25) & """;" & Vbcrlf
	sConfig = sConfig & "config.StateFlag = """ & aTmpStyle(16) & """;" & Vbcrlf
	sConfig = sConfig & "config.CssDir = """ & aTmpStyle(2) & """;" & Vbcrlf
	sConfig = sConfig & "config.AutoDetectLanguage = """ & aTmpStyle(27) & """;" & Vbcrlf
	sConfig = sConfig & "config.DefaultLanguage = """ & aTmpStyle(28) & """;" & Vbcrlf
	sConfig = sConfig & "config.AllowBrowse = """ & aTmpStyle(43) & """;" & Vbcrlf
	sConfig = sConfig & Vbcrlf
	sConfig = sConfig & "function showToolbar(){" & Vbcrlf
	sConfig = sConfig & Vbcrlf

	sConfig = sConfig & chr(9) & "document.write ("""
	sConfig = sConfig & "<table border=0 cellpadding=0 cellspacing=0 width='100%' class='Toolbar' id='eWebEditor_Toolbar'>"

	Dim s_Order, s_ID, n, aTmpToolbar
	s_Order = ""
	s_ID = ""
	For n = 1 To UBound(aToolbar)
		If aToolbar(n) <> "" Then
			aTmpToolbar = Split(aToolbar(n), "|||")
			If aTmpToolbar(0) = CStr(n_StyleID) Then
				If s_ID <> "" Then
					s_ID = s_ID & "|"
					s_Order = s_Order & "|"
				End If
				s_ID = s_ID & CStr(n)
				s_Order = s_Order & aTmpToolbar(3)
			End If
		End If
	Next

	Dim a_ID, a_Order, aTmpButton, i
	If s_ID <> "" Then
		a_ID = Split(s_ID, "|")
		a_Order = Split(s_Order, "|")
		For n = 0 To UBound(a_Order)
			a_Order(n) = Clng(a_Order(n))
			a_ID(n) = Clng(a_ID(n))
		Next
		a_ID = Sort(a_ID, a_Order)
		For n = 0 To UBound(a_ID)
			aTmpToolbar = Split(aToolbar(a_ID(n)), "|||")
			aTmpButton = Split(aTmpToolbar(1), "|")

			sConfig = sConfig & "<tr><td><div class=yToolbar>"
			For i = 0 To UBound(aTmpButton)
				If UCase(aTmpButton(i)) = "MAXIMIZE" Then
					sConfig = sConfig & """);" & Vbcrlf
					sConfig = sConfig & Vbcrlf

					sConfig = sConfig & chr(9) & "if (sFullScreen==""1""){" & Vbcrlf
					sConfig = sConfig & chr(9) & chr(9) & "document.write (""" & Code2HTML("Minimize", aTmpStyle(1)) & """);" & Vbcrlf
					sConfig = sConfig & chr(9) & "}else{" & Vbcrlf
					sConfig = sConfig & chr(9) & chr(9) & "document.write (""" & Code2HTML(aTmpButton(i), aTmpStyle(1)) & """);" & Vbcrlf
					sConfig = sConfig & chr(9) & "}" & Vbcrlf
					sConfig = sConfig & Vbcrlf

					sConfig = sConfig & chr(9) & "document.write ("""
				Else
					sConfig = sConfig & Code2HTML(aTmpButton(i), aTmpStyle(1))
				End If
			Next
			sConfig = sConfig & "</div></td></tr>"
		Next
	Else
		sConfig = sConfig & "<tr><td></td></tr>"
	End If

	sConfig = sConfig & "</table>"");" & Vbcrlf
	sConfig = sConfig & Vbcrlf
	sConfig = sConfig & "}" & Vbcrlf	

	Call WriteFile("../style/" & LCase(aTmpStyle(0)) & ".js", sConfig)

End Sub

Function Code2HTML(s_Code, s_ButtonDir)
	Dim i
	Code2HTML = ""
	For i = 1 To UBound(aButton, 1)
		If UCase(aButton(i, 1)) = UCase(s_Code) Then
			Select Case aButton(i, 5)
			Case 0
				Code2HTML = "<DIV CLASS=" & aButton(i, 7) & " TITLE='""+lang[""" & aButton(i, 1) & """]+""' onclick=\""" & aButton(i, 6) & "\""><IMG CLASS=Ico SRC='buttonimage/" & s_ButtonDir & "/" & aButton(i, 3) & "'></DIV>"
			Case 1
				If aButton(i, 4) <> "" Then
					Code2HTML = "<SELECT CLASS=" & aButton(i, 7) & " onchange=\""" & aButton(i, 6) & "\"">" & aButton(i, 4) & "</SELECT>"
				Else
					Code2HTML = "<SELECT CLASS=" & aButton(i, 7) & " onchange=\""" & aButton(i, 6) & "\"">""+lang[""" & aButton(i, 1) & """]+""</SELECT>"
				End If
			Case 2
				Code2HTML = "<DIV CLASS=" & aButton(i, 7) & ">" & aButton(i, 4) & "</DIV>"
			End Select
			Exit Function
		End If
	Next
End Function

Sub DeleteFile(s_StyleName)
	On Error Resume Next
	Dim oFSO, sMapFileName
	oFSO = Server.CreateObject("Scripting.FileSystemObject")
	sMapFileName = Server.MapPath("../style/" & LCase(s_StyleName) & ".js")
	If oFSO.FileExists(sMapFileName) Then
		oFSO.DeleteFile(sMapFileName)
	End If
	oFSO = Nothing
End Sub

Sub GoUrl(url)
	Response.Write ("<script language=javascript>location.href=""" & url & """;</s" & "cript>")
	Response.End
End Sub

Function isValidColor(str)
	Dim re As Regex
	re = new Regex("[A-Fa-f0-9]{6}")
	isValidColor = re.IsMatch(str)
End Function

</script>