<%
'/格式化时间/
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 = n &"-"& 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

'检查Email地址合法性
Function fyChkEmail(email)
		dim names, name, i, c
		fyChkEmail = true : names = Split(email, "@")
		if UBound(names) <> 1 then fyChkEmail = false : Exit Function
		for each name in names
			if Len(name) <= 0 then fyChkEmail = 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
		    	   fyChkEmail = false:Exit Function
		   	    end if
		    next
		    if Left(name, 1) = "." or Right(name, 1) = "." then
   		 	    fyChkEmail = false:Exit Function
	 	    end if
		next
		if InStr(names(1), ".") <= 0 then fyChkEmail = false:exit function
		i = Len(names(1)) - InStrRev(names(1), ".")
		if i <> 2 and i <> 3 then fyChkEmail = false : Exit function
		if InStr(email, "..") > 0 then fyChkEmail = false
End Function

'/在一个表中判断用户输入的一个字段的值是否已存在/
Function SearchFieldValue(vTableName,vFieldName,vFieldValue)
	dim strField,sqlField
	set strField = Server.CreateObject("ADODB.Recordset")
	sqlField = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	strField.Open sqlField,Conn
	if not strField.EOF then
		SearchFieldValue = True
	else
		SearchFieldValue = False
	end if
	strField.Close
	set strField = nothing
end Function
'信息类型函数 stype显示类型1为表单，其它显示文字链接 ，xxlx为类型参数
Function gqlx(stype,xxlx)
gqlx="出错啦！"
if stype=1 then
		gqlx="<option value=""1"""
		if xxlx="1" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"出售</option>"
		gqlx=gqlx&"<option value=""2"""
		if xxlx="2" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"求购</option>"
		gqlx=gqlx&"<option value=""3"""
		if xxlx="3" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"出租</option>"
		gqlx=gqlx&"<option value=""4"""
		if xxlx="4" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"求租</option>"
		gqlx=gqlx&"<option value=""5"""
		if xxlx="5" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"招聘</option>"
		gqlx=gqlx&"<option value=""6"""
		if xxlx="6" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"求职</option>"
		gqlx=gqlx&"<option value=""7"""
		if xxlx="7" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"置换</option>"
		gqlx=gqlx&"<option value=""8"""
		if xxlx="8" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"招生</option>"
		gqlx=gqlx&"<option value=""9"""
		if xxlx="9" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"二手</option>"
		gqlx=gqlx&"<option value=""10"""
		if xxlx="10" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"展会</option>"
		gqlx=gqlx&"<option value=""11"""
		if xxlx="11" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"讨论</option>"
		gqlx=gqlx&"<option value=""12"""
		if xxlx="12" then gqlx = gqlx&" selected"			
		gqlx = gqlx&">"
		gqlx = gqlx&"其它</option>"
else
strurl_list_lx=gqwebdir&"list.asp?lx="&xxlx
Select Case xxlx
		Case "1"
							gqlx = "<a href="&strurl_list_lx&"><font color=#009933><span style=""text-decoration: none"">[出售]</span></font></a>"
							Case "2"
								gqlx = "<a href="&strurl_list_lx&"><font color=#ff0000><span style=""text-decoration: none"">[求购]</span></font></a>"	
							Case "3"
								gqlx = "<a href="&strurl_list_lx&"><font color=#FF00FF><span style=""text-decoration: none"">[出租]</span></font></a>"
							Case "4"
								gqlx = "<a href="&strurl_list_lx&"><font color=#008080><span style=""text-decoration: none"">[求租]</span></font></a>"
							Case "5"
								gqlx = "<a href="&strurl_list_lx&"><font color=#0000FF><span style=""text-decoration: none"">[招聘]</span></font></a>"
							Case "6"
								gqlx = "<a href="&strurl_list_lx&"><font color=#9900FF><span style=""text-decoration: none"">[求职]</span></font></a>"
							Case "7"
								gqlx = "<a href="&strurl_list_lx&"><font color=#CC6600><span style=""text-decoration: none"">[置换]</span></font></a>"
							Case "8"
								gqlx = "<a href="&strurl_list_lx&"><font color=#000000><span style=""text-decoration: none"">[招生]</span></font></a>"
								
								
							Case "9"
								gqlx = "<a href="&strurl_list_lx&"><font color=#ff0000><span style=""text-decoration: none"">[二手]</span></font></a>"	
							Case "10"
								gqlx = "<a href="&strurl_list_lx&"><font color=#FF00FF><span style=""text-decoration: none"">[展会]</span></font></a>"
							Case "11"
								gqlx = "<a href="&strurl_list_lx&"><font color=#008080><span style=""text-decoration: none"">[讨论]</span></font></a>"
							Case "12"
								gqlx = "<a href="&strurl_list_lx&"><font color=#CC6600><span style=""text-decoration: none"">[其它]</span></font></a>"
		End Select
end if
Response.Write gqlx
end Function
'/字符过滤/
function changechr(str) 
    changechr=replace(replace(replace(replace(str,"<","&lt;"),">","&gt;"),chr(13),"")," "," ") 
   changechr=replace(replace(replace(replace(changechr,"'",""),"&nbsp;",CHR(32)),"insert",""),"set","") 
    changechr=replace(replace(replace(replace(changechr,"select",""),"update",""),"delete%20from",""),chr(34),"&quot;") 
end function

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

'/判断会员是否超时/
Function IsTimeOutuser(vMember,vPassWord)
	Dim rdsMember1
	Dim sqlMember1
	
	set rdsMember1 = Server.CreateObject("ADODB.Recordset")
	sqlMember1 = "Select * From Dat_Member Where Member = '"& vMember &"' And PassWord = '"& vPassWord &"'"
	rdsMember1.Open sqlMember1,Conn
	
	If Not rdsMember1.EOF Then
		IsTimeOutuser = False
	Else
		IsTimeOutuser = True
	End if
	
	rdsMember1.Close
	set rdsMember1 = nothing
