📄 qqcf_myfunction.asp
字号:
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="弹出广告(弹出类)"
End If
End Function
Function Gen_Key(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)
connstrIP="DBQ="+server.mappath("QQCF_Data/QQCF_Ip.Mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set connIP = Server.CreateObject ("ADODB.Connection")
connIP.open connstrIP
inIP=Ip
inIPs=split(inIP,".")
inIPnum=inips(0)*256*256*256 + inips(1)*256*256 + inips(2)*256 + inips(3)
Sql="Select * from WWW_QQCF_COM_Cfwztg_IpAddress where startip<="&inIPnum&" and endip>="&inIPnum
set RsIp=connIP.Execute(Sql)
If Not RsIp.Eof Then
GetIpArea= RsIp("Country")
If RsIp("City")<>"" Then GetIpArea=GetIpArea& "-"&RsIp("City")
Else
GetIpArea= "-"
End If
RsIp.Close
End Function
FunCtion ReturnFlag(User_Name,Ad_ID,Ad_Url,MyFlag)
If MyFlag=0 Then
ShowText="<br>欢迎加入<a href="&Tmp&"Index.asp target=_blank>"&RsSet("Title")&"</a>"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=1 Then
ShowText="<br>广告不存在或者已经被删除"
ShowText=ShowText&"<br>正在为你转到推广系统首页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"Index.asp'>"
ElseIf MyFlag=2 Then
ShowText="<br>广告点数已经投放完毕"
ShowText=ShowText&"<br>正在为你转到推广系统首页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"Index.asp'>"
ElseIf MyFlag=3 Then
ShowText="<br>用户账号不存在"
ShowText=ShowText&"<br>正在为你转到推广系统首页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"Index.asp'>"
ElseIf MyFlag=4 Then
ShowText="<br>用户账号被禁用"
ShowText=ShowText&"<br>正在为你转到推广系统首页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"Index.asp'>"
ElseIf MyFlag=5 Then
ShowText="<br>只有站长能申请时没有来源地址"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=6 Then
ShowText="<br>点击率过高"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=7 Then
ShowText="<br>发布在页面上时，点击没有来源"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=8 Then
ShowText="<br>在没有经过管理员审核的系统允许的网站上发布广告"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=9 Then
ShowText="<br>在没有经过管理员审核的用户的网站上发布广告"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=10 Then
ShowText="<br>验证码错误"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=11 Then
ShowText="<br>IP验证错误"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=12 Then
ShowText="<br>时间验证错误"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=13 Then
ShowText="<br>此电脑已经点击过"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=14 Then
ShowText="<br>此IP已经点击过"
ShowText=ShowText&"<br>正在为你转到推广系统首页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=15 Then
ShowText="<br>广告扣点"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=16 Then
ShowText="<br>用户扣点"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
ElseIf MyFlag=17 Then
ShowText="<br>其它错误"
ShowText=ShowText&"<br>正在为你转到广告页，请等待三秒钟<META HTTP-EQUIV='Refresh' CONTENT='3;URL="&Ad_Url&"'>"
End If
If RsSet("ShowClickInfo")=-1 Then
Response.Write ShowText
Else
If MyFlag=1 Or MyFlag=2 Or MyFlag=3 Or MyFlag=4 Then
Response.Write "<META HTTP-EQUIV='Refresh' CONTENT='0;URL="&Tmp&"Index.asp'>"
Else
Response.Write "<META HTTP-EQUIV='Refresh' CONTENT='0;URL="&Ad_Url&"'>"
End If
End If
Call ConnClose()
Response.End
End FunCtion
Function connclose()
Conn.Close
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(RsAd)=True Then
RsAd.Close
Set RsAd=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
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -