📄 advertise.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="Conn.asp"-->
<!--#include file="SysCls/KS_CommonCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 0628 Free
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New Advertise
KSCls.Execute()
Set KSCls = Nothing
Class Advertise
Private KSCMS
Private getplace,getshow,adsrs,adssql,adsrsp,adssqlp,adsrss,adssqls,getip,getggwlxsz,getggwhei,getggwwid
Private ttarg,DomainStr,GaoAndKuan
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConn()
Set KSCMS=Nothing
End Sub
Sub Execute()
DomainStr=KSCMS.GetDomain
getplace=KSCMS.ChkClng(KSCMS.G("i"))
dim GaoAndKuan
Dim adsrs1:Set adsrs1=server.createobject("adodb.recordset")
adsrs1.open "select * From KS_ADPlace where show_flag=1 and place="&getplace,Conn,1,1
if not adsrs1.eof then
getggwlxsz=adsrs1(2)
else
getggwlxsz=0
end if
getggwhei=adsrs1(3)
getggwwid=adsrs1(4)
GaoAndKuan=""
if getggwhei<>"" then GaoAndKuan=" height="&getggwhei&" "
if getggwwid<>"" then GaoAndKuan=GaoAndKuan&" width="&getggwwid&" "
adsrs1.close
Set adsrs1=nothing
''''''''''''''''''''''''''''''''每次显示广告位前，检测其中的各广告条是否过期，并更新状态''''''''''''''''''''''''''''''''
set adsrsp=server.createobject("adodb.recordset")
adssqlp="Select * from KS_Advertise where act=1 and class <> 0 and place="&getplace&" order by time"
adsrsp.open adssqlp,Conn,1,3
while not adsrsp.eof
advertvirtualvalue=0
if adsrsp("class")=1 then
if adsrsp("click")>=adsrsp("clicks") then
advertvirtualvalue=1
end if
elseif adsrsp("class")=2 then
if adsrsp("show")>=adsrsp("shows") then
advertvirtualvalue=1
end if
elseif adsrsp("class")=3 then
if now()>=adsrsp("lasttime") then
advertvirtualvalue=1
end if
elseif adsrsp("class")=4 then
if adsrsp("click")>=adsrsp("clicks") then
advertvirtualvalue=1
end if
if adsrsp("show")>=adsrsp("shows") then
advertvirtualvalue=1
end if
elseif adsrsp("class")=5 then
if adsrsp("click")>=adsrsp("clicks") then
advertvirtualvalue=1
end if
if now()>=adsrsp("lasttime") then
advertvirtualvalue=1
end if
elseif adsrsp("class")=6 then
if adsrsp("show")>=adsrsp("shows") then
advertvirtualvalue=1
end if
if now()>=adsrsp("lasttime") then
advertvirtualvalue=1
end if
elseif adsrsp("class")=7 then
if adsrsp("click")>=adsrsp("clicks") then
advertvirtualvalue=1
end if
if adsrsp("show")>=adsrsp("shows") then
advertvirtualvalue=1
end if
if now()>=adsrsp("lasttime") then
advertvirtualvalue=1
end if
end if
if advertvirtualvalue>=1 then
adsrsp("act")=2
adsrsp.update
end if
adsrsp.movenext
wend
adsrsp.close
set adsrsp=nothing
'''''''''''''''''''''''''''''''''''''''''''''''结束 检测、更新''''''''''''''''''''''''''''''''
set adsrs=server.createobject("adodb.recordset")
set adsrs1=server.createobject("adodb.recordset")
adsrs1.open "select * From KS_ADPlace where place="&getplace,Conn,1,1
''''''''''''''''''''''''''''''''''''''''根据显示方式的不同进行显示''''''''''''''''''''''''
Select Case getggwlxsz
Case 1
adssql="Select top 1 id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
Call DggtXs()
adsrs.close
Case 2
adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
do while not adsrs.eof
Call DggtXs()
adsrs.movenext
Response.Write "document.write('<br>');"
loop
adsrs.close
Case 3
adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
do while not adsrs.eof
Call DggtXs()
adsrs.movenext
Response.Write "document.write(' ');"
loop
adsrs.close
Case 4
adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
Response.Write "document.write('<marquee direction=up"&GaoAndKuan&">');"
do while not adsrs.eof
Call DggtXs()
adsrs.movenext
Response.Write "document.write('<br><br>'); "
loop
Response.Write "document.write('</marquee>');"
adsrs.close
Case 5
adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
Response.Write "document.write('<marquee"&GaoAndKuan&">');"
do while not adsrs.eof
Call DggtXs()
adsrs.movenext
Response.Write "document.write(' ');"
loop
Response.Write "document.write('</marquee>');"
adsrs.close
Case 6
adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
do while not adsrs.eof
call gaokuan()
Response.Write "window.open('"&DomainStr&"/AdOpen.asp?i="&adsrs("id")&"','" & KSCMS.GetConfig("WebName") & "-广告服务"&adsrs("id")&"','"&GaoAndKuan&"');"
adsrs.movenext
loop
adsrs.close
Case 7
adssql="Select top 1 id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
adsrs.open adssql,Conn,1,3
call gaokuan()
Response.Write "window.open('"&DomainStr&"/AdOpen.asp?i="&adsrs("id")&"','" & KSCMS.GetConfig("WebName") & "-广告服务','"&GaoAndKuan&"');"
adsrs.close
End Select
set adsrs=nothing
Conn.close
set Conn=nothing
End Sub
''''''''''''''''''''''''''''显示单个广告条 ''''''''''''''''''''''''''''''''''''''''''''''
Sub DggtXs()
adsrs("show")=adsrs("show")+1
adsrs("time")=now()
adsrs.Update
if adsrs("window")=0 then
ttarg = "_blank"
else
ttarg="_top"
end if
if isnumeric(adsrs("hei")) then
GaoAndKuan=" height="&adsrs("hei")&" "
else
if right(adsrs("hei"),1)="%" then
if isnumeric(Left(len(adsrs("hei"))-1))=true then
GaoAndKuan=" height="&adsrs("hei")&" "
end if
end if
end if
if isnumeric(adsrs("wid")) then
GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
else
if right(adsrs("wid"),1)="%" then
if isnumeric(Left(len(adsrs("wid"))-1))=true then
GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
end if
end if
end if
Select Case adsrs("xslei")
Case "txt"%>document.write('<a title=\"<%=adsrs("sitename")%>\" href=\"<%=DomainStr%>Adurl.asp?id=<%=adsrs("id")%>\" target=\"<%=ttarg%>\"><%=UBBCode(adsrs("intro"))%></a>');
<% Case "gif"%>document.write('<a href=\"<%=DomainStr%>Adurl.asp?id=<%=adsrs("id")%>\" target=\"<%=ttarg%>\"><img art=\"<%=adsrs("sitename")%>\" border=0 <%=GaoAndKuan%> src="<%=adsrs("gif_url")%>"></a>');
<% Case "swf"%>document.write('<EMBED src=<%=adsrs("gif_url")%> <%=GaoAndKuan%> quality=high TYPE=\"application/x-shockwave-flash\"></EMBED>');
<% Case "dai"%>document.write('<iframe marginwidth=0 marginheight=0 frameborder=0 bordercolor=000000 scrolling=no name=\"轩溪小居广告\" src=\"<%=DomainStr%>daima.asp?id=<%=adsrs("id")%>\" <%=GaoAndKuan%> ></iframe>');
<% Case else%>document.write('<a href=\"<%=DomainStr%>Adurl.asp?id=<%=adsrs("id")%>\" target=\"<%=ttarg%>\"><img art=\"<%=adsrs("sitename")%>\" border=0 <%=GaoAndKuan%> src="<%=adsrs("gif_url")%>"></a>');
<%End Select
getip=request.ServerVariables("REMOTE_ADDR")
set adsrss=server.createobject("adodb.recordset")
adssqls="select * from KS_Adiplist"
adsrss.open adssqls,Conn,1,3
adsrss.AddNew
adsrss("adid") =adsrs("id")
adsrss("time") = now()
adsrss("ip") = getip
adsrss("class") = 1
adsrss.update
adsrss.close
set adsrss=nothing
End Sub
Sub gaokuan()
adsrs("show")=adsrs("show")+1
adsrs("time")=now()
adsrs.Update
if adsrs("window")=0 then
ttarg = "_blank"
else
ttarg="_top"
end if
if adsrs("hei")<>"" then
if isnumeric(adsrs("hei")) then
GaoAndKuan=" height="&adsrs("hei")&" "
else
if right(adsrs("hei"),1)="%" then
if isnumeric(Left(len(adsrs("hei"))-1))=true then
GaoAndKuan=" height="&adsrs("hei")&" "
end if
end if
end if
if isnumeric(adsrs("wid")) then
GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
else
if right(adsrs("wid"),1)="%" then
if isnumeric(Left(len(adsrs("wid"))-1))=true then
GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
end if
end if
end if
else
end if
End Sub
function UBBCode(strContent)
on error resume next
strContent = KSCMS.HTMLEncode(strContent)
dim objRegExp
Set objRegExp=new RegExp
objRegExp.IgnoreCase =true
objRegExp.Global=True
objRegExp.Pattern="(\[color=(.*)\])(.*)(\[\/color\])"
strContent=objRegExp.Replace(strContent,"<font color=$2>$3</font>")
objRegExp.Pattern="(\[face=(.*)\])(.*)(\[\/face\])"
strContent=objRegExp.Replace(strContent,"<font face=$2>$3</font>")
objRegExp.Pattern="(\[align=(.*)\])(.*)(\[\/align\])"
strContent=objRegExp.Replace(strContent,"<div align=$2>$3</div>")
objRegExp.Pattern="(\[QUOTE\])(.*)(\[\/QUOTE\])"
strContent=objRegExp.Replace(strContent,"<BLOCKQUOTE><font size=1 face=""Verdana, Arial"">quote:</font><HR>$2<HR></BLOCKQUOTE>")
objRegExp.Pattern="(\[i\])(.*)(\[\/i\])"
strContent=objRegExp.Replace(strContent,"<i>$2</i>")
objRegExp.Pattern="(\[u\])(.*)(\[\/u\])"
strContent=objRegExp.Replace(strContent,"<u>$2</u>")
objRegExp.Pattern="(\[b\])(.*)(\[\/b\])"
strContent=objRegExp.Replace(strContent,"<b>$2</b>")
objRegExp.Pattern="(\[size=1\])(.*)(\[\/size\])"
strContent=objRegExp.Replace(strContent,"<font size=1>$2</font>")
objRegExp.Pattern="(\[size=2\])(.*)(\[\/size\])"
strContent=objRegExp.Replace(strContent,"<font size=2>$2</font>")
objRegExp.Pattern="(\[size=3\])(.*)(\[\/size\])"
strContent=objRegExp.Replace(strContent,"<font size=3>$2</font>")
objRegExp.Pattern="(\[size=4\])(.*)(\[\/size\])"
strContent=objRegExp.Replace(strContent,"<font size=4>$2</font>")
strContent = doCode(strContent, "[list]", "[/list]", "<ul>", "</ul>")
strContent = doCode(strContent, "[list=1]", "[/list]", "<ol type=1>", "</ol id=1>")
strContent = doCode(strContent, "[list=a]", "[/list]", "<ol type=a>", "</ol id=a>")
strContent = doCode(strContent, "[*]", "[/*]", "<li>", "</li>")
strContent = doCode(strContent, "[code]", "[/code]", "<pre id=code><font size=1 face=""Verdana, Arial"" id=code>", "</font id=code></pre id=code>")
set objRegExp=Nothing
UBBCode=strContent
end function
End Class
%> ⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -