<%
Function ShowHyzk(Num)   '婚姻状况
  Dim hyzk
  Select Case Num
    Case 1:
	  hyzk="未婚"
    Case 2:
	  hyzk="在婚"
	Case 3:
	  hyzk="离婚"
	Case 4:
	  hyzk="丧偶"
	Case 5:
	  hyzk="周末夫妻"
	Case 6:
	  hyzk="丁客家族"  
	Case 7:
	  hyzk="单身主义"   	
  End Select
  ShowHyzk=hyzk            
End Function

Function ShowSx(Num)   '生肖
  Dim sx
  Select Case Num
    Case 1:
	  sx="鼠"
    Case 2:
	  sx="牛"
	Case 3:
	  sx="虎"
	Case 4:
	  sx="兔"
	Case 5:
	  sx="龙"
	Case 6:
	  sx="蛇"  
	Case 7:
	  sx="马"  
	Case 8:
	  sx="羊"
	Case 9:
	  sx="猴"  
	Case 10:
	  sx="鸡" 
	Case 11:
	  sx="狗"            	
	Case 12:
	  sx="猪"  
  End Select
  ShowSx=sx            
End Function

Function ShowXl(Num)  '学历
  Dim xl
  Select Case Num
    Case 1:
	  xl="高中"
    Case 2:
	  xl="大专"
	Case 3:
	  xl="本科"
	Case 4:
	  xl="硕士"
	Case 5:
	  xl="博士"
	Case 6:
	  xl="博士后"  	
	Case 0:
	  xl=""	
  End Select
  ShowXl=xl           
End Function

Function ShowMz(Num)  '民族
  Dim mz
  Select Case Num
    Case 1:
	  mz="汉族"
	Case 2:
	  mz="朝鲜族"
	Case 3:
	  mz="蒙古族"    
	Case 4:
	  mz="回族"
	Case 5:
	  mz="满族"
	Case 6:
	  mz="维吾尔族"
	Case 7:
	  mz="壮族"    
	Case 8:
	  mz="彝族"  
	Case 9:
	  mz="苗族"  
	Case 10:
	  mz="藏族"      
	Case 11:
	  mz="其它民族"
  End Select
  ShowMz=mz           
End Function  

Function ShowDw(Num)   '单位性质
  Dim dw
  Select Case Num
    Case 1:
	  dw="国有"
    Case 2:
	  dw="民营"
	Case 3:
	  dw="合资"
	Case 4:
	  dw="独资"
	Case 5:
	  dw="个体"	  	
  End Select
  ShowDw=dw           
End Function

Function ShowYx(Num)   '月收入
  Dim yx
  Select Case Num
    Case 1:
	  yx="1500元以下"
    Case 2:
	  yx="1500-3000元"
	Case 3:
	  yx="3000-5000元"
	Case 4:
	  yx="5000-7000元"
	Case 5:
	  yx="7000-9000元"	 
	Case 6:
	  yx="9000-12000元"
    Case 7:
	  yx="12000-15000元"
	Case 8:
	  yx="15000－20000元"
	Case 9:
	  yx="20000元以上"		
  End Select
  ShowYx=yx          
End Function

Function checkStr(Chkstr)
	dim Str:Str=Chkstr
	if isnull(Str) then
		checkStr = ""
		exit Function
	else
		Str=replace(Str,"'","")
		Str=replace(Str,";","")
		Str=replace(Str,"--","")
		checkStr=Str
	end if
End Function

Function ChkPost()   '不允许外部提交
    dim HTTP_REFERER,SERVER_NAME
	dim server_v1,server_v2
	chkpost=false
    SERVER_NAME=CheckStr(Request.ServerVariables("SERVER_NAME"))
	HTTP_REFERER=CheckStr(Request.ServerVariables("HTTP_REFERER"))
	server_v1=Cstr(HTTP_REFERER)
	server_v2=Cstr(SERVER_NAME)	
	if mid(server_v1,8,len(server_v2))<>server_v2 then
		chkpost=false
	else
		chkpost=true
	end if
End Function

