<%

'/判断用户是否超时/
Function IsTimeOut(vUserName,vUserPwd)
	dim rdsUser,sqlUser
	Set rdsUser = Server.CreateObject("ADODB.Recordset")
	sqlUser = "Select * From Sys_Account Where Account ='"& vUserName &"' And PassWord ='"& md5(vUserPwd,16) &"'"
	rdsUser.Open sqlUser,conn
	If Not rdsUser.EOF Then
		IsTimeOut = False
	Else
		IsTimeOut = True
	End if
	rdsUser.Close
	set rdsUser = nothing
End Function

'/字符过滤/
function changechr(str) 
    changechr=replace(replace(replace(replace(str,"<",""),">",""),chr(13),"")," ","") 
   changechr=replace(replace(replace(replace(changechr,"'",""),"and",""),"insert",""),"set","") 
    changechr=replace(replace(replace(replace(changechr,"select",""),"update",""),"delete%20from",""),chr(34),"") 
end function
'/非HTML代码转换函数/
Function Html2Txt(vString)
	vString = replace(vString, ">", "&gt;")
	vString = replace(vString, "<", "&lt;")
	vString = Replace(vString, CHR(32) & CHR(32) & CHR(32) & CHR(32), "&nbsp;&nbsp;&nbsp;&nbsp;")
	vString = Replace(vString, CHR(10) & CHR(10), "<br>")
	vString = Replace(vString, CHR(10), "<BR>")
	Html2Txt = vString
End Function

'/格式化时间/
Function FormatTime(TestTime,style)
	Dim n,y,r,s,f,m
	n = Year(TestTime)
	y = Month(TestTime)
	r = Day(TestTime)
	s = Hour(TestTime)
	f = Minute(TestTime)
	m = Second(TestTime)
	if len(n) = 2 then n = "20" & n
	if len(y) = 1 then y = "0" & y
	if len(r) = 1 then r = "0" & r						
	if len(s) = 1 then s = "0" & s
	if len(f) = 1 then f = "0" & f
	if len(m) = 1 then m = "0" & m
	If style = 1 Then
		FormatTime = "<font color=""#FF0000"">"& n &"</font>年<font color=""#FF0000"">"& y &"</font>月<font color=""#FF0000"">"& r &"</font>日<font color=""#FF0000"">"& s &"</font>时"
	Elseif style = 2 Then
		FormatTime = r &"日 "& s & ":" & f & ":" & m
	Elseif style = 3 Then
		FormatTime = n &"年"& y &"月"& r &"日"
	Elseif style = 4 Then
		FormatTime = n & "/" & y & "/" & r
	Elseif style = 5 then
		FormatTime =  y &"-"& r &"&nbsp;" & s & ":" & f
	Elseif style = 6 then
		FormatTime = n &"年"& y &"月"& r &"日" & s &":"& f
	Elseif style = 7 then
		FormatTime =  n & y & r & s & f & m
	Elseif style = 8 then
		FormatTime = n &"-"& y &"-"& r
	End if
End Function


'/删除一个贴子的附件/
Sub deleteArtAffix(nArtID)
	dim strDelAffix,sqlDelAffix,sqlDeleteFavor
	set strDelAffix = Server.CreateObject("ADODB.Recordset")
	sqlDelAffix = "Select * From ProjectContent Where ProjectID = "& nArtID
	strDelAffix.Open sqlDelAffix,Conn
	if not strDelAffix.EOF then
		if not IsNull(strDelAffix("Affix")) then
			Set Upload = Server.CreateObject("Persits.Upload.1")
			Upload.DeleteFile strUploadFilePath & strDelAffix("Affix")
			Set Upload = nothing
		end if
	end if
	strDelAffix.Close
	set strDelAffix = nothing
End Sub

'/字符串转换函数/
function Htmlencode2(strMsgString)
	strMsgString = replace(strMsgString, ">", "&gt;")
	strMsgString = replace(strMsgString, "<", "&lt;")
	strMsgString = replace(strMsgString, chr(34), "&quot;")
	'strMsgString = replace(strMsgString, "&", "&amp;")
	strMsgString = replace(strMsgString, chr(32), "&nbsp;")
	strMsgString = replace(strMsgString, chr(9), "	")
	strMsgString = replace(strMsgString, chr(13), "<br>")
	strMsgString = replace(strMsgString, "[br]", "<br>")

	Htmlencode2 = strMsgString
end function

'/在一个表中判断用户输入的一个字段的值是否已存在/
Function SearchFieldValue(vTableName,vFieldName,vFieldValue)
	Dim rdsField
	Dim sqlField
	
	set rdsField = Server.CreateObject("ADODB.Recordset")
	sqlField = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	rdsField.Open sqlField,Conn
	if not rdsField.EOF then
		SearchFieldValue = True
	else
		SearchFieldValue = False
	end if
	rdsField.Close
	set rdsField = nothing
end Function
Function bbHTMLDecode(reString) '转换HTML代码
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = Replace(Str, "&amp;", "&")
		Str = Replace(Str, "&gt;", ">")
		Str = Replace(Str, "&lt;", "<")
		Str = Replace(Str, "&nbsp;", CHR(32))
	    Str = Replace(Str, "&nbsp;", CHR(9))
		Str = Replace(Str, "&#160;&#160;&#160;&#160;", CHR(9))
		Str = Replace(Str, "&quot;", CHR(34))
		Str = Replace(Str, "&#39;", CHR(39))
		Str = Replace(Str, "", CHR(13))
		Str = Replace(Str, "<br>", CHR(10))
		Str = Replace(Str, "<BR>", CHR(10))
		bbHTMLDecode = Str
	End If
End Function
function dvHTMLEncode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")

    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")

    dvHTMLEncode = fString
end if
End Function
Function RtnReplaceInt(iCheck,iDefault) 
	If Trim(iCheck)="" Then
		RtnReplaceInt = iDefault
		Exit Function
	End If

	If IsNumeric(iCheck)=false Then
		RtnReplaceInt = iDefault
		Exit Function
	End If

	RtnReplaceInt = iCheck
End Function
'/在一个表中判断用户输入的一个字段是否与其它字段重名，除了他本身以外/
Function SearchEditFieldValue(vTableName,vFieldname,vFieldValue,vIDName,intIDValue)
	Dim rdsField1
	Dim sqlField1
	
	set rdsField1 = Server.CreateObject("ADODB.Recordset")
	sqlField1 = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	rdsField1.Open sqlField1,Conn
	if not rdsField1.EOF then
		do while not rdsField1.EOF
			if int(intIDValue) <> rdsField1(vIDName) then
				SearchEditFieldValue = 1
				exit Function
			end if
			rdsField1.MoveNext
		loop
		SearchEditFieldValue = 0
	end if
	rdsField1.Close
	set rdsField1 = nothing
End Function

'/取字符串函数/
Function OutStr(SourceString,MarkStr,Num)
	SourceStr = SourceString
	If Len(SourceStr) = 0 Then
	 OutStr = "无"
	Else
		Dim StrCount,DelStr,LastStr
		If Mid(SourceStr,Len(SourceStr),1) <> MarkStr Then
			SourceStr = SourceStr + MarkStr
		End if
		StrCount = 1
		Do While Len(SourceStr) > 0
			DelStr = Instr(1,SourceStr,MarkStr)
			LastStr = Mid(SourceStr,1,DelStr - 1)
			SourceStr = Mid(SourceStr,DelStr + 1,Len(SourceStr) - DelStr)
			If StrCount = Num Then
				If LastStr <> "" Then
					OutStr = LastStr
				End if
				Exit Do
			End if
			StrCount = StrCount + 1
		Loop
	End if
End Function
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function
'=================================================
'信息审核:fyinfosh(sh,shid,kword,typejj,page,state,userid,email,lxr)
'sh		        ----- (审核类型,1为审核,0为取消审核)
'shid			----- (审核信息id)
'kword          ----- (如果有检索，当前页的关键字)
'typejj         ----- (如果有检索，当前页的检索类型)
'page           ----- (页码)
'state          ----- (当前页显示信息类型，是否为审核信息)
'userid          ----- (发布者id)
'email          --------(发布者email，如果开启审核邮件通知则发邮件到用户邮箱)
'=================================================
Function fyinfosh(sh,shid,kword,typejj,page,state,userid,email,lxr)
if fla16=1 or Session("intUserLevel") > 2 then
conn.execute("Update Dat_Information Set State ="&sh&" Where InfoKey = ("&shid&")")
'审核加点
if userid<>0 and userid<>"" and sh=1 then
		set rdsMember24 = Server.CreateObject("ADODB.Recordset")
		sqlMember24 = "Select * From Dat_Member Where MemberKey = "&userid
		rdsMember24.Open sqlMember24,Conn,1,3
		rdsMember24("Point") = rdsMember24("Point") +passpoint
		rdsMember24.Update
		rdsMember24.Close
		set rdsMember24 = nothing
