📄 cls_ads.asp
字号:
set MyFile=nothing
DriftBoxObj.close
Set DriftBoxObj = Nothing
End Sub
Sub LeftBottom(TempLocation)
dim LeftBottomStr,LeftBottomLocation,LeftBottomObj
LeftBottomLocation = clng(TempLocation)
AdsTempPicStr(LeftBottomLocation)
LeftBottomStr = AdsTempStr
Set LeftBottomObj = Conn.Execute("select * from FS_AD_Info where AdID="&LeftBottomLocation&"")
if CheckAd(LeftBottomObj)=False then
AdsJSStr = "document.write('此广告已经暂停或是失效');"
else
AdsJSStr = "if (navigator.appName == 'Netscape')" & vbCrLf & _
"{document.write('<layer id=LeftBottom top=150 width="& LeftBottomObj("AdPicWidth") &" height="& LeftBottomObj("AdPicHeight") &">"& LeftBottomStr &"</layer>');}" & vbCrLf & _
"else{document.write('<div id=LeftBottom style=""position: absolute;width:"& LeftBottomObj("AdPicWidth") &";height:"& LeftBottomObj("AdPicHeight") &";visibility: visible;z-index: 1"">"& LeftBottomStr &"</div>');}" & vbCrLf & _
"document.write('<script language=javascript src=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/CreateJs/LeftBottom.js></script>');" & vbCrLf & _
"document.write('<script src=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/show.asp?Location="&LeftBottomLocation&"></script>');"
end if
Set MyFile=Server.CreateObject(G_FS_FSO)
If MyFile.FolderExists(Server.MapPath(Str_SysDir)) = false then
MyFile.CreateFolder(Server.MapPath(Str_SysDir))
End If
if MyFile.FileExists(Server.MapPath(Str_SysDir)&"/"& LeftBottomLocation &".js") then
MyFile.DeleteFile(Server.MapPath(Str_SysDir)&"/"& LeftBottomLocation &".js")
end if
set CrHNJS=MyFile.CreateTextFile(Server.MapPath(Str_SysDir)&"/"& LeftBottomLocation &".js")
CrHNJS.write AdsJSStr
set MyFile=nothing
LeftBottomObj.close
Set LeftBottomObj = Nothing
End Sub
Sub Couplet(TempLocation)
dim CoupletLeftStr,CoupletLocation,CoupletRightStr,CoupletObj
CoupletLocation = clng(TempLocation)
AdsTempPicStr(CoupletLocation)
CoupletLeftStr = AdsTempStr
CoupletRightStr = AdsTempStrRight
Set CoupletObj = Conn.Execute("select * from FS_Ad_Info where AdID="&CoupletLocation&"")
if CheckAd(CoupletObj)=False then
AdsJSStr = "document.write('此广告已经暂停或是失效');"
else
AdsJSStr = "function winload()" & vbCrLf & _
"{" & vbCrLf & _
"AdsLayerLeft.style.top=20;" & vbCrLf & _
"AdsLayerLeft.style.left=5;" & vbCrLf & _
"AdsLayerRight.style.top=20;" & vbCrLf & _
"AdsLayerRight.style.right=5;" & vbCrLf & _
"}" & vbCrLf & _
"if(screen.availWidth>800){" & vbCrLf & _
"{" & vbCrLf & _
"document.write('<div id=AdsLayerLeft style=""position: absolute;visibility:visible;z-index:1""><table border=0 cellspacing=0 cellpadding=0><tr><td>" & CoupletLeftStr & "</td></tr><tr><td height=""20"" align=""left"" valign=""middle""><span onclick=""Javascript:$(\'AdsLayerLeft\').style.display=\'none\';$(\'AdsLayerRight\').style.display=\'none\';"" style=""cursor:pointer;"">×关闭</span></td></tr></table></div>'" & vbCrLf & _
"+'<div id=AdsLayerRight style=""position: absolute;visibility:visible;z-index:1""><table border=0 cellspacing=0 cellpadding=0><tr><td>" & CoupletRightStr & "</td></tr><tr><td height=""20"" align=""right"" valign=""middle""><span onclick=""Javascript:$(\'AdsLayerLeft\').style.display=\'none\';$(\'AdsLayerRight\').style.display=\'none\';"" style=""cursor:pointer;"">×关闭</span></td></tr></table></div>');" & vbCrLf & _
"}" & vbCrLf & _
"document.write('<script language=javascript src=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/CreateJs/Couplet.js></script>');" & vbCrLf & _
"winload()" & vbCrLf & _
"}" & vbCrLf & _
"document.write('<script src=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/show.asp?Location="&CoupletLocation&"></script>');"
end if
Set MyFile=Server.CreateObject(G_FS_FSO)
If MyFile.FolderExists(Server.MapPath(Str_SysDir)) = false then
MyFile.CreateFolder(Server.MapPath(Str_SysDir))
End If
if MyFile.FileExists(Server.MapPath(Str_SysDir)&"/"& CoupletLocation &".js") then
MyFile.DeleteFile(Server.MapPath(Str_SysDir)&"/"& CoupletLocation &".js")
end if
set CrHNJS=MyFile.CreateTextFile(Server.MapPath(Str_SysDir)&"/"& CoupletLocation &".js")
CrHNJS.write AdsJSStr
set MyFile=nothing
CoupletObj.close
Set CoupletObj = Nothing
End Sub
Sub AdTxt(AdID)
Dim str_AdTxt,o_AdTxtRs,int_AdID,int_TxtAdID_i,o_AdTxtAdRs,o_Crtxt
int_AdID=Clng(AdID)
Set o_AdTxtAdRs=Conn.execute("Select * from FS_Ad_Info where AdID="&int_AdID&"")
If CheckAd(o_AdTxtAdRs)=False Then
str_AdTxt="document.write('此广告已经暂停或是失效');"
Else
Set o_AdTxtRs=Conn.execute("select * from FS_AD_TxtInfo where AdID="&int_AdID&"")
str_AdTxt="document.write('<script language=""javascript"" src=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/show.asp?Location="&int_AdID&"></script>');"
If o_AdTxtAdRs("AdTxtColNum")<>"" and o_AdTxtAdRs("AdTxtColNum")>0 Then
int_TxtAdID_i=0
str_AdTxt=str_AdTxt&"document.write('<table border=0>"
str_AdTxt=str_AdTxt&"<tr>"
Do While Not o_AdTxtRs.Eof And int_TxtAdID_i<Cint(o_AdTxtAdRs("AdTxtColNum"))
str_AdTxt=str_AdTxt&"<td><a href=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/AdsClick.asp?AdTxtID="&o_AdTxtRs("Ad_TxtID")&" class="&o_AdTxtRs("Css")&">"&o_AdTxtRs("AdTxtContent")&"</a></td>"
o_AdTxtRs.MoveNext
int_TxtAdID_i=int_TxtAdID_i+1
If int_TxtAdID_i = Cint(o_AdTxtAdRs("AdTxtColNum")) then
int_TxtAdID_i = 0
str_AdTxt=str_AdTxt&"</tr><tr>"
End If
Loop
str_AdTxt=str_AdTxt&"</table>');"
Else
str_AdTxt=str_AdTxt&"document.write('<table border=0>"
While Not o_AdTxtRs.Eof
str_AdTxt=str_AdTxt&"<tr>"
str_AdTxt=str_AdTxt&"<td><a href=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/AdsClick.asp?AdTxtID="&o_AdTxtRs("Ad_TxtID")&" class="&o_AdTxtRs("Css")&">"&o_AdTxtRs("AdTxtContent")&"</a></td>"
str_AdTxt=str_AdTxt&"</tr>"
o_AdTxtRs.MoveNext
Wend
str_AdTxt=str_AdTxt&"</table>');"
End If
Set MyFile=Server.CreateObject(G_FS_FSO)
If MyFile.FolderExists(Server.MapPath(Str_SysDir)) = false then
MyFile.CreateFolder(Server.MapPath(Str_SysDir))
End If
If MyFile.FileExists(Server.MapPath(Str_SysDir)&"/"& RightBottomLocation &".js") Then
MyFile.DeleteFile(Server.MapPath(Str_SysDir)&"/"& RightBottomLocation &".js")
End if
Set o_Crtxt=MyFile.CreateTextFile(Server.MapPath(Str_SysDir)&"/"& int_AdID &".js")
o_Crtxt.write str_AdTxt
Set MyFile=Nothing
Set o_AdTxtRs=Nothing
Set o_AdTxtAdRs=Nothing
End If
End Sub
Sub Cycle(ALocation,TempLocation)
dim CycleSelfObj,CycleSelfLocation,CycleLocation,CycleObj,JsFileName,CycleStr
CycleSelfLocation = clng(ALocation)
CycleLocation = clng(TempLocation)
Set CycleSelfObj = Conn.Execute("select * from FS_Ad_Info where AdID="&CycleSelfLocation&"")'自身查询
If Not CycleSelfObj.Eof Then
If Cint(CycleSelfObj("AdLoop")) = 1 then '所有循环广告
If CycleSelfObj("AdLoopAdID")<>0 then '所有被添加到循环广告的非循环广告
Set CycleObj = Conn.Execute("select * from FS_Ad_Info where AdLock=0 and AdID="&CycleLocation&"")
If Not CycleObj.Eof THen
CycleStr="<a href=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/AdsClick.asp?Location="& CycleObj("AdID") &" title="""&CycleObj("AdCaptionTxt")&""" target=_blank><img src="& CycleObj("AdPicPath")&" width="""&CycleSelfObj("AdPicWidth")&""" height="""&CycleSelfObj("AdPicHeight")&""" border=""0""></a>"
End If
Set CycleObj=Nothing
End if
End if
Dim str_LoopFollow
if isnull(CycleSelfObj("AdLoopFollow")) or not isnumeric(CycleSelfObj("AdLoopFollow")) then
str_LoopFollow="up"
else
Select Case Cint(CycleSelfObj("AdLoopFollow"))
Case 0
str_LoopFollow="up"
Case 1
str_LoopFollow="down"
Case 2
str_LoopFollow="left"
Case 3
str_LoopFollow="right"
End Select
end if
AdsJSStr = "document.write('<marquee onmouseout=start() onmouseover=stop() width="&CycleSelfObj("AdPicWidth")&" height="&CycleSelfObj("AdPicHeight")&" direction="&str_LoopFollow&" scrollamount="&CycleSelfObj("AdLoopSpeed")&">"
If Instr(1,LCase(CycleSelfObj("AdPicPath")),"http://") <> 0 then
AdsJSStr = AdsJSStr & " <a href=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/AdsClick.asp?Location="& CycleSelfObj("AdID") &" title="""&CycleSelfObj("AdCaptionTxt")&""" target=_blank><img src="& CycleSelfObj("AdPicPath")&" width="""&CycleSelfObj("AdPicWidth")&""" height="""&CycleSelfObj("AdPicHeight")&""" border=""0""></a>"&CycleStr
Else
AdsJSStr = AdsJSStr & " <a href=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")&"/Ads/AdsClick.asp?Location="& CycleSelfObj("AdID") &" title="""&CycleSelfObj("AdCaptionTxt")&""" target=_blank><img src=http://"&request.Cookies("FoosunMFCookies")("FoosunMFDomain")& CycleSelfObj("AdPicPath")&" width="""&CycleSelfObj("AdPicWidth")&""" height="""&CycleSelfObj("AdPicHeight")&""" border=""0""></a>"&CycleStr
End If
CycleSelfObj.movenext
if not CycleSelfObj.eof then
if Cint(CycleSelfObj("AdLoopFollow")) = 0 or Cint(CycleSelfObj("AdLoopFollow")) = 1 then
AdsJSStr = AdsJSStr & "<br><br>"
else
AdsJSStr = AdsJSStr & " "
end if
end if
AdsJSStr = AdsJSStr & "</marquee>');"
if CheckAd(CycleSelfObj)=False then
AdsJSStr = "document.write('此广告已经暂停或是失效');"
end if
JsFileName = clng(CycleSelfLocation)
Set MyFile=Server.CreateObject(G_FS_FSO)
If MyFile.FolderExists(Server.MapPath(Str_SysDir)) = false then
MyFile.CreateFolder(Server.MapPath(Str_SysDir))
End If
if MyFile.FileExists(Server.MapPath(Str_SysDir)&"/"& JsFileName &".js") then
MyFile.DeleteFile(Server.MapPath(Str_SysDir)&"/"& JsFileName &".js")
end if
set CrHNJS=MyFile.CreateTextFile(Server.MapPath(Str_SysDir)&"/"& JsFileName &".js")
CrHNJS.write AdsJSStr
set MyFile=nothing
CycleSelfObj.close
End If
Set CycleSelfObj = Nothing
End Sub
Function CheckAd(obj)
If Not obj.Eof Then
If Cint(obj("AdLock"))=1 Then
CheckAd=False
Exit Function
End If
If Cint(obj("AdLoopFactor"))=1 Then
If CLng(obj("AdClickNum")) > CLng(obj("AdMaxClickNum")) or CLng(obj("AdShowNum")) > CLng(obj("AdMaxShowNum")) Then
CheckAd=False
Exit Function
End If
If Trim(obj("AdEndDate"))<>"" And not IsNull(obj("AdEndDate")) Then
If Cdate(obj("AdEndDate"))<Now() Then
CheckAd=False
Exit Function
End If
End If
Else
CheckAd=True
Exit Function
End If
Else
CheckAd=""
Exit Function
End If
CheckAd=True
End Function
'-------------生成广告JS结束----------------
'-----------------------------------------------------
Function UpdateAdsJsContent(AdsID)
Dim AdsObj,Ads_ID,Ads_Type,AdLoopAdID
Set AdsObj = Conn.ExeCute("Select AdID,AdType,AdLoopAdID From FS_AD_Info Where AdID = " & AdsID)
If Not(AdsObj.Bof And AdsObj.Eof) Then
Ads_ID = Clng(AdsObj(0))
Ads_Type = Cint(AdsObj(1))
AdLoopAdID = Clng(AdsObj(2))
Select Case Ads_Type
Case 0 call ShowAds(Ads_ID)
Case 1 call NewWindow(Ads_ID)
Case 2 call OpenWindow(Ads_ID)
Case 3 call FilterAway(Ads_ID)
Case 4 call DialogBox(Ads_ID)
Case 5 call ClarityBox(Ads_ID)
Case 6 call DriftBox(Ads_ID)
Case 7 call LeftBottom(Ads_ID)
Case 8 call RightBottom(Ads_ID)
Case 9 call Couplet(Ads_ID)
Case 10 call Cycle(Ads_ID,AdLoopAdID)
Case 11 call AdTxt(Ads_ID)
End Select
End If
AdsObj.CLose : Set AdsObj = Nothing
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -