
<% 
 '===========================================================================================
	'软件名称：126 cms 视频影视管理系统
	'程序版权：126电影               '咨询QQ：479025
	'开发作者：magicblack(479025)    '官方网站：http://www.126oo.com/
	'Copyright (C) 2009 - ... 126oo.com  All Rights Reserved.
	'郑重声明:
	'    1、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
	'    2、任何个人或组织不得以盈利为目的发布,修改,本软件及其他副本上一切关于版权的信息；
	'    3、126电影保留此软件的法律追究权利；
'==========================================================================================
%>

<%
response.Charset="GBK"
'服务器端输出javascript
Private Sub Js(ByVal Str)
	Response.Write("<sc" & "ript type=""text/javascript"">" & VbCrLf)
	Response.Write(VbTab & Str & VbCrLf)
	Response.Write("</scr" & "ipt>" & VbCrLf)
End Sub
'服务器端输出javascript弹出消息框并返回前页
Private Sub Alert(ByVal str)
	Response.Write("<sc" & "ript type=""text/javascript"">alert('" & JsEncode(str) & "\t\t');history.go(-1);</sc" & "ript>"&VbCrLf)
	Response.End()
End Sub
'服务器端输出javascript弹出消息框并转到URL
Private Sub AlertUrl(ByVal str, ByVal url)
	Response.Write("<sc" & "ript type=""text/javascript"">"&VbCrLf)
	Response.Write(VbTab&"alert('" & JsEncode(str) & "\t\t');location.href='" & url & "';"&VbCrLf)
	Response.Write("</sc" & "ript>"&VbCrLf)
End Sub