end if
if sh=1 then

if email<>"" and fyadmin_ChkEmail(email)=true and mailinfosh=1 then'审核发送邮件通知
FriendName=lxr
	FromName=mailform
	mailbiaoti="信息通过审核"

mailbody="<b><font color=#FF0000>"&FriendName&"</font></b> 你好：</p>"
mailbody=mailbody&"<p>&nbsp;&nbsp;&nbsp; 您在 <a target=_blank href="&strSiteUrl&"><font color=#FF0000>"&strSiteName&"</font></a> "
mailbody=mailbody&"发布的信息 <font color=#FF0000>"&Topic&"</font> "
mailbody=mailbody&"已经通过审核，请点击查看：</p>"
mailbody=mailbody&"<p><a target=_blank href="&strSiteUrl&"><font color=#FF0000>"&strSiteName&"</font></a></p>"

	Dim FYEmail
	Set FYEmail = New Cls_SendMail
	FYEmail.SendObject = Cint(mailser)	'设置选取组件
	FYEmail.ServerLoginName = mailname	'您的邮件服务器登录名
	FYEmail.ServerLoginPass = mailpass	'登录密码
	FYEmail.SendSMTP = mailsmtp			'SMTP地址
	FYEmail.SendFromEmail = mailform		'发送来源地址
	FYEmail.SendFromName =strSiteName		'发送人信息
	If FYEmail.ErrCode = 0 Then
		FYEmail.SendMail FriendEmail,mailbiaoti,mailbody	'执行发送邮件
	End If
	
		If FYEmail.ErrCode <> 0 Then
		Response.write FYEmail.Description
	else
		ErrMsg=ErrMsg & "<br><li>通知邮件发送成功</li>"
	end if

end if


end if
FoundErr=True
ErrMsg=ErrMsg & "<br><li><a href=info.asp?Keyword="&kword&"&typejj="& typejj &"&strstate="&state&"&Page="&page&">返回信息管理</a></li>"
Call Admin_ShowErr(ErrMsg)
else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
End Function
'=================================================
'信息推荐:fyinfotj(tj,shid,kword,typejj,page,state)
'tj		        ----- (推荐类型,1为推荐,0为取消推荐)
'shid			----- (信息id)
'kword          ----- (如果有检索，当前页的关键字)
'typejj         ----- (如果有检索，当前页的检索类型)
'page           ----- (页码)
'state          ----- (当前页显示信息类型，是否为审核信息)
'=================================================
Function fyinfotj(tj,id,kword,typejj,page,state)
if fla13=1 or Session("intUserLevel") > 2 then
conn.execute("Update Dat_Information Set tj ="&tj&" Where InfoKey = ("&id&")")
Response.Redirect "info.asp?Keyword="&kword&"&typejj="& typejj &"&strstate="&state&"&Page="&page&""
else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
End Function
'=================================================
'信息置顶:fyinfozd(zd,shid,kword,typejj,page,state)
'zd		        ----- (置顶类型,1为置顶,0为取消置顶)
'shid			----- (信息id)
'kword          ----- (如果有检索，当前页的关键字)
'typejj         ----- (如果有检索，当前页的检索类型)
'page           ----- (页码)
'state          ----- (当前页显示信息类型，是否为审核信息)
'=================================================
Function fyinfozd(zd,id,kword,typejj,page,state)
if fla14=1 or Session("intUserLevel") > 2 then
conn.execute("Update Dat_Information Set infotop ="&zd&" Where InfoKey = ("&id&")")
Response.Redirect "info.asp?Keyword="&kword&"&typejj="& typejj &"&strstate="&state&"&Page="&page&""
'Response.write("<script>alert(""操作成功！"");location.href=""infomgr.asp?Keyword="&kword&"&typejj="& typejj &"&strstate="&state&"&Page="&page&""";</script>")
'Response.end
else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
End Function
'判断提交信息是否来自外部
Function ChkIsOuter()
		Dim server_v1,server_v2
		ChkIsOuter=True 
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))=server_v2 Then ChkIsOuter=False 
End Function
'检查Email地址合法性
Function fyadmin_ChkEmail(email)
		dim names, name, i, c
		fyadmin_ChkEmail = true : names = Split(email, "@")
		if UBound(names) <> 1 then fyadmin_ChkEmail = false : Exit Function
		for each name in names
			if Len(name) <= 0 then fyadmin_ChkEmail = false:exit function
			for i = 1 to Len(name)
		   	    c = Lcase(Mid(name, i, 1))
				if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
		    	   fyadmin_ChkEmail = false:Exit Function
		   	    end if
		    next
		    if Left(name, 1) = "." or Right(name, 1) = "." then
   		 	    fyadmin_ChkEmail = false:Exit Function
	 	    end if
		next
		if InStr(names(1), ".") <= 0 then fyadmin_ChkEmail = false:exit function
		i = Len(names(1)) - InStrRev(names(1), ".")
		if i <> 2 and i <> 3 then fyadmin_ChkEmail = false : Exit function
		if InStr(email, "..") > 0 then fyadmin_ChkEmail = false
End Function
'=================================================
'信息审核:fyinfoplsh(rcid,kword,typejj,page,state)
'rcid			    ----- (信息id)
'kword          ----- (如果有检索，当前页的关键字)
'typejj         ----- (如果有检索，当前页的检索类型)
'page           ----- (页码)
'state          ----- (当前页显示信息类型，是否为审核信息)
'=================================================
Function fyinfoplsh(rcID,kword,typejj,page,state)
rcID=Replace(rcID," ","")
if Not IsNumeric(Replace(rcID,",","")) then
Response.write "错误！"
Response.end
end if

'批量审核
if fla16=1 or Session("intUserLevel") > 2 then

SQL="select InfoKey,MemberKey,Email,State,ContactMan,Topic from Dat_Information where InfoKey in (" &rcID& ") "

	Set rsP= Server.CreateObject("ADODB.Recordset")
	rsP.open SQL,Conn,1,1
if Not rsP.eof then
		SQL = rsP.GetRows(-1)
		For i=0 To Ubound(SQL,2)
			InfoKey=SQL(0,i)
			MemberKey=SQL(1,i)
			Email=SQL(2,i)
			ContactMan=SQL(4,i)
			Topic=SQL(5,i)
			
'审核
conn.execute("Update Dat_Information Set State =1 Where InfoKey = ("&InfoKey&")")
'加点
if MemberKey<>0 and MemberKey<>"" and passpoint>0 then
conn.execute("Update Dat_Member Set Point=Point+"&passpoint&" Where MemberKey= ("&MemberKey&")")
end if
if Email<>"" and fyadmin_ChkEmail(Email)=true and mailinfosh=1 then'审核发送邮件通知
FriendName=ContactMan
	FromName=mailform
	mailbiaoti="信息通过审核"

mailbody="<b><font color=#FF0000>"&FriendName&"</font></b> 你好：</p>"
mailbody=mailbody&"<p>&nbsp;&nbsp;&nbsp; 您在 <a target=_blank href="&strSiteUrl&"><font color=#FF0000>"&strSiteName&"</font></a> "
mailbody=mailbody&"发布的信息 <font color=#FF0000>"&Topic&"</font> "
mailbody=mailbody&"已经通过审核，请点击查看：</p>"
mailbody=mailbody&"<p><a target=_blank href="&strSiteUrl&"><font color=#FF0000>"&strSiteName&"</font></a></p>"

	Dim FYEmail
	Set FYEmail = New Cls_SendMail
	FYEmail.SendObject = Cint(mailser)	'设置选取组件
	FYEmail.ServerLoginName = mailname	'您的邮件服务器登录名
	FYEmail.ServerLoginPass = mailpass	'登录密码
	FYEmail.SendSMTP = mailsmtp			'SMTP地址
	FYEmail.SendFromEmail = mailform		'发送来源地址
	FYEmail.SendFromName =strSiteName		'发送人信息
	If FYEmail.ErrCode = 0 Then
		FYEmail.SendMail FriendEmail,mailbiaoti,mailbody	'执行发送邮件
	End If

end if
		Next
	End if
	rsP.close : set rsP=Nothing
end if
End Function
'=================================================
'信息删除:fyinfodel(rcid,kword,typejj,page,state)
'rcid			    ----- (信息id)
'kword          ----- (如果有检索，当前页的关键字)
'typejj         ----- (如果有检索，当前页的检索类型)
'page           ----- (页码)
'state          ----- (当前页显示信息类型，是否为审核信息)
'=================================================
Function fyinfodel(rcID,kword,typejj,page,state)
rcID=Replace(rcID," ","")
if Not IsNumeric(Replace(rcID,",","")) then
Response.write "错误！"
Response.end
end if

if fla17=1 or Session("intUserLevel") > 2 then
	if instr(rcID,",")>0 then
	'response.write rcID
		dim idArr,i
		idArr=split(rcID,",")
		for i = 0 to ubound(idArr)
			call Delinfogq(clng(idArr(i)))
		next
	else
	call Delinfogq(clng(rcID))
	end if