Function SendJmail(Email,Topic,MailBody)  '发送邮件

	Dim JMail
	'on error resume next
	Set Jmail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
    Jmail.silent = true '屏蔽例外错误，返回FALSE跟TRUE两值j
    Jmail.logging = true '启用邮件日志
    Jmail.Charset = "GB2312" '邮件的文字编码为国标
    Jmail.ContentType = "text/html" '邮件的格式为HTML格式
    Jmail.AddRecipient Email '邮件收件人的地址
	Jmail.From = AllMail '发件人的E-MAIL地址
	'Jmail.priority=1
    Jmail.MailServerUserName = Mailuser '登录邮件服务器所需的用户名
    Jmail.MailServerPassword = Mailpass '登录邮件服务器所需的密码
    Jmail.Subject = Topic '邮件的标题 
    Jmail.Body = MailBody '邮件的内容	
	
	JMail.Send(Mailsmtp)	
    Jmail.Close() '关闭对象	
    Set JMail = Nothing
	
'if err.number<>0 then
' response.write "发送发送失败！"
'else
' response.write "邮件发送成功！"
'end if
End Function


function trpass(preString)  '单向加密
  Dim texts
  Dim seed
  Dim i,length
  prestring = trim(preString)
  length = len(preString)
  seed = length
  Randomize(length)
  texts = ""
  for i = 1 to length
    seed = int(94*rnd(-asc(mid(preString,i,1))-seed*asc(right(prestring,1)))+32)
    texts = texts & chr(seed) & chr(int(94*rnd(-seed)+32))
  next
  texts=replace(texts,"'","")
  trpass=replace(texts,chr(34),"")
end function

' 检查是否含脏字
function checkshit(mess)'过滤
  dim i
  for i=0 to UBound(filarray)
    if instr(mess,filarray(i))>0 then checkshit=true:exit for
  next
end function

' 检查是否含禁止使用呢称
function checkforbidword(mess)'过滤
  dim i
  for i=0 to UBound(forbidword)
    if instr(mess,forbidword(i))>0 then checkforbidword=true:exit for
  next
end function

'检查是否含非法字符( or Instr(str,"")>0被去掉了
function invalidch(str)
	if Instr(str,"=")>0  or Instr(str,"|")>0  or Instr(str,"%")>0 or Instr(str,chr(32))>0 or Instr(str,"?")>0 or Instr(str,"&")>0 or Instr(str,";")>0 or Instr(str,"'")>0 or Instr(str,chr(34))>0 or Instr(str,chr(9))>0 or Instr(str,"$")>0 or Instr(str,"#")>0 then invalidch=true
end function

Function chkonline(Uid)  '是否在线
  dim Chkit,res,rsql
  Chkit=false
  set res=server.CreateObject("adodb.recordset")
  rsql="select * from sd_online where userid="& Uid
  res.open rsql,conn,1
  if not(res.bof or res.eof) then
   Chkit=true
  end if
  res.close
  set res=nothing
  chkonline=Chkit
End Function

Function GetIp()
  dim theip
  theip = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
  If theip = "" Then theip = Request.ServerVariables("REMOTE_ADDR")  
  GetIp=theip
End Function

Sub Particle(Newsid)
  dim res,rsql,ai,title,pid,isfind
  isfind=false
  for ai=newsid-1 to newsid-50 step -1
   set res=server.CreateObject("adodb.recordset")
   rsql="select id,title from article where id="& ai
   res.open rsql,conn,1
   if not(res.bof or res.eof) then
     title=res("title")
	 pid=res("id")
	 isfind=true
	 exit for
   end if
   res.close
  set res=nothing
  next  
  if isfind=true then
    response.Write "<a href='showdiary.asp?id="& pid &"' class='a1'>"& title &"</a>"
  else
    response.Write "没有了"
  end if
End Sub

Sub Narticle(Newsid)
  dim res,rsql,ai,title,pid,isfind
  isfind=false
  for ai=newsid+1 to newsid+50
   set res=server.CreateObject("adodb.recordset")
   rsql="select id,title from article where id="& ai
   res.open rsql,conn,1
   if not(res.bof or res.eof) then
     title=res("title")
	 pid=res("id")
	 isfind=true
	 exit for
   end if
   res.close
  set res=nothing
  next  
  if isfind=true then
    response.Write "<a href='showdiary.asp?id="& pid &"' class='a1'>"& title &"</a>"
  else
    response.Write "没有了"
  end if
End Sub

Sub ChkNumber(Sid)  
  if not isnumeric(Sid) or Sid="" then
    response.Write "错误的操作,id须为数字。"
    response.end
  end if
