cf_myfunction.asp

支持多种播放器RealPlayer,MediaPlayer

<%
'乘风电影程序
'制作：乘　风
'QQ：178575
'E-Mail：[e-mail]
'开发网站：http://www.qqcf.com
'详细简介：http://www.qqcf.com/?action=list&list=cffilm
'上面有程序在线演示，安装演示，使用疑难解答，最新版本下载等内容
'因为这些内容可能时常更新，就没有放在程序里，请自己上网站上查看
'有完整版本的演示，包括如何实际整合Helix,Serv-u完全的实现在线播
'放和下载防盗链等
%>

<%'以下为公用函数
Function GoBack(ByVal Str,ByVal AlertStr) '为空时后退
 If Str="" Then 
  Response.Write "<script>" 
  Response.Write "alert('"&AlertStr&"');" 
  Response.Write "history.go(-1)" 
  Response.Write "</script>" 
  Call ConnClose()
  Response.End 
 Else
  GoBack=Str
 End If
End Function

Function AlertBack(ByVal AlertStr,ByVal BackNum) 
  Response.Write "<script>" 
  Response.Write "alert('"&AlertStr&"');" 
  Response.Write "history.go(-"&BackNum&")" 
  Response.Write "</script>" 
  Call ConnClose()
  Response.End 
End Function

Function AlertUrl(ByVal AlertStr,ByVal Url) 
 Response.Write "<script>" 
 Response.Write "alert('"&AlertStr&"');" 
 Response.Write "location.href='"&Url&"';" 
 Response.Write "</script>" 
 Call ConnClose()
 Response.end 
End Function

Function GotoUrl(ByVal Url) 
 Response.Write "<script>" 
 Response.Write "location.href='"&Url&"';" 
 Response.Write "</script>" 
 Call ConnClose()
 Response.End 
End Function

Function CheckInput_Letter(ByVal InputStr) '检查用户名输入的合法性
 CheckInput_Letter = -1
 For I = 1 To Len(InputStr)
  C = Mid(InputStr, I, 1)
  If InStr("abcdefghijklmnopqrstuvwxyz_", C) <= 0 And Not IsNumeric(C) Then
   CheckInput_Letter = 0
   Exit For
  End If
 Next
End Function

Function ChkStr(ByVal ParaValue,ByVal ParaType)'参数类型-数字型(1是字符，2是数字，3是日期
 If ParaType = 1 then
  ChkStr = Replace(ParaValue,"'","''")
 ElseIf ParaType = 2 then
  If ParaValue<>"" And (IsNumeric(ParaValue) = False) then
   Response.Write "传递的参数类型有错误！" 
   Response.End
  Else
   ChkStr = ParaValue
  End If
 ElseIf ParaType = 3 then
  If ParaValue<>"" And (IsDate(ParaValue) = False) then
   Response.Write "传递的参数类型有错误！" 
   Response.End
  Else
   ChkStr = ParaValue
  End If
 End If
End Function

Function GetFieldValues(ByVal TalbeName,ByVal FieldNmae,ByVal Fieldvalues,ByVal FieldType,ByVal GetFieldName)  '通用,通过一个表的字段，得到表中某个字段的值
 If FieldType=1 Then
  Sql="select "&GetFieldName&" from "& TalbeName &" where "& FieldNmae &"="& Fieldvalues
 ElseIf FieldType=2 Then
  Sql="select "&GetFieldName&" from "& TalbeName &" where "& FieldNmae &"='"& Fieldvalues &"'"
 End If
 Set FieldValues=Server.CreateObject("Adodb.RecordSet")
 FieldValues.Open Sql,Conn,1,1
 If Not FieldValues.Eof Then GetFieldValues=FieldValues(0)
 FieldValues.Close
End function

Function MyRate(snum,bnum)
 MyRate=Cstr((snum/bnum)*100)
 If Instr(MyRate,".")=0 Then
  MyRate=MyRate&".00"
 Else
  If Len(Mid(MyRate,Instr(MyRate,".")+1))=1 Then
   MyRate=MyRate&"0"
  Else
   MyRate=Left(MyRate,Instr(MyRate,".")+2)
  End If
 End If
 If Left(MyRate,Instr(MyRate,".")-1)=0 Then MyRate="0"&MyRate