Function ShowMsg(msg,url)
Response.Write "<style>body{text-align:center}</style>"
Response.Write "<script>"&vbcrlf
Response.Write "var pgo=0;"&vbcrlf
Response.Write "function JumpUrl(){"&vbcrlf
Response.Write "if(pgo==0){ location='"&url&"'; pgo=1; }}"&vbcrlf
Response.Write "document.write(""<br/><div style='width:400px;margin:0px auto;padding-top:4px;height:24px;line-height: 24px;font-size:10pt;border:1px solid #cad9ea;background-color:#f5fafe;'>&nbsp;系统提示信息：</div>"");"&vbcrlf
Response.Write "document.write(""<div style='width:400px;margin:0px auto;height:100;font-size:10pt;text-align: center;border:1px solid #cad9ea;background-color:#ffffff'><br/><br/>"");"&vbcrlf
Response.Write "document.write("""&msg&""");"&vbcrlf
Response.Write "document.write(""<br/><br/><a href='"&url&"'>如果你的浏览器没反应，请点击这里...</a><br/><br/></div>"");"&vbcrlf
Response.Write "setTimeout('JumpUrl()',2000);</script>"
Response.end
End Function

Private Sub ErrMsg(e,d)
Response.Write "<style>body{text-align:center}</style><br/><div style='width:400px;margin:0px auto;padding-top:4px;height:24px;line-height: 24px;font-size:10pt;border:1px solid #cad9ea;background-color:#f5fafe;'>&nbsp;"&e&"：</div>"&vbcrlf
Response.Write "<div style='width:400px;margin:0px auto;height:100;font-size:10pt;text-align: center;border:1px solid #cad9ea;background-color:#ffffff'><br/><br/>"&vbcrlf
Response.Write d & vbcrlf
Response.Write "<br/><br/><br/><br/></div>"&vbcrlf
Response.end
End Sub

private sub WriteFlush(ByVal str)
	response.write(str)
	response.Flush()
end sub

private sub WriteEnd(ByVal str)
	response.write(str)
	response.end()
end sub

'处理字符串中的Javascript特殊字符
Function JsEncode(ByVal str)
	If Not isN(str) Then
		str = Replace(str,Chr(92),"\\")
		str = Replace(str,Chr(34),"\""")
		str = Replace(str,Chr(39),"\'")
		str = Replace(str,Chr(9),"\t")
		str = Replace(str,Chr(13),"\r")
		str = Replace(str,Chr(10),"\n")
		str = Replace(str,Chr(12),"\f")
		str = Replace(str,Chr(8),"\b")
	End If
	JsEncode = str
End Function

'判断是否为空值
Function isN(ByVal str)
	isN = Easp_isN(str)
End Function

Function isNum(str)
	if not isN(str) then   isNum=isnumeric(str) else isNum=false
End Function

Private Function Easp_isN(ByVal str)
	Easp_isN = False
	Select Case VarType(str)
		Case vbEmpty, vbNull
			Easp_isN = True : Exit Function
		Case vbString
			If str="" Then Easp_isN = True : Exit Function
		Case vbObject
			If TypeName(str)="Nothing" Or TypeName(str)="Empty" Then Easp_isN = True : Exit Function
		Case vbArray,8194,8204,8209
			If Ubound(str)=-1 Then Easp_isN = True : Exit Function
	End Select
End Function

Private Function Easp_Param(ByVal s)
	Dim arr(2),t : t = Instr(s,":")
	If t > 0 Then
		arr(0) = Left(s,t-1) : arr(1) = Mid(s,t+1)
	Else
		arr(0) = s : arr(1) = ""
	End If
	Easp_Param = arr
	
End Function

Private Function Easp_IIF(ByVal Cn, ByVal T, ByVal F)
	If Cn Then Easp_IIF = T Else Easp_IIF = F End If
End Function

'判断三元表达式
Function IfThen(ByVal Cn, ByVal T, ByVal F)
	IfThen = Easp_IIF(Cn,T,F)
End Function

Function IIF(ByVal Cn, ByVal T, ByVal F)
	IIF = Easp_IIF(Cn,T,F)
End Function

'安全获取值原始方法
Private Function SafeData(fn, ByVal Str, ByVal RType)
	Dim TempStr, fna
	Dim RDefault,RSplit
	Dim TempArr, i
	Select Case fn
		Case "R", "Ra" TempStr = Request(Str)
		Case "RF", "RFa" TempStr = Request.Form(Str)
		Case "RQ", "RQa" TempStr = Request.QueryString(Str)
		Case "RH", "RHa" TempStr = Request.QueryString()
		Case Else TempStr = Str
	End Select
	fna = IfThen(fn = "Ra" or fn = "RFa" or fn = "RQa" or fn = "RHa",True,False)
	If fn = "RH" or fn = "RHa" Then
		If Not isNumeric(Str) Then SafeData = "" : Exit Function
		TempStr = Split(Split(TempStr,".")(0),"-")(Str)
	End If
	RSplit = ","
	If Instr(Cstr(RType),":")=2 Then
		RDefault = Mid(RType,3)
		If IsN(TempStr) Then TempStr = RDefault
		RType = Int(Left(RType,1))
		If RType = 2 Or RType = 3 Then RSplit = RDefault
	End If
	Select Case RType
		Case 0
			TempStr = Replace(TempStr,"'","''")
		Case 1
			TempStr = IsNumber(TempStr,IfThen(fna,0,1))
		Case 2,3
			If Instr(TempStr,RSplit)>0 Then
				TempArr = split(TempStr,RSplit)
				TempStr = ""
				For i = 0 To Ubound(TempArr)
					If i <>0 Then TempStr = TempStr & RSplit
					If RType = 2 Then
						TempStr = TempStr & Replace(Trim(TempArr(i)),"'","''")
					Else
						TempArr(i) = IsNumber(Trim(TempArr(i)),IfThen(fna,0,1))
						TempStr = TempStr & TempArr(i)
					End If
				Next
			Else
				TempStr = IfThen(RType = 2,Replace(TempStr,"'","''"),IsNumber(TempStr,IfThen(fna,0,1)))
			End If
	End Select
	SafeData = TempStr
End Function

'获取用户IP地址
Private Function GetIP()
	Dim addr, x, y
	x = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	y = Request.ServerVariables("REMOTE_ADDR")
	addr = IIF(isN(x) or lCase(x)="unknown",y,x)
	If InStr(addr,".")=0 Then addr = "0.0.0.0"
	GetIP = addr
End Function

'获取当前页面的URL
Function GetUrl()
  Dim ScriptAddress,Servername,qs,portstr
  if Request.ServerVariables("SERVER_PORT")<>"80" then portstr=":"&Request.ServerVariables("SERVER_PORT")
  ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME")) & portstr
  Servername = CStr(Request.ServerVariables("Server_Name"))
  qs=Request.QueryString
  if qs<>"" then
  GetUrl ="http://"& Servername & ScriptAddress &"?"&qs
  else
  GetUrl ="http://"& Servername & ScriptAddress
  end if
End Function


'判断变量是否为空值
Private Function Easp_isN(ByVal str)
	Easp_isN = False
	Select Case VarType(str)
		Case vbEmpty, vbNull
			Easp_isN = True : Exit Function
		Case vbString
			If str="" Then Easp_isN = True : Exit Function
		Case vbObject
			If TypeName(str)="Nothing" Or TypeName(str)="Empty" Then Easp_isN = True : Exit Function
		Case vbArray,8194,8204,8209
			If Ubound(str)=-1 Then Easp_isN = True : Exit Function
	End Select
End Function


'格式化日期时间
Private Function DateTime(ByVal iTime, ByVal iFormat)
	If Not IsDate(iTime) Then DateTime = "Date Error" : Exit Function
	If isDate(iFormat) Then '格式化为时间差
		Dim diff,dire
		dire = IfThen(iTime>iFormat,"后","前")
		diff = Abs(DateDiff("s",iFormat,iTime))
		If (diff\31536000)>0 Then DateTime = (diff\31536000) & "年" & dire : Exit Function
		If (diff Mod 31536000)\2592000>0 Then DateTime = (diff Mod 31536000)\2592000 & "个月" & dire : Exit Function
		If ((diff Mod 31536000) Mod 2592000)\86400>0 Then DateTime = ((diff Mod 31536000) Mod 2592000)\86400 & "天" & dire : Exit Function
		If (((diff Mod 31536000) Mod 2592000) Mod 86400)\3600>0 Then DateTime = (((diff Mod 31536000) Mod 2592000) Mod 86400)\3600 & "个小时" & dire : Exit Function
		If ((((diff Mod 31536000) Mod 2592000) Mod 86400) Mod 3600)\60>0 Then DateTime = ((((diff Mod 31536000) Mod 2592000) Mod 86400) Mod 3600)\60 & "分钟" & dire : Exit Function
		DateTime = diff & "秒" & dire :Exit Function
	End If
	Select Case iFormat	'采用系统日期格式
		Case "0" DateTime = FormatDateTime(iTime,0) : Exit Function
		Case "1" DateTime = FormatDateTime(iTime,1) : Exit Function
		Case "2" DateTime = FormatDateTime(iTime,2) : Exit Function
		Case "3" DateTime = FormatDateTime(iTime,3) : Exit Function
		Case "4" DateTime = FormatDateTime(iTime,4) : Exit Function
	End Select
	Dim iYear, iMonth, iDay, iHour, iMinute, iSecond,iWeek,tWeek
	Dim iiYear, iiMonth, iiDay, iiHour, iiMinute, iiSecond,iiWeek
	Dim iiiWeek, iiiMonth, iiiiMonth
	Dim SpecialText, SpecialTextRe,i,t
	SpecialText = Array("y","m","d","h","i","s","w")
	SpecialTextRe = Array(Chr(0),Chr(1),Chr(2),Chr(3),Chr(4),Chr(5),Chr(6))
	iWeek = Array("日","一","二","三","四","五","六")
	iiWeek = Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
	iiiWeek = Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
	tWeek = Weekday(iTime)-1
	iYear = right(Year(iTime),2) : iMonth = Month(iTime) : iDay = Day(iTime)
	iHour = Hour(iTime) : iMinute = Minute(iTime) : iSecond = Second(iTime)
	iiYear = Year(iTime) : iiMonth = right("0"&Month(iTime),2)
	iiiMonth = Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
	iiiiMonth = Array("January","February","March","April","May","June","July","August","September","October","November","December")
	iiDay = right("0"&Day(iTime),2) : iiHour = right("0"&Hour(iTime),2)
	iiMinute = right("0"&Minute(iTime),2) : iiSecond = right("0"&Second(iTime),2)
	For i = 0 To 6 : iFormat = Replace(iFormat,"\"&SpecialText(i), SpecialTextRe(i)) : Next
	t = Replace(iFormat,"yyyy", iiYear) : t = Replace(t, "yyy", iiYear)
	t = Replace(t, "yy", iYear) : t = Replace(t, "y", iiYear)
	t = Replace(t, "mmmm", iiiiMonth(iMonth-1)) : t = Replace(t, "mmm", iiiMonth(iMonth-1))
	t = Replace(t, "mm", iiMonth) : t = Replace(t, "m", iMonth)
	t = Replace(t, "dd", iiDay) : t = Replace(t, "d", iDay)
	t = Replace(t, "hh", iiHour) : t = Replace(t, "h", iHour)
	t = Replace(t, "ii", iiMinute) : t = Replace(t, "i", iMinute)
	t = Replace(t, "ss", iiSecond) : t = Replace(t, "s", iSecond)
	t = Replace(t, "www", iiiWeek(tWeek)) : t = Replace(t, "ww", iiWeek(tWeek))
	t = Replace(t, "w", iWeek(tWeek))
	For i = 0 To 6 : t = Replace(t, SpecialTextRe(i),SpecialText(i)) : Next
	DateTime = t
End Function

'正则替换
Function regReplace(ByVal Str, ByVal rule, Byval Result)
	Dim tmpStr,Reg : tmpStr = Str
	If Not isN(tmpStr) Then
		Set Reg = New Regexp
		Reg.Global = True
		Reg.IgnoreCase = True
		Reg.Pattern = rule
		tmpStr = Reg.Replace(tmpStr,Result)
	End If
	regReplace = tmpStr
End Function

'设置一个Cookies值
Sub SetCookie(ByVal cooName, ByVal cooValue, ByVal cooCfg)
	Dim n,i,cExp,cDomain,cPath,cSecure
	If isArray(cooCfg) Then
		For i = 0 To Ubound(cooCfg)
			If Test(cooCfg(i),"date") Then
				cExp = cDate(cooCfg(i))
			ElseIf Test(cooCfg(i),"int") Then
				If cooCfg(i)<>0 Then cExp = Now()+Int(cooCfg(i))/60/24
			ElseIf Test(cooCfg(i),"domain") Then
				cDomain = cooCfg(i)
			ElseIf Instr(cooCfg(i),"/")>0 Then
				cPath = cooCfg(i)
			ElseIf cooCfg(i)="True" or cooCfg(i)="False" Then
				cSecure = cooCfg(i)
			End If
		Next
	Else
		If Test(cooCfg,"date") Then
			cExp = cDate(cooCfg)
		ElseIf Test(cooCfg,"int") Then
			If cooCfg<>0 Then cExp = Now()+Int(cooCfg)/60/24
		ElseIf Test(cooCfg,"domain") Then
			cDomain = cooCfg
		ElseIf Instr(cooCfg,"/")>0 Then
			cPath = cooCfg
		ElseIf cooCfg = "True" or cooCfg = "False" Then
			cSecure = cooCfg
		End If
	End If
	n = Easp_Param(cooName)
	If Not isN(cooValue) Then
		If isN(n(1)) Then
			Response.Cookies(n(0)) = cooValue
		Else
			Response.Cookies(n(0))(n(1)) = cooValue
		End If
	End If
	If Not isN(cExp) Then Response.Cookies(n(0)).Expires = cExp
	If Not isN(cDomain) Then Response.Cookies(n(0)).Domain = cDomain
	If Not isN(cPath) Then Response.Cookies(n(0)).Path = cPath
	If Not isN(cSecure) Then Response.Cookies(n(0)).Secure = cSecure
End Sub

'获取一个Cookies值
Function GetCookie(ByVal cooName)
	Dim n : n = Easp_Param(cooName)
	If Response.Cookies(n(0)).HasKeys And Not isN(n(1)) Then
		GetCookie = SafeData("",Request.Cookies(n(0))(n(1)),0)
	Else
		GetCookie = SafeData("",Request.Cookies(n(0)),0)
	End If
	If IsN(GetCookie) Then GetCookie = ""
End Function

'精确到毫秒的脚本执行时间
Function GetRunningTime()
	GetRunningTime  = "页面执行时间: "&FormatNumber((Timer()-runstart)*1000, 2, -1)&"毫秒 &nbsp;" & Database.queryCount & "次数据查询"
End Function

'特殊字符解码
Function UnEscape(ByVal str)
	Dim x, s
	x = InStr(str,"%")
	s = ""
	Do While x>0
		s = s & Mid(str,1,x-1)
		If LCase(Mid(str,x+1,1))="u" Then
			s = s & ChrW(CLng("&H"&Mid(str,x+2,4)))
			str = Mid(str,x+6)
		Else
			s = s & Chr(CLng("&H"&Mid(str,x+1,2)))
			str = Mid(str,x+3)
		End If
		x=InStr(str,"%")
	Loop
	UnEscape = s & str
End Function

Private Function Escape(ByVal str)
	Dim i,c,a,s : s = ""
	If Easp_isN(str) Then Easp_Escape = "" : Exit Function
	For i = 1 To Len(str)
		c = Mid(str,i,1)
		a = ASCW(c)
		If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then
			s = s & c
		ElseIf InStr("@*_+-./",c)>0 Then
			s = s & c
		ElseIf a>0 and a<16 Then
			s = s & "%0" & Hex(a)
		ElseIf a>=16 and a<256 Then
			s = s & "%" & Hex(a)
		Else
			s = s & "%u" & Hex(a)
		End If
	Next
	Easp_Escape = s
End Function

'HTML加码函数
Function HtmlEncode(ByVal str)
	If Not IsN(str) Then
		str = Replace(str, Chr(38), "&#38;")
		str = Replace(str, ">", "&gt;")
		str = Replace(str, "<", "&lt;")
		str = Replace(str, Chr(39), "&#39;")
		str = Replace(str, Chr(32), "&nbsp;")
		str = Replace(str, Chr(34), "&quot;")
		str = Replace(str, Chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
		str = Replace(str, Chr(13), "")
		str = Replace(str, Chr(10), "<br />")
	End If
	HtmlEncode = str
End Function

'HTML解码函数
Function HtmlDecode(ByVal str)
	If Not IsN(str) Then
		str = Replace(str, "<br/>", Chr(13)&Chr(10))
		str = Replace(str, "<br>", Chr(13)&Chr(10))
		str = Replace(str, "<br />", Chr(13)&Chr(10))
		str = Replace(str, "&nbsp;&nbsp;&nbsp;&nbsp;", Chr(9))
		str = Replace(str, "&amp;", Chr(38))
		str = Replace(str, "&#39;", Chr(39))
		str = Replace(str, "&apos;", Chr(39))
		str = Replace(str, "&nbsp;", Chr(32))
		str = Replace(str, "&quot;", Chr(34))
		str = Replace(str, "&gt;", ">")
		str = Replace(str, "&lt;", "<")
		str = Replace(str, "&#38;", Chr(38))
		HtmlDecode = str
	End If
End Function

'过滤HTML标签
Function HtmlFilter(ByVal str)
	Dim regEx
	Set regEx = New RegExp
	regEx.Pattern = "<[^>]+>|</[^>]+>"
	regEx.Global = true
	str = regEx.Replace(str,"")
	str = Replace(str, ">", "&gt;")
	str = Replace(str, "<", "&lt;")
	HtmlFilter = str
End Function

function htmltojs(content)
dim arrLines,i,strNew,sLine
arrLines = Split(content, Chr(10) )
  If IsArray(arrLines) then
   For i=0 To UBound( arrLines )
	sLine = Replace( arrLines(i) , "\" , "\\")
	sLine = Replace( sLine , "/" , "\/")
	sLine = Replace( sLine , "'" , "\'")
	sLine = Replace( sLine , """" , "\""")
    sLine = Replace( sLine , Chr(13) , "" )
    strNew = strNew & "document.writeln('" & sLine  & "');" & Chr(10)
   Next
  end if
htmltojs=strNew
end function

function jstohtml(content)
	content = Replace( content , "document.writeln('" , "")
	content = Replace( content , "\'" , "'")
	content = Replace( content , "\""" , """")
	content = Replace( content , "\\" , "\")
	content = Replace( content , "\/" , "/")
	content = Replace( content , "');" , "")
jstohtml=content
end function

Public Function ParametersToArray(Byval attr)
		on error resume next 
		dim attrStr,attrArray,attrDictionary,i,singleAttr,singleAttrKey,singleAttrValue,DY
		set DY = Server.CreateObject("SCRIPTING.DICTIONARY")
		attrArray = split(attr," ")
		for i=0 to ubound(attrArray)
			singleAttr = split(attrArray(i),"=")
			singleAttrKey =  singleAttr(0) : singleAttrValue =  singleAttr(1)
			if not DY.Exists(singleAttrKey) then DY.add singleAttrKey,singleAttrValue  else  DY(singleAttrKey) = singleAttrValue
		next
		set ParametersToArray = DY
		If Err.number <> 0 then ErrMsg "系统提示","模版标签出错,请检查标签是否正确!"
End Function

Function GetTimeSpan(sessionName)
	dim lastTime : lastTime=session(sessionName)
	if isN(lastTime) then lastTime=0
	GetTimeSpan=DateDiff("s",lasttime,now())
End Function

Function  getStrLen(Byval str)
	dim strlen,charCount,i
	str=trim(str)   
	charCount = len(str)   
	strlen = 0   
	for i = 1 to charCount   
		if asc(mid(str,i,1)) < 0 or asc(mid(str,i,1)) >255 then   
			strlen = strlen + 2   
		else   
			strlen = strlen + 1   
		end if
	next
	getStrLen = strlen
End Function

Function getStrByLen(Byval str, Byval strlen)
	dim vStrlen,charCount,i
	str=trim(str)
	if isNul(str) then Exit Function   
	charCount = len(str)  
	vStrlen = 0   
	for i = 1 to charCount   
		if asc(mid(str,i,1)) < 0 or asc(mid(str,i,1)) >255 then   
			vStrlen = vStrlen + 1   
		else   
			vStrlen = vStrlen + 2   
		end if
		if vStrlen >= strlen then  getStrByLen = left(str,i) : Exit Function
	next
	getStrByLen = left(str,charCount)
End Function

function Getrnd()
		Dim num1,rndnum
		Randomize
		Do While Len(rndnum)<4
			num1=CStr(Chr((57-48)*rnd+48))
			rndnum=rndnum&num1
		Loop
		Getrnd = rndnum
end function

%>