Response.write("<script>alert(""操作成功！"");location.href=""info.asp?Keyword="&kword&"&typejj="& typejj &"&strstate="&state&"&Page="&page&""";</script>")
Response.end
else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
End Function
sub Delinfogq(ID)
	sqlDel="select * from Dat_Information where InfoKey=" &ID
	Set rsDel= Server.CreateObject("ADODB.Recordset")
	rsDel.open sqlDel,conn,1,3
		rsDel.delete
		rsDel.update
		rsDel.close
		set rsDel=nothing
end sub
Function getHTTPPage(Path)
on error resume next
        t = GetBody(Path)
        getHTTPPage=BytesToBstr(t,"GB2312")
End function

Function GetBody(url) 
        on error resume next
        Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
        With Retrieval 
        .Open "Get", url, False, "", "" 
        .Send 
        GetBody = .ResponseBody
        End With 
        Set Retrieval = Nothing 
End Function

Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("Adodb." & "Str" & "eam")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function
Function Newstring(wstr,strng)
        Newstring=Instr(lcase(wstr),lcase(strng))
        if Newstring<=0 then Newstring=Len(wstr)
End Function
Sub Admin_ShowErr(sErrMsg)
	Response.Write "<html><head><title>信息提示</title>"
	Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
	Response.Write "<link href=""images/Admin_Style.Css"" rel=""stylesheet"" type=""text/css"">"
	Response.Write "</head><body><br><br>"
	Response.Write "<table cellpadding=2 cellspacing=1 border=0 class=""border"" align=center>"
	Response.Write "<tr align=""center"" class=""title""><td height=""22""><strong>信息提示</strong></td></tr>"
	Response.Write "<tr class=""tdbg""><td height=""100"" valign=""top"">"&sErrMsg&"</td></tr>"
	Response.Write "<tr align=""center"" class=""tdbg""><td>【<a href=""javascript:history.go(-1)"">返回上一步</a>】&nbsp;&nbsp;【<a href=""javascript:window.close();"">关闭窗口</a>】</td></tr>"
	Response.Write "</table></body></html>"
	CloseAllObj
	response.end
End Sub
'=================================================
'saveeditinfo()
'管理员修改供求信息
'=================================================
sub saveeditinfo()
id=changechr(Request("id"))
	Dim editinfo
            set editinfo = Server.CreateObject("ADODB.Recordset")
			editinfo.Open "Dat_Information Where InfoKey = "& id,Conn,3,3
			editinfo("InfoAdd") = changechr(Request.Form("Sheng"))
			editinfo("smalldq") = changechr(Request.Form("shi"))
			editinfo("InfoClass") = changechr(Request.Form("InfoClass"))
			editinfo("Topic") = changechr(Request.Form("Topic"))
			editinfo("Content") =replace(Request.Form("Content"),gqwebdir&"Upload","{%gqwebdir%}Upload")
			editinfo("ContactMan") = changechr(Request.Form("ContactMan"))
			editinfo("CompanyName") = changechr(Request.Form("CompanyName"))
			editinfo("Add") = changechr(Request.Form("Add"))
			editinfo("qq") = changechr(Request.Form("qq"))
			editinfo("Postalcode") = changechr(Request.Form("Postalcode"))
			editinfo("Tel") = changechr(Request.Form("Tel"))
			editinfo("Homepage") = changechr(Request.Form("Homepage"))
			editinfo("Email") = changechr(Request.Form("Email"))
			editinfo("InfoDate") = changechr(Request.Form("InfoDate"))
						editinfo("dl") = changechr(Request.Form("BigClassName"))
	editinfo("xl") = changechr(Request.Form("SmallClassName"))
	editinfo("jg") = changechr(Request.Form("jg"))
	editinfo("pic") = replace(UCase(Request.Form("pic")),gqwebdir&"UPLOAD","Upload")
	editinfo("color") = changechr(Request.Form("infocolor"))
	editinfo("UploadFiles") =replace(UCase(Request.Form("UploadFiles")),gqwebdir&"UPLOAD","Upload")

			editinfo.Update
			editinfo.Close
			set editinfo = nothing
Response.Redirect "info.asp?bbaction=viewinfo&id="&id&""
end sub
sub saveeditpoint()
		intMemberKey = Request("ID")
		strAdd = Request.Form("Add")
		intUpdateCount = Request.Form("UpdateCount")
		
		set rdsMemberCount = Server.CreateObject("ADODB.Recordset")
		rdsMemberCount.Open "Dat_MemberCount",Conn,3,3
		rdsMemberCount.AddNew
		rdsMemberCount("MemberKey") = intMemberKey
		rdsMemberCount("Add") = strAdd
		rdsMemberCount("UpdateCount") = Request.Form("UpdateCount")
		rdsMemberCount("Remark") = Request.Form("Remark")
		rdsMemberCount("UpdateTime") =now()
		rdsMemberCount.Update
		rdsMemberCount.Close
		set rdsMemberCount = nothing
		
		set rdsMember = Server.CreateObject("ADODB.Recordset")
		sqlMember = "Select * From Dat_Member Where MemberKey = "& intMemberKey
		rdsMember.Open sqlMember,Conn,1,3
		
		if strAdd = 0 then
			rdsMember("Point") = rdsMember("Point") + intUpdateCount
		else
			rdsMember("Point") = rdsMember("Point") - intUpdateCount
		end if
		rdsMember.Update
		rdsMember.Close
		set rdsMember = nothing
Response.Redirect "user.asp"
end sub
'设置会员级别
'=================================================
sub savejb()
	intMemberKey = Request("ID")
		jb = Request.Form("jb")
	
	sqljbMember = "Update Dat_Member Set jb ="&jb&" Where MemberKey = "& intMemberKey
		Conn.Execute sqljbMember
Response.Redirect "user.asp"
end sub
'=================================================
'saveaddinfo()
'管理员添加供求信息
'=================================================
sub saveaddinfo()
intMemberKey=0
		Set rsmaxid= Conn.Execute("select max(infokey) from Dat_Information")
		MaxAID=rsmaxid(0)
		if isnull(MaxAID) or Not IsNumeric(MaxAID) then MaxAID=0
		MaxAID=MaxAID+1
		rsmaxid.close
		set rsmaxid=nothing
	Dim editinfo
	dq=changechr(Request.Form("sheng"))
lx=changechr(Request.Form("InfoClass"))
bname=changechr(Request.Form("BigClassName"))
            set editinfo = Server.CreateObject("ADODB.Recordset")
			editinfo.Open "Dat_Information",Conn,3,3
			editinfo.AddNew
			editinfo("MemberKey") = intMemberKey
			editinfo("Topic") = changechr(Request.Form("Topic"))
			editinfo("InfoClass") = lx

			editinfo("Content") =replace(Request.Form("Content"),gqwebdir&"Upload","{%gqwebdir%}Upload")
			editinfo("ContactMan") = changechr(Request.Form("ContactMan"))
			editinfo("CompanyName") = changechr(Request.Form("CompanyName"))
			editinfo("Add") = changechr(Request.Form("Add"))
			editinfo("qq") = changechr(Request.Form("qq"))
			editinfo("Postalcode") = changechr(Request.Form("Postalcode"))
			editinfo("Tel") = changechr(Request.Form("Tel"))
			editinfo("fax") = changechr(Request.Form("fax"))
			editinfo("Homepage") = changechr(Request.Form("Homepage"))
			editinfo("Email") = changechr(Request.Form("Email"))
			editinfo("InfoAdd") = dq
			editinfo("smalldq") = changechr(Request.Form("shi"))
			editinfo("InfoDate") = changechr(Request.Form("InfoDate"))
			editinfo("dl") =bname
	editinfo("xl") = changechr(Request.Form("SmallClassName"))
	editinfo("jg") = changechr(Request.Form("jg"))
	editinfo("pic") = replace(UCase(Request.Form("pic")),gqwebdir&"UPLOAD","Upload")
	editinfo("color") = changechr(Request.Form("infocolor"))
	editinfo("UploadFiles") =replace(UCase(Request.Form("UploadFiles")),gqwebdir&"UPLOAD","Upload")
	editinfo("State") = 1
	editinfo("Ip") =GetIp()
	editinfo("CreateTime") = now()
if changechr(Request.Form("tj"))="true" then
	editinfo("tj") =1
end if
if changechr(Request.Form("infotop"))="true" then
	editinfo("infotop") =1
end if

			editinfo.Update
			editinfo.Close
			set editinfo = nothing
			
Response.Redirect "info.asp"
end sub
sub saveeditpoint()
		intMemberKey = Request("ID")
		strAdd = Request.Form("Add")
		intUpdateCount = Request.Form("UpdateCount")
		
		set rdsMemberCount = Server.CreateObject("ADODB.Recordset")
		rdsMemberCount.Open "Dat_MemberCount",Conn,3,3
		rdsMemberCount.AddNew
		rdsMemberCount("MemberKey") = intMemberKey
		rdsMemberCount("Add") = strAdd
		rdsMemberCount("UpdateCount") = Request.Form("UpdateCount")
		rdsMemberCount("Remark") = Request.Form("Remark")
		rdsMemberCount("UpdateTime") =now()
		rdsMemberCount.Update
		rdsMemberCount.Close
		set rdsMemberCount = nothing
		
		set rdsMember = Server.CreateObject("ADODB.Recordset")
		sqlMember = "Select * From Dat_Member Where MemberKey = "& intMemberKey
		rdsMember.Open sqlMember,Conn,1,3
		
		if strAdd = 0 then
			rdsMember("Point") = rdsMember("Point") + intUpdateCount
		else
			rdsMember("Point") = rdsMember("Point") - intUpdateCount
		end if
		rdsMember.Update
		rdsMember.Close
		set rdsMember = nothing
Response.Redirect "user.asp"
end sub
sub savejb()
	intMemberKey = Request("ID")
		jb = Request.Form("jb")
	
	sqljbMember = "Update Dat_Member Set jb ="&jb&" Where MemberKey = "& intMemberKey
		Conn.Execute sqljbMember
Response.Redirect "user.asp"
end sub

'======================================
'lockuser锁定开启用户
'======================================
sub lockuser()
if fla4<>1 and Session("intUserLevel")<2 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
lx=Request("lx")
	intLockMemberID = Request("ID")
		sqlLockMember = "Update Dat_Member Set State ="&lx&" Where MemberKey = "& intLockMemberID
		Conn.Execute sqlLockMember
Response.Redirect "user.asp"
end sub
sub deluser()
if fla5<>1 and Session("intUserLevel")<2 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if

	Dim intDelMemberKey
	Dim sqlDelMember
	
	intDelMemberKey = Request("ID")
	
		sqlDelMember = "Delete From Dat_Member Where MemberKey = "& intDelMemberKey
		Conn.Execute sqlDelMember

Response.Redirect "user.asp"
end sub
sub saveeditnews()
	Dim rdsEditNews
	Dim sqlEditNews
	
	set rdsEditNews = Server.CreateObject("ADODB.Recordset")
	sqlEditNews = "Select * From Dat_News Where NewsKey = "& Request("Id")
	rdsEditNews.Open sqlEditNews,Conn,3,3
	
	rdsEditNews("NewsClass") = Request.Form("NewsClass")
	rdsEditNews("Topic") = Request.Form("Topic")
	rdsEditNews("From") = Request.Form("From")
	rdsEditNews("Content") =replace(Request.Form("Content"),gqwebdir&"Upload","{%gqwebdir%}Upload")
	rdsEditNews("PhotoName") = Request.Form("PhotoName")
	rdsEditNews("UploadFiles") =replace(UCase(Request.Form("UploadFiles")),gqwebdir&"UPLOAD","Upload")
	rdsEditNews.Update
	rdsEditNews.Close
	set rdsEditNews = nothing
	Response.Redirect "news.asp"
end sub
sub saveaddnews
	Dim rdsNews
	
	set rdsNews = Server.CreateObject("ADODB.Recordset")
	rdsNews.Open "Dat_News",Conn,3,3
	
	rdsNews.AddNew
	rdsNews("NewsClass") = Request.Form("NewsClass")
	rdsNews("Topic") = Request.Form("Topic")
	rdsNews("From") = Request.Form("From")
	rdsNews("Content") =replace(Request.Form("Content"),gqwebdir&"Upload","{%gqwebdir%}Upload")
	rdsNews("PhotoName") = Request.Form("PhotoName")
	rdsNews("UploadFiles") =replace(UCase(Request.Form("UploadFiles")),gqwebdir&"UPLOAD","Upload")
	rdsNews("Hits") = 0
	rdsNews("State") = 1
	rdsNews("CreateTime") = now()
	rdsNews.Update
	rdsNews.Close
	set rdsNews = nothing
	Response.Redirect "news.asp"
end sub
sub delnews
	set rdsDelNews = Server.CreateObject("ADODB.Recordset")
		sqlDelNews = "Select * From Dat_News Where NewsKey = "& Request("ID")
		rdsDelNews.Open sqlDelNews,Conn,1,1

sqlDelNews = "Delete from Dat_News Where NewsKey = "& Request("ID")

		Conn.Execute sqlDelNews
		
		rdsDelNews.Close
		set rdsDelNews = nothing
Response.Redirect "news.asp"
end sub
'=================================================
'新闻关闭/审核:fyusersh()
'=================================================
Function fynewssh()
if fla4=1 or Session("intUserLevel") > 2 then
sh=request("lx")
sqlLockMember = "Update Dat_News Set State ="&sh&" Where NewsKey= "&request("id")
Conn.Execute sqlLockMember
Response.Redirect "news.asp"
Response.end
else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
End Function
'=================================================
'添加供求大类:saveaddbig()
'=================================================
Function saveaddbig()
if fla18=1 or Session("intUserLevel") > 2 then
BigClassName=trim(request("BigClassName"))
pic=trim(request("pic"))
admin=trim(request("admin"))
	if BigClassName="" then
		FoundErr=True
		ErrMsg=ErrMsg & "大类名不能为空！"
		Call Admin_ShowErr(ErrMsg)
	end if
	if FoundErr<>True then
		Set rs=Server.CreateObject("Adodb.RecordSet")
		rs.open "Select * From BigClass Where BigClassName='" & BigClassName & "'",conn,1,3
		if not (rs.bof and rs.EOF) then
			FoundErr=True
			ErrMsg=ErrMsg & "大类“" & BigClassName & "”已经存在！"
			Call Admin_ShowErr(ErrMsg)
		else
    	 	rs.addnew
     		rs("BigClassName")=BigClassName
     		rs("pic")=pic
     		rs("admin")=admin
     		rs("sj")=now()
    	 	rs.update
     		rs.Close
	     	set rs=Nothing
    	 	conn.close
    	 	set conn=nothing
			Response.Redirect "infoclass.asp"  
		end if
	end if
end if
End Function
sub deldl
BigClassName=trim(Request("BigClassName"))
dl=trim(Request("dl"))
if BigClassName<>"" then
	sql="delete from BigClass where BigClassName='" & BigClassName & "'"
	conn.Execute sql
	sql="delete from SmallClass where dl='" & dl & "'"
	conn.Execute sql
    sql="delete from Dat_Information where dl='" & dl & "'"
	conn.Execute sql
end if
conn.close
set conn=nothing    
response.redirect "infoclass.asp"
end sub
sub deldldq
strname=trim(Request("BigClassName"))
dl=trim(Request("dl"))
if strname<>"" then
	sql="delete from mxdq where name='"&strname&"'"
	conn.Execute sql
	sql="delete from Dat_Information where InfoAdd='"&strname&"'"
	conn.Execute sql
	sql="delete from fysmallmxdq where dl='"&request("dl")&"'"
	conn.Execute sql
end if
conn.close
set conn=nothing    
response.redirect "addclass.asp"
end sub
sub delxl
SmallClassID=trim(Request("SmallClassID"))
SmallClassName=trim(Request("SmallClassName"))
if SmallClassID<>"" then
	sqld="delete from Dat_Information where xl='" & SmallClassID & "'"
	conn.Execute sqld
	sql="delete from SmallClass where SmallClassName='" &SmallClassName& "'"
	conn.Execute sql
end if
conn.close
set conn=nothing    
response.redirect "infoclass.asp"
end sub
sub delxldq
fysmallmxdqID=trim(Request("SmallClassID"))
fysmallmxdqName=trim(Request("SmallClassName"))
if fysmallmxdqID<>"" then
	sqld="delete from Dat_Information where smalldq='" &fysmallmxdqName& "'"
	conn.Execute sqld
	sql="delete from fysmallmxdq where SmallClassName='" &fysmallmxdqName& "'"
	conn.Execute sql
end if
conn.close
set conn=nothing    
response.redirect "addclass.asp"
end sub
sub aa
set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from BigClass where id="&request("id")
rs.open sql,conn,1,3
rs("sj")=now()
rs.Update
rs.Close
set rs=nothing
response.redirect "infoclass.asp"
end sub
sub aaa
set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from smallClass where id="&request("xlid")
rs.open sql,conn,1,3
rs("sj")=now()
rs.Update
rs.Close
set rs=nothing
response.redirect "infoclass.asp"
end sub
sub bb
set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from mxdq where id="&request("id")
rs.open sql,conn,1,3
rs("sj")=now()
rs.Update
rs.Close
set rs=nothing
Response.Redirect "addclass.asp"
end sub
sub bbb
set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from fysmallmxdq where id="&request("xlid")
rs.open sql,conn,1,3
rs("sj")=now()
rs.Update
rs.Close
set rs=nothing
Response.Redirect "addclass.asp"
end sub
sub saveaddsmall
dl=trim(request("dl"))
SmallClassName=trim(request("SmallClassName"))
	if SmallClassName="" then
		FoundErr=True
		ErrMsg=ErrMsg & "小类名不能为空！"
		Call Admin_ShowErr(ErrMsg)
	end if
	if FoundErr<>True then
		Set rs=Server.CreateObject("Adodb.RecordSet")
		rs.open "Select * From SmallClass Where dl='" & dl & "' AND SmallClassName='" & SmallClassName & "'",conn,1,3
		if not rs.EOF then
			FoundErr=True
			ErrMsg=ErrMsg & "“" & BigClassName & "”中已经存在小类“" & SmallClassName & "”！"
			Call Admin_ShowErr(ErrMsg)
		else
     		rs.addnew
    	 	rs("SmallClassName")=SmallClassName
    	 	rs("dl")=dl
    	 	rs("sj")=now()
     		rs.update
	     	rs.Close
    	 	set rs=Nothing
     		conn.close
set conn=nothing
			response.redirect "infoclass.asp"
		end if
	end if
end sub
'=================================================
'修改信息大类:saveeditbig()
'=================================================
sub saveeditbig
BigClassID=trim(Request("BigClassID"))
NewBigClassName=trim(Request("NewBigClassName"))
OldBigClassName=trim(Request("OldBigClassName"))
pic=trim(Request("pic"))
admin=trim(Request("admin"))

if BigClassID="" then
  response.Redirect("infoclass.asp")
end if
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * from BigClass where ID=" & CLng(BigClassID),conn,1,3
if rs.Bof and rs.EOF then
	FoundErr=True
	ErrMsg=ErrMsg & "此大类不存在！"
Call Admin_ShowErr(ErrMsg)
else
		if NewBigClassName="" then
			FoundErr=True
			ErrMsg=ErrMsg & "大类名不能为空！"
Call Admin_ShowErr(ErrMsg)
		end if
		if FoundErr<>True then
rs("BigClassName")=NewBigClassName
rs("pic")=pic
rs("admin")=admin
    	 	rs.update
			rs.Close
	     	set rs=Nothing
			conn.close
set conn=nothing
     		response.Redirect("infoclass.asp")
		end if
end if
end sub
'=================================================
'修改信息小类:saveeditsmall()
'=================================================
sub saveeditsmall
SmallClassID=trim(Request("SmallClassID"))
dl=trim(Request.form("dl"))
odl=trim(Request("odl"))
SmallClassName=trim(Request.form("SmallClassName"))
OldSmallClassName=trim(request.form("OldSmallClassName"))
if SmallClassID="" then
	response.Redirect("infoclass.asp")
end if
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * from SmallClass where ID="&SmallClassID&"",conn,1,3
if rs.Bof or rs.EOF then
	FoundErr=True
	ErrMsg=ErrMsg & "此小类不存在！"
Call Admin_ShowErr(ErrMsg)
else
		if SmallClassName="" then
			FoundErr=True
			ErrMsg=ErrMsg & "小类名不能为空！"
Call Admin_ShowErr(ErrMsg)
		end if
		if FoundErr<>True then
		if dl<>odl then
		rs("dl")=dl
		end if
			rs("SmallClassName")=SmallClassName
     		rs.update
			rs.Close
    	 	set rs=Nothing
			if dl<>odl then
				conn.execute "Update Dat_Information set dl='" & dl & "' where xl='" & SmallClassID & "'"
	     	end if	
			conn.close
set conn=nothing
    	 	Response.Redirect "infoclass.asp"
		end if
end if
end sub
'=================================================
'添加地区大类:saveaddbigdq()
'=================================================
Function saveaddbigdq()
if fla20=1 or Session("intUserLevel") > 2 then
BigClassName=trim(request("Name"))
admin=trim(request("admin"))
	if BigClassName="" then
		FoundErr=True
		ErrMsg=ErrMsg & "大类名不能为空！"
		Call Admin_ShowErr(ErrMsg)
	end if
	if FoundErr<>True then
		Set rs=Server.CreateObject("Adodb.RecordSet")
		rs.open "Select * From mxdq Where Name='" & BigClassName & "'",conn,1,3
		if not (rs.bof and rs.EOF) then
			FoundErr=True
			ErrMsg=ErrMsg & "大类“" & BigClassName & "”已经存在！"
			Call Admin_ShowErr(ErrMsg)
		else
    	 	rs.addnew
     		rs("Name")=BigClassName
     		rs("admin")=admin
     		rs("sj")=now()
    	 	rs.update
     		rs.Close
	     	set rs=Nothing
    	 	conn.close
    	 	set conn=nothing
			Response.Redirect "addclass.asp"  
		end if
	end if
end if
End Function
'=================================================
'添加地区小类:saveaddsmalldq()
'=================================================
sub saveaddsmalldq
dl=trim(request("dl"))
SmallClassName=trim(request("SmallClassName"))
	if SmallClassName="" then
		FoundErr=True
		ErrMsg=ErrMsg & "小类名不能为空！"
		Call Admin_ShowErr(ErrMsg)
	end if
	if FoundErr<>True then
		Set rs=Server.CreateObject("Adodb.RecordSet")
		rs.open "Select * From fysmallmxdq Where dl='" & dl & "' AND SmallClassName='" & SmallClassName & "'",conn,1,3
		if not rs.EOF then
			FoundErr=True
			ErrMsg=ErrMsg & "“" & BigClassName & "”中已经存在小类“" & SmallClassName & "”！"
			Call Admin_ShowErr(ErrMsg)
		else
     		rs.addnew
    	 	rs("SmallClassName")=SmallClassName
    	 	rs("dl")=dl
    	 	rs("sj")=now()
     		rs.update
	     	rs.Close
    	 	set rs=Nothing
     		conn.close
set conn=nothing
			response.redirect "addclass.asp"
		end if
	end if
end sub
'=================================================
'修改地区大类:saveeditbigdq()
'=================================================
sub saveeditbigdq
ID=trim(Request("ID"))
NewBigClassName=trim(Request("NewBigClassName"))
OldBigClassName=trim(Request("OldBigClassName"))
admin=trim(Request("admin"))
if ID="" then
  response.Redirect("addclass.asp")
end if
if NewBigClassName<>OldBigClassName then
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * from mxdq where ID=" & CLng(ID),conn,1,3
if rs.Bof and rs.EOF then
	FoundErr=True
	ErrMsg=ErrMsg & "此产品大类不存在！"
Call Admin_ShowErr(ErrMsg)
else
		if NewBigClassName="" then
			FoundErr=True
			ErrMsg=ErrMsg & "地区名不能为空！"
Call Admin_ShowErr(ErrMsg)
		end if
		if FoundErr<>True then
			rs("Name")=NewBigClassName
			rs("admin")=admin
    	 	rs.update
			rs.Close
	     	set rs=Nothing
conn.execute "Update fysmallmxdq set dl='" &NewBigClassName& "' where dl='" & OldBigClassName& "'"
conn.execute "Update Dat_Information set InfoAdd='" &NewBigClassName& "' where InfoAdd='" & OldBigClassName& "'"
conn.close
set conn=nothing
Response.Redirect "addclass.asp" 
end if
end if
end if
end sub
'=================================================
'修改地区小类:saveeditsmalldq()
'=================================================
sub saveeditsmalldq
SmallClassID=trim(Request("SmallClassID"))
dl=trim(Request("dl"))
odl=trim(Request("odl"))
oldSmallClassname=trim(Request("oldSmallClassname"))
SmallClassName=trim(Request("SmallClassName"))
if SmallClassID="" then
	response.Redirect("addclass.asp")
end if
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * from fysmallmxdq where ID="&SmallClassID&"",conn,1,3
if rs.Bof or rs.EOF then
	FoundErr=True
	ErrMsg=ErrMsg & "此小类不存在！"
Call Admin_ShowErr(ErrMsg)
else
if SmallClassName="" then
			FoundErr=True
			ErrMsg=ErrMsg & "小类名不能为空！"
Call Admin_ShowErr(ErrMsg)
end if
if SmallClassName=oldSmallClassname and dl=odl then
			FoundErr=True
			ErrMsg=ErrMsg & "您没有做任何修改！"
Call Admin_ShowErr(ErrMsg)
end if
		if FoundErr<>True then
		if dl<>odl then
		rs("dl")=dl
		end if
		rs("SmallClassName")=SmallClassName
     	rs.update
		rs.Close
    	set rs=Nothing
conn.execute "Update Dat_Information set smalldq='" &SmallClassName& "' where smalldq='" &OldSmallClassName& "'"
conn.close
set conn=nothing
Response.Redirect "addclass.asp"
end if
end if
end sub
'========================================
'saveaddbighy()
'添加黄页一级栏目
'========================================
sub saveaddbighy
BigClassName=trim(request("BigClassName"))
pic=trim(request("pic"))
	if BigClassName="" then
		FoundErr=True
		ErrMsg=ErrMsg & "大类名不能为空！"
		Call Admin_ShowErr(ErrMsg)
	end if
	if FoundErr<>True then
		Set rs=Server.CreateObject("Adodb.RecordSet")
		rs.open "Select * From hyBigClass Where BigClassName='" & BigClassName & "'",conn,1,3
		if not (rs.bof and rs.EOF) then
			FoundErr=True
			ErrMsg=ErrMsg & "大类“" & BigClassName & "”已经存在！"
			Call Admin_ShowErr(ErrMsg)
		else
    	 	rs.addnew
     		rs("BigClassName")=BigClassName
     		rs("pic")=pic
     		rs("sj")=now()
    	 	rs.update
     		rs.Close
	     	set rs=Nothing
    	 	conn.close
    	 	set conn=nothing
			Response.Redirect "hyClass.asp"  
		end if
	end if
end sub
'========================================
'deldlhy()
'删除黄页大类
'========================================
sub deldlhy
BigClassName=trim(Request("BigClassName"))
dl=trim(Request("dl"))
if BigClassName<>"" then
	sql="delete from hyBigClass where BigClassName='" & BigClassName & "'"
	conn.Execute sql
	sql="delete from hySmallClass where dl='" & dl & "'"
	conn.Execute sql
end if
conn.close
set conn=nothing    
response.redirect "hyClass.asp"
end sub
'========================================
'delxlhy()
'删除黄页小类
'========================================
sub delxlhy
SmallClassID=trim(Request("SmallClassID"))
SmallClassName=trim(Request("SmallClassName"))
if SmallClassID<>"" then
	sql="delete from hySmallClass where SmallClassName='" &SmallClassName& "'"
	conn.Execute sql
end if
conn.close
set conn=nothing  
response.redirect "hyClass.asp"
end sub
'========================================
'saveaddsmallhy()
'添加黄页小类
'========================================
sub saveaddsmallhy
dl=trim(request("dl"))
SmallClassName=trim(request("SmallClassName"))
	if SmallClassName="" then
		FoundErr=True
		ErrMsg=ErrMsg & "小类名不能为空！"
		Call Admin_ShowErr(ErrMsg)
	end if
	if FoundErr<>True then
		Set rs=Server.CreateObject("Adodb.RecordSet")
		rs.open "Select * From hySmallClass Where dl='" & dl & "' AND SmallClassName='" & SmallClassName & "'",conn,1,3
		if not rs.EOF then
			FoundErr=True
			ErrMsg=ErrMsg & "“" & BigClassName & "”中已经存在小类“" & SmallClassName & "”！"
			Call Admin_ShowErr(ErrMsg)
		else
     		rs.addnew
    	 	rs("SmallClassName")=SmallClassName
    	 	rs("dl")=dl
    	 	rs("sj")=now()
     		rs.update
	     	rs.Close
    	 	set rs=Nothing
     		conn.close
set conn=nothing
		response.redirect "hyClass.asp"
		end if
	end if
end sub
'=================================================
'修改黄页大类:saveeditbighy()
'=================================================
sub saveeditbighy
BigClassID=trim(Request("BigClassID"))
NewBigClassName=trim(Request("NewBigClassName"))
OldBigClassName=trim(Request("OldBigClassName"))
pic=trim(Request("pic"))
admin=trim(Request("admin"))

if BigClassID="" then
  response.Redirect("infoclass.asp")
end if
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * from hyBigClass where ID=" & CLng(BigClassID),conn,1,3
if rs.Bof and rs.EOF then
	FoundErr=True
	ErrMsg=ErrMsg & "此大类不存在！"
Call Admin_ShowErr(ErrMsg)
else
		if NewBigClassName="" then
			FoundErr=True
			ErrMsg=ErrMsg & "大类名不能为空！"
Call Admin_ShowErr(ErrMsg)
		end if
		if FoundErr<>True then
rs("BigClassName")=NewBigClassName
rs("pic")=pic
    	 	rs.update
			rs.Close
	     	set rs=Nothing
			conn.close
set conn=nothing
     		response.Redirect("hyclass.asp")
		end if
end if
end sub
'=================================================
'修改黄页小类:saveeditsmallhy()
'=================================================
sub saveeditsmallhy
SmallClassID=trim(Request("SmallClassID"))
dl=trim(Request.form("dl"))
odl=trim(Request("odl"))
SmallClassName=trim(Request.form("SmallClassName"))
OldSmallClassName=trim(request.form("OldSmallClassName"))
if SmallClassID="" then
	response.Redirect("infoclass.asp")
end if
Set rs=Server.CreateObject("Adodb.RecordSet")
rs.Open "Select * from hySmallClass where ID="&SmallClassID&"",conn,1,3
if rs.Bof or rs.EOF then
	FoundErr=True
	ErrMsg=ErrMsg & "此小类不存在！"
Call Admin_ShowErr(ErrMsg)
else
		if SmallClassName="" then
			FoundErr=True
			ErrMsg=ErrMsg & "小类名不能为空！"
Call Admin_ShowErr(ErrMsg)
		end if
		if FoundErr<>True then
		if dl<>odl then
		rs("dl")=dl
		end if
			rs("SmallClassName")=SmallClassName
     		rs.update
			rs.Close
    	 	set rs=Nothing
			if dl<>odl then
				conn.execute "Update Dat_Information set dl='" & dl & "' where xl='" & SmallClassID & "'"
	     	end if	
			conn.close
set conn=nothing
    	 	Response.Redirect "hyclass.asp"
		end if
end if
end sub
sub cc
set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from hyBigClass where id="&request("id")
rs.open sql,conn,1,3
rs("sj")=now()
rs.Update
rs.Close
set rs=nothing
response.redirect "hyclass.asp"
end sub
sub ccc
set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from hysmallClass where id="&request("xlid")
rs.open sql,conn,1,3
rs("sj")=now()
rs.Update
rs.Close
set rs=nothing
response.redirect "hyclass.asp"
end sub
'=============================
'删除反馈信息
'=============================
sub delguestbook
	Dim sqlDelFeedBack
if fla21=1 or Session("intUserLevel") > 2 then

sqlDelFeedBack = "Delete from Dat_FeedBack Where FeedBackKey = "& Request("ID")

		Conn.Execute sqlDelFeedBack
		
response.redirect "guestbook.asp"
	else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
	end if
end sub
'==================================
'saveaddlink添加友情链接
'==================================
sub saveaddlink
	Dim rdsLink
	
	set rdsLink = Server.CreateObject("ADODB.Recordset")
	rdsLink.Open "Dat_Link",Conn,3,3
	
	rdsLink.AddNew
	rdsLink("LinkClass") = Request.Form("LinkClass")
	rdsLink("Homepage") = Request.Form("Homepage")
	rdsLink("Url") = Request.Form("Url")
	rdsLink("Content") = Request.Form("Content")
	rdsLink("State") = 0
	rdsLink("CreateTime") = now()
	rdsLink.Update
	rdsLink.Close
	set rdsLink = nothing
response.redirect "link.asp"
end sub
'======================================
'locklink锁定开启链接
'======================================
sub locklink()
if fla22<>1 and Session("intUserLevel")<2 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
lx=Request("lx")
	intLocklinkid = Request("ID")
		sqlLockMember = "Update Dat_Link Set State ="&lx&" Where LinkKey = "&intLocklinkid
		Conn.Execute sqlLockMember
response.redirect "link.asp"
end sub
'======================================
'saveeditlink修改链接
'======================================
sub saveeditlink
	Dim rdsEditLink
	Dim sqlEditLink
	
	set rdsEditLink = Server.CreateObject("ADODB.Recordset")
	sqlEditLink = "Select * From Dat_Link Where LinkKey = "& Request("Id")
	rdsEditLink.Open sqlEditLink,Conn,3,3
	rdsEditLink("LinkClass") = Request.Form("LinkClass")
	rdsEditLink("Homepage") = Request.Form("Homepage")
	rdsEditLink("Url") = Request.Form("Url")
	rdsEditLink("Content") = Request.Form("Content")
	rdsEditLink("UpdateTime") = now()
	rdsEditLink.Update
	rdsEditLink.Close
	set rdsEditLink = nothing
response.redirect "link.asp"
end sub
'======================================
'dellink删除链接
'======================================
sub dellink
Dim sqlDelLink
if fla22=1 or Session("intUserLevel") > 2 then

sqlDelLink = "Delete from Dat_Link Where LinkKey = "& Request("Id")

Conn.Execute sqlDelLink
response.redirect "link.asp"
	else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
end sub
'======================================
'savegsjj修改公司简介
'======================================
sub savegsjj
	Dim rdsUpdateCompany
	Dim strFileName
	
	strFileName = Request.Form("FileName")
	if strFileName <> Request.Form("PhotoName") then
		Dim fso
		
		set fso = CreateObject("Scripti"&"ng.File"&"SystemO"&"bject")
		fso.DeleteFile Server.MapPath(strUploadNewsPhotoUrl & strFileName)
		set fso = nothing
	end if
	
	set rdsUpdateCompany = Server.CreateObject("ADODB.Recordset")
	rdsUpdateCompany.Open "Dat_Company",Conn,3,3
	
	rdsUpdateCompany("Company") = Request.Form("Company")
	rdsUpdateCompany("PhotoName") = Request.Form("PhotoName")
	rdsUpdateCompany("strFormat") = Request.Form("strFormat")
	rdsUpdateCompany("CreateTime") = now()
	rdsUpdateCompany.Update
	rdsUpdateCompany.Close
	set rdsUpdateCompany = nothing
response.redirect "gsjj.asp"
end sub
'======================================
'savelxwm修改联系方式
'======================================
sub savelxwm
	Dim rdsUpdateContact
	
	set rdsUpdateContact = Server.CreateObject("ADODB.Recordset")
	rdsUpdateContact.Open "Dat_Company",Conn,3,3
	
	rdsUpdateContact("CompanyName") = Request.Form("CompanyName")
	rdsUpdateContact("ContactMan") = Request.Form("ContactMan")
	rdsUpdateContact("Tel") = Request.Form("Tel")
	rdsUpdateContact("Fax") = Request.Form("Fax")
	rdsUpdateContact("Email")	= Request.Form("Email")
	rdsUpdateContact("QQ")	= Request.Form("QQ")
	rdsUpdateContact("MSN")	= Request.Form("MSN")
	rdsUpdateContact("Mobile")	= Request.Form("Mobile")
	rdsUpdateContact("Add") = Request.Form("Add")
	rdsUpdateContact("Postalcode") = Request.Form("Postalcode")
	rdsUpdateContact("Homepage") = Request.Form("Homepage")
	rdsUpdateContact("UpdateTime") = now()
	rdsUpdateContact.Update
	rdsUpdateContact.Close
	set rdsUpdateContact = nothing
response.redirect "lxwm.asp"
end sub
'==================================
'saveeditsysuser管理员权限设定
'==================================
sub saveeditsysuserqx
id=RtnReplaceInt(Request("Id"),0)
a=""
for i=0 to 27
b=request(i)
if b="" then b=0
a=a&","&b
next
a=right(replace(a," ",""),len(replace(a," ",""))-1)

set rs=server.createobject("adodb.recordset")
sql="select * from Sys_Account Where UserKey = "&id
rs.open sql,conn,1,3
rs("flag")=a
rs.update
rs.close
set rs=nothing
response.redirect "SysUser.asp"
end sub
'==================================
'locksysuser开启锁定管理员
'==================================
sub locksysuser
if Session("intUserLevel")<2 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
end if
lx=Request("lx")
	intLockUserID = Request("ID")
		sqlLockUser = "Update Sys_Account Set State ="&lx&" Where UserKey = "& intLockUserID
		Conn.Execute sqlLockUser
response.redirect "SysUser.asp"
end sub
'==================================
'saveeditsysuser编辑管理员
'==================================
sub saveeditsysuser
	Dim intEditUserID
	Dim rdsEditUser
	
	intEditUserID = Request("ID")
	strpass=Request.Form("Password")
	if Session("intUserLevel") > 2 then
			set rdsEditUser = Server.CreateObject("ADODB.Recordset")
			rdsEditUser.Open "Sys_Account Where UserKey = "& intEditUserID,Conn,3,3
			rdsEditUser("Account") = Request.Form("Account")
			if strpass<>"" then
			rdsEditUser("Password") = md5(strpass,16)
			end if
			rdsEditUser("UserLevel") = Request.Form("UserLevel")
			rdsEditUser.Update
			rdsEditUser.Close
			set rdsEditUser = nothing
response.redirect "SysUser.asp"
end if
end sub
'==================================
'delsysuser删除管理员
'==================================
sub delsysuser
	Dim intDelUserID
	Dim sqlDelUser
	
	intDelUserID = Request("ID")
	
	if Session("intUserLevel") > 2 then

sqlDelUser = "Delete from Sys_Account Where UserKey = "& intDelUserID

		Conn.Execute sqlDelUser
response.redirect "SysUser.asp"
	else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
	end if
end sub
'==================================
'delguoqi删除过期信息
'==================================
sub delguoqi
	Dim rsgq,sqlgq
if Session("intUserLevel") > 2 then

sqlgq="select InfoKey from [Dat_Information] where CInt(DateDiff('d',CreateTime,Now()))>CInt(InfoDate)"

	Set rsgq= Server.CreateObject("ADODB.Recordset")
	rsgq.open sqlgq,conn,1,3
	if not rsgq.eof then
	do while not rsgq.eof
	call Delinfogq(rsgq("InfoKey"))
	rsgq.MoveNext
	loop
	end if
	rsgq.close
	set rsgq=nothing

response.redirect "info.asp"
	else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：操作权限出错，您没有权限操作些功能！</li>"
Call Admin_ShowErr(ErrMsg)
	end if
end sub
'==================================
'saveaddad添加新广告
'==================================
sub saveaddad
Set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from [ad] where ADID='"&changechr(Request.Form("ADID"))&"'"
rs.Open sql,conn,1,3
If not rs.eof Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>错误：广告ID重复,请使用其他ID！</li>"
Call Admin_ShowErr(ErrMsg)
End iF
rs.AddNew 
rs("ADID")=changechr(Request.Form("ADID"))
rs("ADType")=TRIM(Request.Form("ADType"))
rs("ADSrc")=changechr(Request.Form("ADSrc"))
rs("ADHeight")=TRIM(Request.Form("ADHeight"))
rs("ADWidth")=TRIM(Request.Form("ADWidth"))
rs("ADLink")=changechr(Request.Form("ADLink"))
rs("ADAlt")=changechr(Request.Form("ADAlt"))
rs("ADStopViews")=TRIM(Request.Form("ADStopViews"))
rs("ADStopHits")=TRIM(Request.Form("ADStopHits"))
rs("ADStopDate")=TRIM(Request.Form("ADStopDate"))
rs("ADNote")=TRIM(Request.Form("ADNote"))
rs.Update
rs.Close

set rs=nothing
conn.Close
set conn=nothing
response.redirect "ad.asp"
end sub
'==================================
'saveeditad修改广告
'==================================
sub saveeditad
id=Request("id")

'打开/更新广告数据
Set rs = Server.CreateObject("ADODB.Recordset")
sql="select ADID,ADType,ADSrc,ADHeight,ADWidth,ADLink,ADAlt,ADStopViews,ADStopHits,ADStopDate,ADNote,ADViews,ADHits from [ad] where id=" & id
rs.Open sql,conn,1,3
	rs("ADID")=changechr(Request.Form("ADID"))
	rs("ADType")=changechr(Request.Form("ADType"))
	rs("ADSrc")=changechr(Request.Form("ADSrc"))
	rs("ADHeight")=TRIM(Request.Form("ADHeight"))
	rs("ADWidth")=TRIM(Request.Form("ADWidth"))
	rs("ADLink")=changechr(Request.Form("ADLink"))
	rs("ADAlt")=changechr(Request.Form("ADAlt"))
	rs("ADStopViews")=TRIM(Request.Form("ADStopViews"))
	rs("ADStopHits")=TRIM(Request.Form("ADStopHits"))
	rs("ADStopDate")=TRIM(Request.Form("ADStopDate"))
	rs("ADNote")=changechr(Request.Form("ADNote"))
	If Request.Form("ADRESET")="YES" Then
		rs("ADViews")=0
		rs("ADHits")=0
	End If
	rs.Update
rs.close
set rs=nothing
response.redirect "ad.asp"
end sub
'==================================
'delad删除广告
'==================================
sub delad
id = Request("id")

Set rs = Server.CreateObject("ADODB.Recordset")
sql="select * from [ad] where id=" & id
rs.Open sql,conn,1,3
rs.Delete 
set rs=nothing
conn.Close
set conn=nothing
Response.Redirect ("ad.asp")
end sub
'==================================
'jsad生成广告代码
'==================================
sub jsad
	Dim ADID,HostURL,ScrCode,JsCode
	Dim AD_Type,AD_Src,AD_Width,AD_Height,AD_Link,AD_Alt,AD_Views,ADViews,AD_Hits,ADHits,AD_Stop_Views,AD_Stop_Hits,AD_Stop_Date
		Response.Expires = 0

		ADID=Request.QueryString("ID")
		strmlad="ad/"
		HostURL=gqwebdir&strmlad

	Set rs=server.createobject("adodb.recordset")
		sql = "Select ADType,ADSrc,ADWidth,ADHeight,ADAlt,ADViews,ADHits,ADStopViews,ADStopHits,ADStopDate from [ad] where ADID='" & ADID & "'"
		rs.open sql,conn,1,3
	If Not (rs.bof or rs.eof) Then
		AD_Type=rs("ADType")
		AD_Src=rs("ADSrc")
		AD_Width=rs("ADWidth")
		AD_Height=rs("ADHeight")
		AD_Alt=rs("ADAlt")
		AD_Views=rs("ADViews")
		AD_ADHits=rs("ADHits")
		AD_Stop_Views=rs("ADStopViews")
		AD_Stop_Hits=rs("ADStopHits")
		AD_Stop_Date=rs("ADStopDate")
		rs("ADViews")= AD_Views + 1
		rs.Update
	Else
		response.write "document.write('<! -- 没有找到您要浏览的广告 -->');"
	End If
		rs.Close
	Set rs=nothing
		conn.Close
	Set conn=nothing

	If ( AD_Stop_Views <> 0 and AD_Views > AD_Stop_Views) Then AD_Type = 0
	If ( AD_Stop_Hits <> 0 and AD_Hits > AD_Stop_Hits) Then AD_Type = 0
	If ( NOW() > AD_Stop_Date) Then AD_Type = 0

	If InStr(1,AD_Src,".swf",1)>0 Then
		ScrCode="<EMBED src="""& AD_Src &""" quality=high WIDTH="""& AD_Width &""" HEIGHT="""& AD_Height &""" TYPE=""application/x-shockwave-flash"" PLUGINSPAGE=""http://www.macromedia.com/go/getflashplayer""></EMBED>"
	Else
		ScrCode="<a href="""& HostURL &"js/openad.asp?adid="& ADID &""" target=_blank><img src="""& AD_Src &""" border=0 width="""& AD_Width &""" height="""& AD_Height &""" alt="""& AD_Alt &""" align=top></a>"
	End If

	Select Case AD_Type
	Case 0
		JsCode= "document.write('<!-- 过期广告 ID"&ADID&" -->')"
	Case 1
		JsCode= "document.write('"& ScrCode &"');"
	Case 2
		JsCode= "ns4=(document.layers)?true:false;" & vbCrLf & _
				"ie4=(document.all)?true:false;" & vbCrLf & _
				"if(ns4){document.write('<layer id=DGbanner2 width="& AD_Width &" height="& AD_Height &" onmouseover=stopme(""DGbanner2"") onmouseout=movechip(""DGbanner2"")>"& ScrCode &"</layer>');}" & vbCrLf & _
				"else{document.write('<div id=DGbanner2 style=""position:absolute; width:"& AD_Width &"px; height:"& AD_Height &"px; z-index:9; filter: Alpha(Opacity=90)"" onmouseover=stopme(""DGbanner2"") onmouseout=movechip(""DGbanner2"")>"& ScrCode &"</div>');}" & vbCrLf & _
				"document.write('<script language=javascript src="& HostURL &"/images/ad_float_fullscreen.js></script>');"
	Case 3
		JsCode= "if (navigator.appName == 'Netscape')" & vbCrLf & _
				"{document.write('<layer id=DGbanner3 top=150 width="& AD_Width &" height="& AD_Height &">"& ScrCode &"</layer>');}" & vbCrLf & _
				"else{document.write('<div id=DGbanner3 style=""position: absolute;width:"& AD_Width &";top:150;visibility: visible;z-index: 1"">"& ScrCode &"</div>');}" & vbCrLf & _
				"document.write('<script language=javascript src="& HostURL &"/images/ad_float_upanddown.js></script>');"
	Case 4
		JsCode= "if (navigator.appName == 'Netscape')" & vbCrLf & _
				"{document.write('<layer id=DGbanner10 top=150 width="& AD_Width &" height="& AD_Height &">"& ScrCode &"</layer>');}" & vbCrLf & _
				"else{document.write('<div id=DGbanner10 style=""position: absolute;width:"& AD_Width &";top:150;visibility: visible;z-index: 1"">"& ScrCode &"</div>');}" & vbCrLf & _
				"document.write('<script language=javascript src="& HostURL &"/images/ad_float_upanddown_L.js></script>');"
	Case 5
		JsCode= "ns4=(document.layers)?true:false;" & vbCrLf & _
				"if(ns4){document.write('<layer id=DGbanner4Cont onLoad=""moveToAbsolute(layer1.pageX-160,layer1.pageY);clip.height="& AD_Height &";clip.width="& AD_Width &"; visibility=show;""><layer id=DGbanner4News position:absolute; top:0; left:0>"& ScrCode &"</layer></layer>');}" & vbCrLf & _
				"else{document.write('<div id=DGbanner4 style=""position:absolute;top:0; left:0;""><div id=DGbanner4Cont style=""position:absolute; width:"& AD_Width &"; height:"& AD_Height &";clip:rect(0,"& AD_Width &","& AD_Height &",0)""><div id=DGbanner4News style=""position:absolute;top:0; left:0; right:820"">"& ScrCode &"</div></div></div>');} " & vbCrLf & _
				"document.write('<script language=javascript src="& HostURL &"/images/ad_fullscreen.js></script>');"
	Case 6
		JsCode= "window.showModalDialog('"& AD_Src &"','','dialogWidth:"& AD_Width &"px;dialogHeight:"& AD_Height &"px;scroll:no;status:no;help:no');"
	Case 7
		JsCode= "document.write('<script language=javascript src="& HostURL &"/images/ad_dialog.js></script>'); " & vbCrLf & _
				"document.write('<div style=""position:absolute;left:300px;top:150px;width:"& AD_Width &"; height:"& AD_Height &";z-index:1;solid;filter:alpha(opacity=90)"" id=DGbanner5 onmousedown=""down1(this)"" onmousemove=""move()"" onmouseup=""down=false""><table cellpadding=0 border=0 cellspacing=1 width="& AD_Width &" height="& AD_Height &" bgcolor=#000000><tr><td height=18 bgcolor=#5A8ACE align=right style=""cursor:move;""><a href=# style=""font-size: 9pt; color: #eeeeee; text-decoration: none"" onClick=clase(""DGbanner5"") >关闭>>><img border=""0"" src="""&HostURL&"/images/close_o.gif""></a>&nbsp;</td></tr><tr><td bgcolor=f4f4f4 >&nbsp;"& AD_Src &"</td></tr></table></div>');"
	Case 8
		JsCode= "window.open('"& AD_Src &"','_blank');"
	Case 9
		JsCode= "window.open('"& AD_Src &"','DGBANNER7','width="& AD_Width &",height="& AD_Height &",scrollbars=1')"
	Case 10
		JsCode= "function closeAd(){" & vbCrLf & _
						"huashuolayer2.style.visibility='hidden';" & vbCrLf & _
						"huashuolayer3.style.visibility='hidden';}" & vbCrLf & _
						"function winload()" & vbCrLf & _
						"{" & vbCrLf & _
						"huashuolayer2.style.top=20;" & vbCrLf & _
						"huashuolayer2.style.left=5;" & vbCrLf & _
						"huashuolayer3.style.top=20;" & vbCrLf & _
						"huashuolayer3.style.right=5;" & vbCrLf & _
						"}" & vbCrLf & _
						"if(document.body.offsetWidth>800){" & vbCrLf & _
						"{" & vbCrLf & _
						"document.write('<div id=huashuolayer2 style=""position: absolute;visibility:visible;z-index:1""><table width=100  border=0 cellspacing=0 cellpadding=0><tr><td height=10 align=right bgcolor=666666><a href=javascript:closeAd()><img src=images/close.gif width=12 height=10 border=0></a></td></tr><tr><td>" & ScrCode & "</td></tr></table></div>'" & vbCrLf & _
						"+'<div id=huashuolayer3 style=""position: absolute;visibility:visible;z-index:1""><table width=100  border=0 cellspacing=0 cellpadding=0><tr><td height=10 align=right bgcolor=666666><a href=javascript:closeAd()><img src=images/close.gif width=12 height=10 border=0></a></td></tr><tr><td>" & ScrCode & "</td></tr></table></div>');" & vbCrLf & _
						"}" & vbCrLf & _
						"winload()" & vbCrLf & _
						"}"
	End Select

	If JsCode<>"" Then
	On Error Resume Next
		JsFileName = Server.MapPath("..\ad\JS\"&ADID&".js")
		JsCode = "<!--" & vbCrLf & JsCode & vbCrLf &"//-->"  
	set objStream = Server.CreateObject("Adodb." & "Str" & "eam")
	With objStream
		.Open
		.Type = 2
		.Charset = "GB2312"
		.WriteText JsCode
		.SaveToFile JsFileName, 2
		.Close
	End With
	Set objStream = Nothing

	If Err <> 0 Then
		Response.Write ("<script>alert(' 生成JS代码失败! \n\n "& Err.Description &"');history.back();</script>")
	Else
		Response.Write ("<script>alert(' 生成JS代码成功 !');history.back();</script>")
	End If
	Else
		Response.Write ("<script>alert(' 生成JS代码失败! \n\n 广告类型不正确!');history.back();</script>")
	End If
end sub
%>