End Function
'/判断管理员是否超时/
Function IsTimeOutadmin(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
		IsTimeOutadmin = False
	Else
		IsTimeOutadmin = True
	End if
	rdsUser.Close
	set rdsUser = nothing
End Function

'/获得会员的编号/
Function getMemberKey(Member)
	Dim rdsMember
	Dim sqlMember
	
	set rdsMember = Server.CreateObject("ADODB.Recordset")
	sqlMember = "Select * From Dat_Member Where Member = '"& Member &"'"
	rdsMember.Open sqlMember,Conn,1,1
	if not rdsMember.EOF then
		getMemberKey = rdsMember("MemberKey")
	else
		getMemberKey = 0
	end if
	rdsMember.Close
	set rdsMember = nothing
End Function
sub checkgquqx()
bbaction=changechr(request("bbaction"))
if IsTimeOutadmin(Session("strAccount"),Session("strPassWord")) then
if bbaction<>"nocheck" then
if IsTimeOutuser(Session("boobuser"),Session("boobpass")) then
	Response.write "<font color=red>您未登录，不能使用上传功能。</font>"
	Response.end
end if
Select case upload18
  	Case 1'普通会员
if IsTimeOutuser(Session("boobuser"),Session("boobpass")) then
	Response.write "<font color=red>您未登录，不能使用上传功能。</font>"
Response.end
end if
 	Case 2'高级会员
if IsTimeOutuser(Session("boobuser"),Session("boobpass")) then
Response.write "<font color=red>您未登录，不能使用上传功能。</font>"
Response.end
else
if Session("gqjb")=0 then
Response.write "<font color=red>上传功能仅对高级会员开放,<a target=_blank href="&gqwebdir&"sjgj.asp><font color=#FF0000>立即申请高级会员</font></a>。</font>"
Response.end
end if
if Session("gqjb")=-1 then
Response.write "<font color=red>上传功能仅对高级会员开放,<font color=#FF0000>您申请高级会员还未通过</font>。</font>"
Response.end
end if
end if
End Select
end if
end if
end sub
Sub OutMsg(strMsg,strUrl)
		response.write "<script language=""javascript"">alert('"&strMsg&"');location.href='"&strUrl&"';</script>"
		response.end
	End Sub
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 leftt(str,n)
If len(str)<=n/2 Then
LeftT=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
t=l
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
If t>n Then exit for
TStr=TStr&(mid(str,i,1))
next
If t>n Then
LeftT = TStr+".."
Else
LeftT = TStr
End If
End If
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 HTMLEncode(fString)
	fString = Replace(fString, CHR(32) & CHR(32) & CHR(32) & CHR(32), "&nbsp;&nbsp;&nbsp;&nbsp;")
	fString = replace(fString, ">", "&gt;")
	fString = replace(fString, "<", "&lt;")

	HTMLEncode = fString
end function
function GetIp()
	'如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法
	getclientip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	If getclientip = "" Then
		'如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法
		getclientip = Request.ServerVariables("REMOTE_ADDR")
	end if
	GetIp = getclientip
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 ChkIsOuteradd()
		Dim server_v1,server_v2
		ChkIsOuteradd=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 ChkIsOuteradd=False 
End Function
' 根路径转为带域名全路径格式
	Function fyRootPath2DomainPath(url)
		Dim sHost, sPort
		sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
		sPort = Request.ServerVariables("SERVER_PORT")
		If sPort <> "80" Then sHost = sHost & ":" & sPort
		RootPath2DomainPath = sHost & url
	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
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
'/清除html/
function clearHTMLCode(Code)
Dim objRegExp
set objRegExp = new RegExp
objRegExp.IgnoreCase = True
objRegExp.Global=True 
objRegExp.Pattern="<[^<>]+>" 
If objRegExp.test(Code) Then
Code = objRegExp.Replace(Code,"")
End If
set objRegExp = nothing
Code = Replace(Code, "&nbsp;", "")
clearHTMLCode= Code
end function 
'/出错提示函数/
Sub ShowMessage()
	if strMsgTitle = "" then strMsgTitle = "异常出错"
	if strMsg = "" then strMsg = "未知错误"
%>
  <br>
  <table border="0" width="70%" cellspacing="0" cellpadding="0" align="center">
	<tr>
	  <td width="100%" bgcolor="#3986CE">
		<table border="0" width="100%" cellspacing="1">
		  <tr>
		    <td width="100%" align="center" bgcolor="#3986CE" height="30"><% = strMsgTitle%></td>
		  </tr>
		  <tr>
		    <td width="100%" align="center" height="68" bgcolor="#FFFFFF" style="line-height:200%"><% = strMsg%></td>
		  </tr>
          <tr>
            <td width="100%" align="center" height="25" class="banma2"><input onclick="parent.location.href='Javascript:history.back()'" type="button" value="返 回" class="face" name="button1"></td>
          </tr>
        </table>
      </td>
    </tr>
  </table>
  <br>
<%End Sub
sub fy_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
'=================================================
'fy_DelFilesbb(strFiles)
'strdir           ----(要删除的文件)
'删除指定文件
'=================================================
Sub fy_DelFilesbb(strFiles)
		if strFiles="" then Exit Sub
		dim fso,arrFiles,i
		On Error Resume Next
		Err=0
		Set fso = CreateObject("Scripti"&"ng.File"&"SystemO"&"bject")
			if fso.FileExists(server.MapPath(strFiles)) then
				fso.DeleteFile(server.MapPath(strFiles))
			end if
		Set fso = Nothing
		Err=0
End Sub
%>