End Function

Function MyRate_2(ByVal num)
 MyRate_2=num
 If Instr(MyRate_2,".")=0 Then
  MyRate_2=MyRate_2&".00"
 Else
  If Len(Mid(MyRate_2,Instr(MyRate_2,".")+1))=1 Then
   MyRate_2=MyRate_2&"0"
  Else
   MyRate_2=Left(MyRate_2,Instr(MyRate_2,".")+2)
  End If
 End If
 If Left(MyRate_2,Instr(MyRate_2,".")-1)=0 Then MyRate_2="0"&MyRate_2
End Function

Function HttpPath(ByVal Assort)
 Ser=Request.servervariables("SERVER_NAME")
 Scr=Request.servervariables("SCRIPT_NAME")
 Port=Request.Servervariables("SERVER_PORT")

 Scr_2=StrReverse(Mid(StrReverse(Scr),Instr(StrReverse(Scr),"/")))

 If Assort=1 Then
  HttpPath=Ser 
 ElseIf Assort=2 Then
  If Port="80" Then
   HttpPath="http://"&Ser&Scr_2
  Else
   HttpPath="http://"&Ser&":"&Port&Scr_2
  End If 
 ElseIf Assort=3 Then
  If Port="80" Then
   HttpPath="http://"&Ser&Scr
  Else
   HttpPath="http://"&Ser&":"&Port&Scr
  End If
 End If
End Function

Function GetCurrWeb()
 Url=HttpPath(3)&"?"&Request.QueryString&"&"&Request.Form
 If Mid(Url,Len(Url))="&" Then Url=Left(Url,Len(Url)-1)
 Session("Url")=Url
End Function


Function PxFilter(ByVal px,ByVal pxok)
 px=Lcase(px)
 pxok=Lcase(pxok)

 PxArrary=Split(Pxok,",")

 For I= 0 To Ubound(PxArrary)
  If PxArrary(I)=Px Then J=1
 Next

 If J<>1 Then Call AlertBack("禁止此类排序",1)
End Function

Function GetConVertStr(ByVal MyStr)
 If MyStr="-" Then MyStr=""
 GetConVertStr=MyStr
End Function

Function BreakUrl(ByVal Url,ByVal BreakType)
 Url=Lcase(Url)
 If Url<>"-" Then
  UrlArrary=Split(Url,"/")
  UrlHead=UrlArrary(2)
  UrlTail=UrlArrary(Ubound(UrlArrary))
  If BreakType=1 Then
   BreakUrl=UrlHead
  ElseIf BreakType=2 Then
   If UrlTail<>"" Then
    BreakUrl=UrlTail
   Else
    BreakUrl=UrlHead
   End if
  End if
 Else
  BreakUrl=Url
 End if
End Function


Function GetTurnTime(byval Num)
 Num=Cstr(Num)
 If Len(Num)=1 Then
  GetTurnTime="0"&Num
 Else
  GetTurnTime=Num
 End if
End Function

Function FSOFileRead(ByVal filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function

Function URLDecode(byval enStr)
  dim deStr
  dim c,i,v
  deStr=""
  for i=1 to len(enStr)
  c=Mid(enStr,i,1)
  if c="%" then
  v=eval("&h"+Mid(enStr,i+1,2))
  if v<128 then
  deStr=deStr&chr(v)
  i=i+2
  else
  if isvalidhex(mid(enstr,i,3)) then
  if isvalidhex(mid(enstr,i+3,3)) then
  v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
  deStr=deStr&chr(v)
  i=i+5
  else
  v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
  deStr=deStr&chr(v)
  i=i+3 
  end if 
  else 
  destr=destr&c
  end if
  end if
  else
  if c="+" then
  deStr=deStr&" "
  else
  deStr=deStr&c
  end if
  end if
  next
  URLDecode=deStr
  end function

  function isvalidhex(str)
  isvalidhex=true
  str=ucase(str)
  if len(str)<>3 then isvalidhex=false:exit function
  if left(str,1)<>"%" then isvalidhex=false:exit function
  c=mid(str,2,1)
  if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
  c=mid(str,3,1)
  if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
  end function
  

'解码出始
function UTF2GB(byval UTFStr) 
for Dig=1 to len(UTFStr) 
if mid(UTFStr,Dig,1)="%" then 
if len(UTFStr) >= Dig+8 then 
GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9)) 
Dig=Dig+8 
else 
GBStr=GBStr & mid(UTFStr,Dig,1) 
end if 
else 
GBStr=GBStr & mid(UTFStr,Dig,1) 
end if 
next 
UTF2GB=GBStr 
end function 