End Sub

Function GetPhotoNum(Uid)
  dim res,rsql,pnum
  pnum=0
  set res=server.CreateObject("adodb.recordset")
  rsql="select count(*) from photo_info where userid="& Uid &""
  res.open rsql,conn,1
  if not(res.eof or res.bof) then
    pnum=res(0)
  end if
  res.close
  set res=nothing
  GetPhotoNum=pnum
End Function

Sub ShowUserPhoto()
 dim imgphoto
response.Write  "<table width=""131"" height=""165"" border=""0"" cellpadding=""0"" cellspacing=""0"" bgcolor=""#FFFFFF""><tr>"
response.Write "<td width=""125"" height=""110"" align=""center""><a href=""userinfo.asp?user_id="& rs("userid") &""" target=""_blank"">"
if rs("photo")="" or isnull(rs("photo")) then
 select case rs("sex")
   case "男"
     imgphoto="default-1.gif"
   case "女"
       imgphoto="default-0.gif"
 end select
 response.Write "<img src=""ima/"& imgphoto &""" width=""105"" height=""90"" border=""0"">"
else
 response.Write "<img src=""Uppic/photo/"& rs("photo") &""" border=""0"" onload=""javascript:if(this.width>this.height){this.width=105}else{this.height=90}"">"
end if
response.Write "</a></td>"
response.Write "<td width=""6"" rowspan=""3"" align=""center"" valign=""top""><img src=""ima/ce.jpg"" width=""6"" height=""165""></td></tr>"
response.Write "<tr align=""center""><td height=""25"" class=""STYLE8"">"& rs("username") &"</td></tr>"
response.Write "<tr align=""center""><td height=""30"" class=""STYLE4"">"&rs("sex")&" ,"& GetProv(rs("prov")) &"<br>"& ShowXl(rs("school")) &" ,"& datediff("yyyy",rs("birthday"),now()) &"岁</td></tr>"
response.Write "</table>"
End Sub

Function GetProv(ProvId)
  dim res,sql1,Sprov
  set res=server.CreateObject("adodb.recordset")
  sql1="select sheng from sheng where id="& ProvId &""
  res.open sql1,conn,1
  if not(res.eof or res.bof) then
    Sprov=res("sheng")
  end if
  res.close
  set res=nothing
  GetProv=Sprov
End Function

Function GetCity(CityId)
  dim res,sql1,Scity
  set res=server.CreateObject("adodb.recordset")
  sql1="select shi from shi where id="& CityId &""
  res.open sql1,conn,1
  if not(res.eof or res.bof) then
    Scity=res("shi")
  end if
  res.close
  set res=nothing
  GetCity=Scity
End Function

Sub ShowHonor(Uid)  '显示上传证件状态
dim hnum,arrayhonor,strhonor
hnum=0
strhonor="已经上传了"
set res1=server.CreateObject("adodb.recordset")
sql1="select honorold from user_info where userid="& Uid &""
res1.open sql1,conn,1
if not res1.eof then

arrayhonor=split(res1("honorold"),",")	
if arrayhonor(0)=1 then strhonor=strhonor+"身份证,"
if arrayhonor(1)=1 then strhonor=strhonor+"学历证件,"
if arrayhonor(2)=1 then strhonor=strhonor+"行车证,"
if arrayhonor(3)=1 then strhonor=strhonor+"房产证,"
if arrayhonor(4)=1 then strhonor=strhonor+"大头贴,"

for i=0 to ubound(arrayhonor)
  if arrayhonor(i)=1 then
    hnum=hnum+1
  end if
  if hnum>4 then
  hnum=4
  end if
  
next
if hnum=0 then
  strhonor="尚未上传任何证件。"
else
  strhonor=left(strhonor,len(strhonor)-1)+"。"
end if
response.Write "<img src=""/ima/star_"& hnum &".gif"" title="""& strhonor &""" style=""cursor:hand"" border=0>"
end if
res1.close
set res1=nothing
End Sub

function getfilename(d)
dim datetime
datetime=cstr(d)
dim date1,time1
date1=split(d," ")(0)
time1=split(d," ")(1)
Randomize
getfilename=year(date1)&month(date1)&day(date1)&hour(time1)&minute(time1)&second(time1)&(int(rnd*1000)+1)
end function

Function listPages(LinkFile) 
 dim pagestart,dn,spage
 dn=page
 spage=intpagecount
 pagestart=clng(dn)-5
 if pagestart <=1 then pagestart=1 
 
 If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
    strTemp = "http://" 
 Else 
    strTemp = "https://" 
 End If 
 strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME")) 
 If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT")) 
 strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
 lenstrTemp=len(strTemp)+1	
 response.write "<DIV class=pgd id=hb align=right>"
 if instr(left(linkfile,lenstrTemp),"?")>0 then 	
   if clng(dn)>1 then
     Response.Write("<a href=" & LinkFile & "&page="&dn-1&" class=st1><<上一页</a>&nbsp;")
   end if
   for i=pagestart to pagestart+9
     if i>spage then exit for
     if clng(i)=clng(dn) then
        Response.Write("<span class=page_on>"&dn&"</span>")
     else
        Response.Write(" <a href=" & LinkFile & "&page="&i&" class=page_off>"&i&"</a> ")  
     end if 
   next
   if dn < spage then
      Response.Write("<a href=" & LinkFile & "&page="&dn+1&" class=st1>下一页>></a>&nbsp;")
   end if
 else
   if clng(dn)>1 then
     Response.Write("<a href=" & LinkFile & "?page="&dn-1&" class=st1><<上一页</a>&nbsp;")
   end if
   for i=pagestart to pagestart+9
     if i>spage then exit for
     if clng(i)=clng(dn) then
        Response.Write("<span class=page_on>"&dn&"</span>")
     else
        Response.Write(" <a href=" & LinkFile & "?page="&i&" class=page_off>"&i&"</a> ")  
     end if 
   next
   if dn < spage then
      Response.Write("<a href=" & LinkFile & "?page="&dn+1&" class=st1>下一页>></a>&nbsp;")
   end if
 end if  
 response.write "</div>"
End Function

'删除2天前文件（为清除无效视频文件）
Function bianli(path)
set fso=Server.CreateObject("Scripting.FileSystemObject")

''on error resume next
set objFolder=fso.GetFolder(path)
set objFiles=objFolder.Files

for each objFile in objFiles
  a=path&"\"&objfile.name
  dim f
  Set f = fso.GetFile(a)
  if datediff("d",f.Datecreated,now())>2 then
    Fso.DeleteFile(a)
  end if
next

set objFolder=nothing
set fso=nothing
End Function

Function GetOnlineMember()
  dim tnum
  set r1=server.CreateObject("adodb.recordset")
  s1="select count(userid) from sd_online"
  r1.open s1,conn,1
  tnum=r1(0)
  r1.close
  set r1=nothing
  GetOnlineMember=tnum
End Function

Function GetTotalMember()
  dim tnum
  set r1=server.CreateObject("adodb.recordset")
  s1="select count(userid) from user_info"
  r1.open s1,conn,1
  tnum=r1(0)
  r1.close
  set r1=nothing
  GetTotalMember=tnum
End Function

Function GetCityNum(Cid)
  dim tnum
  set r1=server.CreateObject("adodb.recordset")
  s1="select count(userid) from user_info where city="&Cid&""
  r1.open s1,conn,1
  tnum=r1(0)
  r1.close
  set r1=nothing
  GetCityNum=tnum  
End Function

Function GetOlCityNum(Cid)
  dim tnum
  set r1=server.CreateObject("adodb.recordset")
  s1="select count(a.userid) from sd_online as a inner join user_info as b on a.userid=b.userid where b.city="&Cid&""
  r1.open s1,conn,1
  tnum=r1(0)
  r1.close
  set r1=nothing
  GetOlCityNum=tnum  
End Function

Public Function iHTMLEncode(fString)
		If Not IsNull(fString) Then
			fString = replace(fString, ">", "&gt;")
			fString = replace(fString, "<", "&lt;")
			fString = Replace(fString, CHR(32), " ")
			fString = Replace(fString, CHR(9), " ")
			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> ")
			iHTMLEncode = fString
		End If
End Function

Function chkhz(club,user)
  dim ishz:ishz=false
  set rr=server.CreateObject("adodb.recordset")
  rsql="select * from julebu where bigid="& club &" and hzid="& user &""
  rr.open rsql,conn,1
  if not rr.eof then
    ishz=true  
  end if
  rr.close
  set rr=nothing
  chkhz=ishz
End Function
%>