class_sys.asp

电子备课系统

				If rs("custom_domain") <> "" And Not IsNull(rs("custom_domain")) Then
					utruepath = "http://" & rs("custom_domain") & "/"
				Else
					utruepath = "http://" & rs("user_domain") & "." & rs("user_domainroot") & "/"
				End If
			Else
				utruepath = blogdir & udir & "/" & ufolder & "/"
			End If
			If bname = "" Or IsNull(bname) Then bname = " "
			searchstr = "<form name=""search"" method=""post"" action=""" & blogurl & "list.asp?userid=" & uid & """ target=""_blank"">" & vbcrlf
			searchstr = searchstr & "	<select name=""selecttype"" id=""selecttype"">" & vbcrlf
			searchstr = searchstr & "		<option value=""topic"" selected>日志标题</option>" & vbcrlf
			searchstr = searchstr & "		<option value=""logtext"">日志内容</option>" & vbcrlf
			searchstr = searchstr & "	</select>" & vbcrlf
			searchstr = searchstr & "	<br />" & vbcrlf
			searchstr = searchstr & "	<input name=""keyword"" type=""text"" id=""keyword"" size=""16"" maxlength=""40"">" & vbcrlf
			searchstr = searchstr & "	<input type=""submit"" name=""Submit"" value=""搜索"">" & vbcrlf
			searchstr = searchstr & "</form>" & vbcrlf

			'upath = Server.MapPath(udir)
			upath = Server.MapPath(blogdir & udir)
			Set fso = Server.CreateObject(CacheCompont(1))
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			upath = Server.MapPath(blogdir & udir & "/" & ufolder)
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			Call BuildFile(upath & "/index." & f_ext, "暂无日志,请发表日志或者更新首页!" )
			Call BuildFile(upath & "/message." & f_ext, "暂无留言,请更新发布留言板!" )
			upath = Server.MapPath(blogdir & udir & "/" & ufolder & "/calendar")
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			If f_ext = "htm" Or f_ext = "html" Then
				Call BuildFile(upath & "/0.htm", htm2js_div(" ", "calendar") )
			Else
				Call BuildFile(upath & "/0.htm", " " )
			End If
			upath = Server.MapPath(blogdir & udir & "/" & ufolder)
			If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			Dim xmlDoc,userpath
			Set xmlDoc = New Cls_XmlDoc
			userpath = blogdir & udir & "/" & ufolder&"/user.xml"
			If xmlDoc.LoadXml (blogdir&"XmlData/user.xml") Then
				xmlDoc.SaveAs userpath
			Else
				Response.Write (blogdir&"XmlData/user.xml 不存在，无法继续操作！")
				Set XmlDoc = Nothing
				Response.End
			End If
			If xmlDoc.LoadXml (userpath) Then
				xmlDoc.UpdateNodeText "blogname",oblog.htm2js_div(filt_html(bname),"blogname"),True
				xmlDoc.UpdateNodeText "placard",oblog.htm2js_div(" ","placard"),True
				xmlDoc.UpdateNodeText "subject",oblog.htm2js_div(" ","subject"),True
				xmlDoc.UpdateNodeText "newblog",oblog.htm2js_div(" ","newblog"),True
				xmlDoc.UpdateNodeText "comment",oblog.htm2js_div(" ","comment"),True
				xmlDoc.UpdateNodeText "links",oblog.htm2js_div(" ","links"),True
				xmlDoc.UpdateNodeText "info",oblog.htm2js_div(" ","info"),True
				xmlDoc.UpdateNodeText "search",oblog.htm2js_div(searchstr,"search"),True
				xmlDoc.UpdateNodeText "mygroups",oblog.htm2js_div(" ","mygroups"),True
				xmlDoc.UpdateNodeText "myfriend",oblog.htm2js_div(" ","myfriend"),True
				xmlDoc.UpdateNodeText "newmessage",oblog.htm2js_div("<a href=""" & utruepath & "message." & f_ext & "#cmt""><strong>签写留言</strong></a> ","newmessage"),True
				xmlDoc.Save
				Set xmlDoc = Nothing
			Else
				Response.Write xmlDoc.ErrInfo
				Set xmlDoc = Nothing
				Response.End
			End if
			If CacheConfig(57) = "1" Then
				upath = Server.MapPath(blogdir & udir & "/" & ufolder & "/archives")
				If fso.FolderExists(upath) = False Then fso.CreateFolder (upath)
			End If
			Set fso = Nothing
			Set rs = Nothing
		Else
			Set rs = Nothing
			Response.Write ("没找到该用户，无法建立目录。")
			Exit Sub
		End If
	End Sub

	Public Sub ShowMsg(Str, url)
		url = Trim(url)
		If url = "" Then
			'如果返回URL为空
			'如果可以获取来路则直接返回来路，否则返回上一页
			If Comeurl = "" Then
				Response.Write "<script language=Javascript>alert(""" & Str & """);history.go(-1)</script>"
			Else
				Response.Write "<script language=Javascript>alert(""" & Str & """);window.location='" & Comeurl & "'</script>"
			End if
		Else
			'操作完成后关闭当前窗口
			If url = "close" Then
				Response.Write "<script language=Javascript>alert(""" & Str & """);self.close();</script>"
			Else
			'操作完成后转向目标URL
				Response.Write "<script language=Javascript>alert(""" & Str & """);window.location='" & url & "'</script>"
			End if
		End If
		Set oblog = Nothing
		Response.End
	End Sub

	Public Function type_city(province, city)
		Dim tmpstr
		tmpstr = "	<select onchange=setcity(); name=""province"">" & vbcrlf
		tmpstr = tmpstr & "		<option value="""">选择省份</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""安徽"">安徽</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""北京"">北京</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""重庆"">重庆</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""福建"">福建</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""甘肃"">甘肃</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""广东"">广东</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""广西"">广西</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""贵州"">贵州</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""海南"">海南</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""河北"">河北</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""黑龙江"">黑龙江</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""河南"">河南</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""香港"">香港</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""湖北"">湖北</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""湖南"">湖南</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""江苏"">江苏</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""江西"">江西</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""吉林"">吉林</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""辽宁"">辽宁</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""澳门"">澳门</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""内蒙古"">内蒙古</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""宁夏"">宁夏</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""青海"">青海</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""山东"">山东</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""上海"">上海</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""山西"">山西</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""陕西"">陕西</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""四川"">四川</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""台湾"">台湾</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""天津"">天津</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""新疆"">新疆</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""西藏"">西藏</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""云南"">云南</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""浙江"">浙江</option>" & vbcrlf
		tmpstr = tmpstr & "		<option value=""海外"">海外</option>" & vbcrlf
		tmpstr = tmpstr & "	</select>" & vbcrlf
		tmpstr = tmpstr & "	<select name=""city"">" & vbcrlf
		tmpstr = tmpstr & "	</select>" & vbcrlf
		tmpstr = tmpstr & "<script src=""inc/getcity.js""></script>" & vbcrlf
		tmpstr = tmpstr & "<script>initprovcity('" & province & "','" & city & "');</script>" & vbcrlf
		type_city = tmpstr
	End Function
	Public Sub type_job(job)
		Dim tmpstr
		tmpstr = "<select name=""job"" id=""job"">" & vbcrlf
		tmpstr = tmpstr & "	<option value="""">----请选择职业----</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""财会/金融""> 财会/金融</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""工程师"">工程师</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""顾问"">顾问</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""计算机相关行业"">计算机相关行业</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""计算机相关行业（其他）"">计算机相关行业（其他）</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""家庭主妇"">家庭主妇</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""教育/培训"">教育/培训</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""客户服务/支持"">客户服务/支持</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""零售商/手工工人"">零售商/手工工人</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""退休"">退休</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""无职业"">无职业</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""销售/市场/广告"">销售/市场/广告</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""学生"">学生</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""研究和开发"">研究和开发</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""一般管理"">一般管理</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""政府/军队"">政府/军队</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""执行官/高级管理"">执行官/高级管理</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""制造/生产/操作"">制造/生产/操作</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""专业人员（医药、法律等）"">专业人员（医药、法律等）</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""自雇/业主"">自雇/业主</option>" & vbcrlf
		tmpstr = tmpstr & "	<option value=""其他"">其他</option>" & vbcrlf
		tmpstr = tmpstr & "</select>" & vbcrlf
		Response.Write (tmpstr)
	%>
	<script language=javascript>
	var jobObject = document.oblogform["job"];
	for(var i = 0; i < jobObject.options.length; i++) {
		if (jobObject.options[i].value=="<%=Trim(job)%>")
		{
			jobObject.selectedIndex = i;
		}
	}
	</script>
	<%
	End Sub

	Public Sub type_dateselect(addtime, n)
		Dim y, m, d, ttime
		If addtime = "" Then ttime = ServerDate(Now()) Else ttime = addtime
		Response.Write("<select name=""selecty"&n&""">")&vbcrlf
		For y = Year(Now())-10 To Year(Now())+10
			If Year(ttime) = y Then
				Response.Write "<option value="""&y&""" selected>"&y&"年</option>"&vbcrlf
			Else
				Response.Write "<option value="""&y&""">"&y&"年</option>"&vbcrlf
			End If
		Next
		Response.Write "</select>"&vbcrlf
		Response.Write "<select name=""selectm"&n&""">"&vbcrlf

		For m = 1 To 12
			If Month(ttime) = m Then
				Response.Write "<option value="""&m&""" selected>"&m&"月</option>"&vbcrlf
			Else
				Response.Write "<option value="""&m&""">"&m&"月</option>"&vbcrlf
			End If
		Next
		Response.Write("</select>")&vbcrlf
		Response.Write("<select name=""selectd"&n&""">")&vbcrlf

		For d = 1 To 31
			If Day(ttime) = d Then
				Response.Write "<option value="""&d&""" selected>"&d&"日</option>"&vbcrlf
			Else
				Response.Write "<option value="""&d&""">"&d&"日</option>"&vbcrlf
			End If
		Next
		Response.Write ("</select>") & vbCrLf
	End Sub

	Public Sub chk_commenttime()
		Dim lasttime
		if CacheConfig(27) = "0" Then
			If DateDiff("s", l_uLastComment, l_uLastMessage) > 0 Then
				lasttime = l_uLastMessage
			Else
				lasttime = l_uLastComment
			End If
		Else
			lasttime = Request.Cookies(cookies_name)("LastComment")
		End If
		If IsDate(lasttime) Then
			If DateDiff("s", lasttime, ServerDate(Now())) < Int(cacheConfig(32)) Then
				Response.Write ("<script language=javascript>alert('" & cacheConfig(32) & "秒后才能回复或评论。');window.history.back(-1);</script>")
				Response.End
			End If
		End If
	End Sub

	Public Function filtpath(Str)
		Dim s1
		If oblog.CacheConfig(55) = 1 Then
			Dim nurl
			nurl = Trim("http://" & Request.ServerVariables("HTTP_HOST"))
			nurl = nurl & Request.ServerVariables("PATH_INFO")
			nurl = Left(nurl, InStrRev(nurl, "/"))
			s1 = Replace(Str, nurl, "")
		Else
			s1 = Str
		End If
		filtpath=Replace(s1,"over--flow","overflow")
	End Function


	Public Function showpage(bTotal, bAllPages, sUnit)
		Dim n, i, sTmp, strUrl
		If G_P_PerMax=0 Then G_P_PerMax=1
		If G_P_AllRecords Mod G_P_PerMax = 0 Then
			n = G_P_AllRecords \ G_P_PerMax
		Else
			n = G_P_AllRecords \ G_P_PerMax + 1
		End If
		sTmp = vbcrlf & "<div id=""showpage"">" & vbcrlf
		If bTotal = True Then
			sTmp = sTmp & "共" & G_P_AllRecords & sUnit & "&nbsp;&nbsp;"
		End If
		strUrl = JoinChar(G_P_FileName)
		If G_P_This < 2 Then
				sTmp = sTmp & "首页 上一页&nbsp;"
		Else
				sTmp = sTmp & "<a href=""" & strUrl & "page=1"">首页</a>&nbsp;"
				sTmp = sTmp & "<a href=""" & strUrl & "page=" & (G_P_This - 1) & """>上一页</a>&nbsp;"
		End If

		If n - G_P_This < 1 Then
				sTmp = sTmp & "下一页 尾页"
		Else
				sTmp = sTmp & "<a href=""" & strUrl & "page=" & (G_P_This + 1) & """>下一页</a>&nbsp;"
				sTmp = sTmp & "<a href=""" & strUrl & "page=" & n & """>尾页</a>"
		End If
		sTmp = sTmp & "&nbsp;页次：" & G_P_This & "/" & n & "页 "
		sTmp = sTmp & "&nbsp;" & G_P_PerMax & "" & sUnit & "/页"
		If bAllPages = True Then
			sTmp = sTmp & "&nbsp;转到：<select name=""page"" size=""1"" onchange=""javascript:window.location='" & strUrl & "page=" & "'+this.options[this.selectedIndex].value;"">"
			For i = 1 To n
				sTmp = sTmp & "<option value=""" & i & """"
				If CInt(G_P_This) = CInt(i) Then sTmp = sTmp & " selected "
				sTmp = sTmp & ">" & i & "</option>"
			Next
			sTmp = sTmp & "</select>"
		End If
		sTmp = sTmp & "</div>" & vbcrlf
		showpage = sTmp
	End Function

	Function MakePageBar(rs,sUnit)
		if Request("page")<>"" then
			G_P_This=cint(Request("page"))
		else
			G_P_This=1
		end if
		If rs.EOF Then
			G_P_Guide = G_P_Guide & " (共有0"&sUnit&")"
			Response.write "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" & G_P_Guide
		Else
			G_P_AllRecords = rs.recordcount
			G_P_Guide = G_P_Guide & " (共有" & G_P_AllRecords & sUnit & ")"
			If G_P_This < 1 Then
				G_currentPage = 1
			End If
			If (G_P_This - 1) * G_P_PerMax > G_P_AllRecords Then
				If (G_P_AllRecords Mod G_P_PerMax) = 0 Then
					G_P_This = G_P_AllRecords \ G_P_PerMax
				Else
					G_P_This = G_P_AllRecords \ G_P_PerMax + 1
				End If
			End If
			If G_P_This = 1 Then
				showContent
				Response.write oblog.showpage(True, True, sUnit)
			Else
				If (G_P_This - 1) * G_P_PerMax < G_P_AllRecords Then
					rs.Move (G_P_This - 1) * G_P_PerMax
					Dim bookmark
					bookmark = rs.bookmark
					showContent
					Response.write oblog.showpage(True, True, sUnit)
				Else
					G_currentPage = 1
					showContent
					Response.write oblog.showpage(True, True, sUnit)
				End If
			End If
		End If
	End Function
	Public Function JoinChar(strUrl)
		If strUrl = "" Then
			JoinChar = ""
			Exit Function
		End If
		If InStr(strUrl, "?") < Len(strUrl) Then
			If InStr(strUrl, "?") > 1 Then
				If InStr(strUrl, "&") < Len(strUrl) Then
					JoinChar = strUrl & "&"
				Else
					JoinChar = strUrl
				End If
			Else
				JoinChar = strUrl & "?"
			End If
		Else
			JoinChar = strUrl
		End If
	End Function

	Public Function htm2js(Str,IsWrite)
		If Str = "" Or IsNull(Str) Then Str = " "
		Str = Replace(Str, "\", "\\")
		Str = Replace(Str, "'", "\'")
'		Str = Replace(Str, vbCrLf, "\n")
		Str = Replace(Str, Chr(13), "")
		Str = Replace(Str, Chr(10), "\n")
		If IsWrite Then
			htm2js = "document.write('" & Str & "');"
		Else
			htm2js = Str
		End If
	End Function

	'将htm代码插入div,不支持脚本插入
	Public Function htm2js_div(Str, divid)
		divid = Trim(divid)
		If Str = "" Or IsNull(Str) Then Str = " "
		Str = Replace(Str, "\", "\\")
		Str = Replace(Str, "'", "\'")
'		Str = Replace(Str, vbCrLf, "\n")
		Str = Replace(Str, Chr(13), "")
		Str = Replace(Str, Chr(10), "\n")
		htm2js_div = "if (chkdiv('" & divid & "')) {"