function ConvChinese(x) 
A=split(mid(x,2),"%") 
i=0 
j=0 

for i=0 to ubound(A) 
A(i)=c16to2(A(i)) 
next 

for i=0 to ubound(A)-1 
DigS=instr(A(i),"0") 
Unicode="" 
for j=1 to DigS-1 
if j=1 then 
A(i)=right(A(i),len(A(i))-DigS) 
Unicode=Unicode & A(i) 
else 
i=i+1 
A(i)=right(A(i),len(A(i))-2) 
Unicode=Unicode & A(i) 
end if 
next 

if len(c2to16(Unicode))=4 then 
ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode))) 
else 
ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode))) 
end if 
next 
end function 

function c2to16(x) 
i=1 
for i=1 to len(x) step 4 
c2to16=c2to16 & hex(c2to10(mid(x,i,4))) 
next 
end function 

function c2to10(x) 
c2to10=0 
if x="0" then exit function 
i=0 
for i= 0 to len(x) -1 
if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i) 
next 
end function 

function c16to2(x) 
i=0 
for i=1 to len(trim(x)) 
tempstr= c10to2(cint(int("&h" & mid(x,i,1)))) 
do while len(tempstr)<4 
tempstr="0" & tempstr 
loop 
c16to2=c16to2 & tempstr 
next 
end function 

function c10to2(x) 
mysign=sgn(x) 
x=abs(x) 
DigS=1 
do 
if x<2^DigS then 
exit do 
else 
DigS=DigS+1 
end if 
loop 
tempnum=x 

i=0 
for i=DigS to 1 step-1 
if tempnum>=2^(i-1) then 
tempnum=tempnum-2^(i-1) 
c10to2=c10to2 & "1" 
else 
c10to2=c10to2 & "0" 
end if 
next 
if mysign=-1 then c10to2="-" & c10to2 
end function 
'解码结束

Function GetAdClassName(ByVal Ad_Class) 
 If Ad_Class=1 Then
  GetAdClassName="直接文字广告"
 ElseIf Ad_Class=2 Then
  GetAdClassName="直接图片广告"
 ElseIf Ad_Class=3 Then
  GetAdClassName="网页文字广告"
 ElseIf Ad_Class=4 Then
  GetAdClassName="网页图片广告"
 ElseIf Ad_Class=5 Then
  GetAdClassName="弹出广告(点击有效)"
 ElseIf Ad_Class=6 Then
  GetAdClassName="弹出广告(弹出有效)"
 ElseIf Ad_Class=7 Then
  GetAdClassName="网页复合广告"
 End If
End Function

Function Gen_Key(ByVal digits) 
 dim char_array(10)
 char_array(0) = "0"
 char_array(1) = "1"
 char_array(2) = "2"
 char_array(3) = "3"
 char_array(4) = "4"
 char_array(5) = "5"
 char_array(6) = "6"
 char_array(7) = "7"
 char_array(8) = "8"
 char_array(9) = "9"

 randomize
 do while len(output)<digits
 num = char_array(Int((9 - 0 + 1) * Rnd + 0))
 output = output + num
 loop
 gen_key = output
End Function

Function DollarConVert(ByVal MyCent)
 MyCent=Cstr(MyCent)
 If Instr(MyCent,".")=1 Then MyCent="0"&MyCent
 If Len(MyCent)=3 Then MyCent=MyCent&"0"
 If MyCent="0" Then MyCent="0.00"
 DollarConVert=MyCent
