<%
'=======================================================
' 欢迎使用《阿赛大型门户网站系统V3.0》，简称“AsaiMHV3”
' 技术支持、商业版咨询、官方唯一指定联系QQ“4941172”
' 官方网站：http://77ya.com      程序负责人：阿赛
'=======================================================

'//* 格式化SELECT *//
'--* sName：	Select Name
'--* sView：	显示项目
'--* sValue：	项目值
'--* iValue：	默认选定项目值
Private Function SelectInit(ByVal sName,ByVal sView,ByVal sValue,ByVal iValue)
	Dim Nii
	SelectInit = "<select name="""&sName&""" size=1>"
	For Nii = 0 To Ubound(sView)
		SelectInit = SelectInit & "<option value='"&sValue(Nii)&"'"
		If Cstr(sValue(Nii)) = Cstr(iValue) Then SelectInit = SelectInit & " selected"
		SelectInit = SelectInit & ">"&sView(Nii)&"</option>"
	Next
	SelectInit = SelectInit & "</select>"
End Function

'//* 格式化Input(radio部分) *//
'--* sName：	Select Name
'--* sView：	显示项目
'--* sValue：	项目值
'--* iValue：	默认选定项目值
Private Function InputInit(ByVal sName,ByVal sView,ByVal sValue,ByVal iValue)
	Dim Nii
	For Nii = 0 To Ubound(sView)
		InputInit = InputInit & "<input Type=radio name="""&sName&""" value='"&sValue(Nii)&"'"
		If sValue(Nii) = iValue Then InputInit = InputInit & " checked"
		InputInit = InputInit & ">&nbsp;"&sView(Nii)&"&nbsp;"
	Next
	InputInit = InputInit & "&nbsp;&nbsp;&nbsp;"
End Function

'================================================
'作  用：查看用户信息
'参  数：
'	uuser : 用户名称
'	ut    : 是否弹出窗口显示
'	un    : 是否对用户名称进行截取
'================================================
Public Function Format_User_View(ByVal uuser,ByVal ut,ByVal un)
	If Cls.Is_Null(uuser)="" Then
		Format_User_View="<font class=Gys>-----</font>"
		Exit Function
	End If
	Dim uname
	uname=uuser
	If un=1 Then uname=Cls.Cuted(uuser,10)
	Format_User_View="<a href='"&Cls.Web_Dir&"User/View.asp?username="&Server.UrlEncode(uuser)&"' class=blue title='查看 "&uuser&" 的详细资料'"
	If ut=1 Then Format_User_View=Format_User_View&" target=_blank"
	Format_User_View=Format_User_View&">"&uname&"</a>"
End Function

'================================================
'作  用：查看用户信息
'参  数：
'	varss : 用户名称
'	ctt   : 是否对用户名称进行截取
'	ct    : 名称显示颜色标记
'================================================
Public Function Format_User_Name(ByVal varss,ByVal ctt,ByVal ct)
	Dim cnum,vars,classt
	cnum=5
	If Int(ctt)=0 Then cnum=0
	vars=varss
	If Cls.Is_Null(vars)="" Then
		Format_User_Name="<font class=Gys>-----</font>"
		Exit Function
	End If
	If Cls.Is_Null(ct)<>"" And ct<>"" Then classt=" class="&ct
	Format_User_Name="<a href='"&Cls.Web_Dir&"User/View.asp?username="&Server.UrlEncode(vars)&"' class=blue title='查看 "&vars&" 的详细资料' target=_blank"&classt&">"&Cls.Code_Html(vars,1,cnum)&"</a>"
End Function

'================================================
'作  用：查看用户信息
'参  数：
'	uid   : 用户ID
'	ut    : 是否弹出窗口显示
'	un    : 是否对用户名称进行截取
'================================================
Public Function Format_User_ID(ByVal uid,ByVal ut,ByVal un)
	If Cls.Is_Null(uid)="" Then
		Format_User_ID="<font class=Gys>-----</font>"
		Exit Function
	End If
	If un=1 Then uid=Cls.Cuted(uid,10)
	Format_User_ID="<a href='"&Cls.Web_Dir&"User/View.asp?userid="&Server.UrlEncode(uid)&"' title='查看 "&uid&" 的详细资料'"
	If ut=1 Then Format_User_ID=Format_User_ID&" target=_blank"
	Format_User_ID=Format_User_ID&">"&uid&"</a>"
End Function

'================================================
'作  用：定义用户图像
'参  数：
'	f_vars: 图像地址
'	f_w   : 图像宽度
'	f_h   : 图像高度
'================================================
Public Function Format_User_Face(ByVal f_vars,ByVal f_w,ByVal f_h)
	If Cls.Is_Null(f_vars)="" Then
		Format_User_Face=Cls.Web_Dir&"Images/Face/0.gIf"
		Exit Function
	End If
	Format_User_Face="<img src='"&f_vars&"' border=0 width="&f_w&" height="&f_h&">"
End Function

'================================================
'作  用：推荐信息给好友
'参  数：
'	t1: 信息分类
'	t2: 信息主题
'   t3: 信息链接地址
'================================================
Public Function Format_Commend(ByVal t1,ByVal t2,ByVal t3)
	Format_Commend="【<a href='javascript:;' onclick=""javascript:open_win('"&Cls.Web_Dir&"Common/Commend.asp?ntit="&Server.UrlEncode(t1)&"&topic="&Server.UrlEncode(t2)&"&url="&Server.UrlEncode(t3)&"','Commend',520,450,'no');"">告诉好友</a>】"
End Function

'================================================
'作  用：举报错误信息与链接
'参  数：
'	t1: 信息分类
'	t2: 信息主题
'   t3: 报错信息编号
'	t4: 报错信息分类
'   t5: 信息链接地址
'================================================
Public Function Commend_Error(ByVal t1,ByVal t2,ByVal t3,ByVal t4)
	Commend_Error="【<a href='javascript:;' onclick=""javascript:open_win('"&Cls.Web_Dir&"Common/Err.asp?ChannelIDs="&t1&"&topic="&Server.UrlEncode(t2)&"&eid="&t3&"&ntit="&Server.UrlEncode(t4)&"','Commend',520,400,'no');"">错误报告</a>】"
End Function

'================================================
'作  用：定义网站图片
'参  数：
'	snum: 图片名称前缀
'================================================
Public Function Img_Small(ByVal sNum)
	Img_Small="<img border=0 src='"&Cls.Web_Dir&"Images/Small/"&sNum&".gIf' align=absmiddle>&nbsp;"
End Function
Public Function Img_Skin(ByVal sNum)
	Img_Skin="<img border=0 src='"&Cls.web_skindir&"sys/"&sNum&".gIf' align=absmiddle>&nbsp;"
End Function
Public Function Img_Alt(ByVal sNum,ByVal sAlt)
	Img_Alt="<img border=0 src='"&Cls.web_skindir&"sys/"&sNum&".gIf' title='"&sAlt&"' align=absmiddle>"
End Function

'//* 网站用户图例 *//
Public Function Img_User()
	Dim a,udim,ui
	'a="用户图例："
	udim=Cls.Cache_Get("user_group")
	For ui=0 To Ubound(udim,2)
		a=a&VbCrlf&"<img border=0 src='"&Cls.web_skindir&"sys/icon_"&udim(0,ui)&".gIf' align=absmiddle>&nbsp;"&udim(1,ui)
	Next
	a=a&VbCrlf&"<img border=0 src='"&Cls.web_skindir&"sys/icon_other.gIf' align=absmiddle>&nbsp;游客"
	If IsArray(udim) Then Erase udim
	Img_User=a
End Function

Function get_abc(var_s)
	'65-90 A-Z
	'97-122 a-z
	'48-58 0-9
	'45 -
	dim tmp,vars:vars=trim(var_s)
	If vars="" or isnull(vars) Then get_abc="-":exit Function
	vars=left(vars,1)
	tmp=int(asc(vars))
	If tmp>=48 and tmp<=57 Then get_abc=vars:exit Function
	If (tmp>=65 and tmp<=90) or (tmp>=97 and tmp<=122) Then get_abc=ucase(vars):exit Function
	tmp=tmp+65536
	If(tmp>=45217 and tmp<=45252) Then get_abc="A":exit Function
	If(tmp>=45253 and tmp<=45760) Then get_abc="B":exit Function
	If(tmp>=45761 and tmp<=46317) Then get_abc="C":exit Function
	If(tmp>=46318 and tmp<=46825) Then get_abc="D":exit Function
	If(tmp>=46826 and tmp<=47009) Then get_abc="E":exit Function
	If(tmp>=47010 and tmp<=47296) Then get_abc="F":exit Function
	If(tmp>=47297 and tmp<=47613) Then get_abc="G":exit Function
	If(tmp>=47614 and tmp<=48118) Then get_abc="H":exit Function
	If(tmp>=48119 and tmp<=49061) Then get_abc="J":exit Function
	If(tmp>=49062 and tmp<=49323) Then get_abc="K":exit Function
	If(tmp>=49324 and tmp<=49895) Then get_abc="L":exit Function
	If(tmp>=49896 and tmp<=50370) Then get_abc="M":exit Function
	If(tmp>=50371 and tmp<=50613) Then get_abc="N":exit Function
	If(tmp>=50614 and tmp<=50621) Then get_abc="O":exit Function
	If(tmp>=50622 and tmp<=50905) Then get_abc="P":exit Function
	If(tmp>=50906 and tmp<=51386) Then get_abc="Q":exit Function
	If(tmp>=51387 and tmp<=51445) Then get_abc="R":exit Function
	If(tmp>=51446 and tmp<=52217) Then get_abc="S":exit Function
	If(tmp>=52218 and tmp<=52697) Then get_abc="T":exit Function
	If(tmp>=52698 and tmp<=52979) Then get_abc="W":exit Function
	If(tmp>=52980 and tmp<=53640) Then get_abc="X":exit Function
	If(tmp>=53641 and tmp<=54480) Then get_abc="Y":exit Function
	If(tmp>=54481 and tmp<=62289) Then get_abc="Z":exit Function
	get_abc="-"
End Function

'//* 版权信息 *//
Public Sub Web_Copy()
	Dim HtmlStr:HtmlStr=Cls.ReadSkin("copyright")
	HtmlStr = Replace(HtmlStr,"{$closer}",Cls.ReadSkin("closer"))	
	Response.write Cls.ReHtml(HtmlStr,1)
End Sub

'================================================
'作  用：用户系统信息
'参  数：
'	svar : 用户系统信息
'================================================
Public Function User_Sys_Type(ByVal sVar)
	If Cls.Is_Null(sVar)="" Then
		User_Sys_Type="未知的系统信息"
		Exit Function
	End If
	Dim sys_dim,Temp1,sys2,s1,tmp
	sys_dim=Split(svar,";")
	If Int(Ubound(sys_dim))<2 Then
		User_Sys_Type="未知的系统信息"
		Exit Function
	End If
	sys2=sys_dim(2)
	s1=Len(sys2)
	tmp=Mid(sys2,s1,1)
	If tmp=")" Then sys2=Mid(sys2,1,s1-1)
	Temp1="操作系统："&sys2
	Temp1=Temp1&"，浏览器："&sys_dim(1)
	Temp1=Replace(Temp1,"MSIE","Internet Explorer")
	Temp1=Replace(Temp1,"NT 5.0","2000")
	Temp1=Replace(Temp1,"NT 5.1","XP")
	Temp1=Replace(Temp1,"NT 5.2","2003")
	If IsArray(sys_dim) Then Erase sys_dim
	User_Sys_Type=Temp1
End Function

Function Rank_Img(lTimes,tType)
	Dim Times,h_lTime,m_lTime,n_lTime,nh_lTime,nm_lTime,Rank_Temp,Rank,i,Temp,nRank_Time
	Rank_Temp=0
	h_lTime=lTimes \ 60
	m_lTime=lTimes Mod 60
	Do While h_lTime >= 5*Rank_Temp^2+15*Rank_Temp
		Rank_Temp=Rank_Temp+1
	Loop
	Rank=Rank_Temp-1
	n_lTime=(5*Rank_Temp^2+15*Rank_Temp)*60-lTimes
	nh_lTime=n_lTime \ 60
	nm_lTime=n_lTime Mod 60
	Times=Rank
	Do While Times > 0
		If Times \ 16 >0 Then
			For i=1 To Times \ 16
				Temp=Temp&"<img border=0 src="&Cls.Web_Dir&"images/Rank/sun.gIf>"
			Next
			Times=Times Mod 16
		End If
		If Times \ 4 >0 Then
			For i=1 to Times \ 4
				Temp=Temp&"<img border=0 src="&Cls.Web_Dir&"images/Rank/moon.gIf>"
			Next
			Times=Times Mod 4
		End If
		If Times \ 1 >0 Then
			For i=1 to Times \ 1
    				Temp=Temp&"<img border=0 src="&Cls.Web_Dir&"images/Rank/star.gIf>"
   			Next
   			Times=Times Mod 1
  		End If
 	Loop
	Select Case Cint(tType)
	Case 1
		Rank_Img="<td colspan=2><span title='Rank: "&Rank&"'>"&Temp&"</span>&nbsp;今日在线&nbsp;<font color=red title='5分种统计一次，并将此值清0'>"&today_onlinetime&"</font>&nbsp;分钟，总在线&nbsp;<font color=red>"&lTimes&"</font>&nbsp;分钟，合计：&nbsp;<font color=red>"&h_lTime&"</font>&nbsp;小时&nbsp;<font color=red>"&m_lTime&"</font>&nbsp;分钟</td></tr>"
		Rank_Img=Rank_Img&"<tr class=tr><td></td><td colspan=2>离下次升级还有&nbsp;<font color=red>"&n_lTime&"</font>&nbsp;分钟，合计：&nbsp;<font color=red>"&nh_lTime&"</font>&nbsp;小时&nbsp;<font color=red>"&nm_lTime&"</font>&nbsp;分钟</td>"
	Case else
		Rank_Img= "<span title='Rank: "&Rank&"'>"&Temp&"</span>"
	End Select
End Function

'//* 格式化Sel_Type *//
Public Function Sel_Type(ByVal Seled,ByVal Selstr)
	Dim Snum,Sdim,Temp1
	If Selstr="" Then Exit Function
	If Instr(Selstr,"|")<0 then
		Sel_Type="<option value='"&Selstr&"'>"&Selstr&"</option>"
		Exit Function
	End If
	Sdim=Split(Selstr,"|")
	Snum=Ubound(Sdim)
	For i=0 To Snum
		Temp1=Temp1&"<option value='"&Sdim(i)&"'"
		If (Seled=Sdim(i)) Then Temp1=Temp1&" selected"
		Temp1=Temp1&">"&Sdim(i)&"</option>"
	Next
	Erase Sdim
	Sel_Type=Temp1
End Function

'//* 关键字链接 *//
Public Function KeyWord_Url(Byval strText)
    Dim re,s,iii,strKeyword,strKeyurl,strKeytype
	set re = New RegExp
	re.IgnoreCase = True
	re.Global = True
    s = strText
    If Not Cls.KeyWordTrue or strText="" Then 
	       KeyWord_Url = s
	       Exit Function
	End If
    If isArray(Cls.ChannelKeyWord) Then
		   For iii = 0 To UBound(Cls.ChannelKeyWord,2)
					strKeyword = Cls.ChannelKeyWord(1,iii)
					strKeyurl = Cls.ChannelKeyWord(2,iii)
					strKeytype = Cls.ChannelKeyWord(4,iii)
					If strKeyword <> "" Then
						  re.Pattern = "(^|[^\/\\\w\=])(" & strKeyword & ")"
						  if strKeytype Then
						       s=re.Replace(s, "$1<a target=""_blank"" href=""" & strKeyurl & """ class=""KeyLink""><font color=red><b>$2</b></font></a>")
						  Else
						       s=re.Replace(s, "$1<a target=""_blank"" href=""" & strKeyurl & """ class=""KeyLink"">$2</a>")
						  End If
					End If
		  Next
	End If
	KeyWord_Url=s
	set re = nothing
End Function
'//* 中文字符数判断函数 *//
Function Chinese(types)
    Dim Ctypes,i,tt
        Ctypes=types:Chinese="no"
            for i=1 to len(Ctypes)
            tt=mid(Ctypes,i,1)
        if int(asc(tt))<0 then Chinese="yes":exit for
    next
End Function

'//* 精减句段判断函数 *//
Function PrintTrueText(tempString)
	If tempString<>"" Then
		PrintTrueText=Replace(Replace(Replace(Replace(Replace(killhtmlEncode(tempString),VbCrLf & " ","<br />" & "&nbsp;"),VbCrLf,"<br />" & VbCrLf),"   "," &nbsp; "),"  "," &nbsp;"),chr(9)," &nbsp; &nbsp; &nbsp;")

		If Left(PrintTrueText,1) = chr(32) Then
			PrintTrueText = "&nbsp;" & Mid(PrintTrueText,2)
		End If
	Else
		PrintTrueText=""
	End If
End Function

'//* 删除语句中的相关字符 *//
Function killhtmlEncode(str)
    dim re
	set re = New RegExp
	re.Global = True
	re.IgnoreCase = True
	Dim TStr1:TStr1=str
	re.Pattern = "\<([A-Za-z0-9\./=\?%\-&_~`@$\(\)[\]\':+!#\ \""\f]*)\>"
	TStr1 = re.Replace(TStr1, " ")
    re.Pattern = "\[([A-Za-z0-9\./=\?%\-&_~`@$\(\)[\]\':+!#\ \""\f]*)\]"
	TStr1 = re.Replace(TStr1,"")
	Set Re = Nothing
	killhtmlEncode=TStr1
End Function

'//* Rss相关函数 *//
Function RemoveHTML(strHTML)
	Dim objRegExp, Match, Matches
	Set objRegExp = New Regexp
	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	'取闭合的<>
	objRegExp.Pattern = "<.+?>"
	'进行匹配
	Set Matches = objRegExp.Execute(strHTML)
	' 遍历匹配集合，并替换掉匹配的项目
	For Each Match in Matches
		strHtml=Replace(strHTML,Match.Value,"")
	Next
	RemoveHTML=strHTML
	Set objRegExp = Nothing
End Function

'//* 检查连接中是否有非法信息 *//
Public Sub ChkPostAgent()
    On Error Resume Next
    Dim server_v1, server_v2
    Dim m_blnAgent,m_strAgent
    m_blnAgent = False
    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
        m_blnAgent = True
    End If
    If m_blnAgent Then
        m_strAgent = Request.ServerVariables("HTTP_USER_AGENT")
        If Left(m_strAgent, 7) = "Mozilla" Or Left(m_strAgent, 5) = "Opera" Then
            m_blnAgent = True
        End If
    End If
    If m_blnAgent = False Then
        Response.Status = "302 Object Moved"
        Response.End
    End If
End Sub

'//* 发布内容图片张数控制 *//
'Function Word_Img_True(v_remark,dimok,dim_img_num)
	'Word_Img_True=true
	'If int(dimok)=1 then
        'dim img_num,num_remark
        'img_num=split(Lcase(v_remark),"[img]")
        'num_remark=ubound(img_num)
		'If int(num_remark)>=int(dim_img_num) then
			'Word_Img_True=false
		'End If
	'End If
'End Function

'--- 文件防盗下载调用
Public Function FileDefendThiefDownUrl(strFile)
	On Error Resume Next
	Server.ScriptTimeOut=999999
	Dim S,fso,f,intFilelength,FileName
	FileName = strFile
	Response.Buffer = True
	Response.Clear
	Set s = Server.CreateObject("Adodb." & "Str" & "eam")
	s.Open
	s.Type = 1
	'Set fso = Server.CreateObject(Trim(Fso_Sys_Var))
	Set fso = New Cls_FileSystem
	If Not fso.FileExists(FileName) Then
		Response.Write("<h1>Error: </h1><br />系统找不到指定文件！<a href='javascript:history.go(-1)'><font color=red>点此返回</font></a>吧！")
		Exit Function
	End If
	Set f = fso.GetFile(FileName)
	intFilelength = f.size
	s.LoadFromFile(FileName)
	If err Then
		Response.Write("<h1>Error: </h1>" & err.Description & "<p>")
		Response.End 
	End If
	Set fso=Nothing
	Dim Data
	Data=s.Read
	s.Close
	Set s=Nothing
	If Response.IsClientConnected Then 
		Response.AddHeader "Content-Disposition", "attachment; filename=AsaiMHDownFlie"&Cls.Rand_File(9)&"."&GetFileExt(f.name)
		Response.AddHeader "Content-Length", intFilelength 
		Response.CharSet = "UTF-8" 
		Response.ContentType = "application/octet-stream"
		Response.BinaryWrite Data
		Response.Flush
	End If
End Function

Function FileDefendThiefDownUrl2(strFile)
	Dim Stream,TmpFso,fso,File,intFilelength,UrlFilePath
	UrlFilePath = strFile
	Response.Buffer = True
	Response.Clear
	Set Stream = Server.CreateObject("ADODB.Stream")
	Stream.Type = 1
	Stream.Open
	on error resume next
	Set TmpFso = New Cls_FileSystem
	'if TmpFso.Chk_Exist(UrlFilePath,0) then
		'Response.Write("<h1>Error:</h1>"&UrlFilePath&" Document does not exist<p>")
		'Response.End
	'end if
	Set File = TmpFso.GetFile(UrlFilePath)
	intFilelength = File.size
	Stream.LoadFromFile(UrlFilePath)
	'if err then
		'Response.Write("<h1>Error:</h1>" & err.Description & "<p>")
		'Response.End
	'end if
	Response.ContentType = "application/ms-download"
	Response.AddHeader "Content-Disposition", "attachment; FileName=AsaiMHDownFlie"&Cls.Rand_File(9)&".rar"	'生成随机文件名
	Response.AddHeader "Content-Length", intFilelength
	Response.CharSet     = "UTF-8"
	Response.ContentType = "application/octet-stream"
	Response.BinaryWrite Stream.Read
	Response.Flush
	Stream.Close
	Set s = Nothing
	'Response.Write("<script>window.close();</script>")
	Response.End()
End Function
%>