End Function

Function GetIpArea(ByVal Ip)
 inIP=Ip
 inIPs=split(inIP,".")
 inIPnum=inips(0)*256*256*256 + inips(1)*256*256 + inips(2)*256 + inips(3)

 Sql="Select * from WWW_CF_COM_CfWztg_IpAddress where Ip_1<="&inIPnum&" and Ip_2>="&inIPnum
 set RsIp=conn.Execute(Sql)

 If Not RsIp.Eof Then
  If RsIp("Area")<>"" Then GetIpArea = RsIp("Area")
 Else
  GetIpArea= "-"
 End If
 RsIp.Close
End Function

Function GetMySet(ByVal MyStr)

 If IsEmpty(Application("CFFilmMySet")) Then
  Sql = "Select OtherSet From CFFilm_Admin"
  Set Rs_MySet = Conn.Execute(Sql)
  Application("CFFilmMySet") = Rs_MySet("OtherSet")
  Rs_MySet.Close
 End If
 
 MyArray_MySet = Split(Application("CFFilmMySet"), "|")
 For I_MySet = 0 To UBound(MyArray_MySet)
  If LCase(Left(MyArray_MySet(I_MySet), Len(MyStr) + 1)) = LCase(MyStr) & "=" Then GetMySet = Mid(MyArray_MySet(I_MySet), Len(MyStr) + 2)
 Next

End Function

Function GetAppSet(ByVal App, ByVal MyStr)
 MyArray_AppSet = Split(App, "*")

 For I_AppSet = 0 To UBound(MyArray_AppSet)
  If LCase(Left(MyArray_AppSet(I_AppSet), Len(MyStr) + 1)) = LCase(MyStr) & "=" Then GetAppSet = Mid(MyArray_AppSet(I_AppSet), Len(MyStr) + 2)
 Next
End Function

Function GetAppSet_2(ByVal App, ByVal MyStr, ByVal SplitStr)
 MyArray_GetAppSet_2 = Split(App, SplitStr)

 For I_GetAppSet_2 = 0 To UBound(MyArray_GetAppSet_2)
  If LCase(Left(MyArray_GetAppSet_2(I_GetAppSet_2), Len(MyStr) + 1)) = LCase(MyStr) & "=" Then GetAppSet_2 = Mid(MyArray_GetAppSet_2(I_GetAppSet_2), Len(MyStr) + 2)
 Next
End Function

Function GetPorduceArea(PorduceArea)
If PorduceArea=1 Then
 GetPorduceArea="大陆影片"
ElseIf PorduceArea=2 Then
 GetPorduceArea="港台影片"
ElseIf PorduceArea=3 Then
 GetPorduceArea="日本影片"
ElseIf PorduceArea=4 Then
 GetPorduceArea="韩国影片"
ElseIf PorduceArea=5 Then
 GetPorduceArea="欧美影片"
ElseIf PorduceArea=6 Then
 GetPorduceArea="其它影片"
End If
End Function

Function GetFilmLevel(FilmLevel)
If FilmLevel=1 Then
 GetFilmLevel="免费电影"
ElseIf FilmLevel=2 Then
 GetFilmLevel="需要点击广告观看"
ElseIf FilmLevel=3 Then
 GetFilmLevel="需要消耗点数观看"
ElseIf FilmLevel=4 Then
 GetFilmLevel="只有黄金会员观看"
End If
End Function

Function ConnClose()
 If IsObject(Rs)=True Then
  Rs.Close
  Set Rs=Nothing
 End If

 If IsObject(Rs2)=True Then
  Rs2.Close
  Set Rs2=Nothing
 End If

 If IsObject(RsUser)=True Then
  RsUser.Close
  Set RsUser=Nothing
 End If

 If IsObject(RsSet)=True Then
  RsSet.Close
  Set RsSet=Nothing
 End If

 If IsObject(qqcf)=True Then
  qqcf.Close
  Set qqcf=Nothing
 End If

 If IsObject(Conn)=True Then
  Conn.Close
  Set Conn=Nothing
 End If
End Function
%>