发新话题
打印

静态页面插入TLA代码的方法

本主题由 Gump 于 2008-3-22 15:28 移动
你又被热心了?

你不知道为什么会被列为热心观众?请先看看论坛发帖规则!

http://www.adjie.com ...

静态页面插入TLA代码的方法

大部分代码还是来自TLA,我只是补充了一下,让它能在静态页面上生效而已。
不提倡什么版权不版权的了,需要的拿过去用吧,但需要的是参数改一下。

1、local_93558.xml,这个文件不知道是不是所有的帐号是否一致,若不同就改下,14行。
2、被调用的静态文件存储成了tla.htm,根据需要改一下,117行。
3、这个代码默认是存储到根目录下,文件名为tla.asp,若不喜欢则修改一下路径,第115行。
4、调用方法: <!--#include virtual="/tla.htm" --> ,若你的是虚拟主机,可能不支持SSI引用,自己想一想解决方法,或者你可以把下面的输出部分的代码改成js输出,然后用<script src="/tla.asp"></script>方式插入进来,至于会不会被TLA允许,这个我就不清楚了。

设置方式比较烦琐,不太喜欢这种设置方法,那就别看下去了。
复制内容到剪贴板
代码:
<%@ Language=VBScript %>
<%
' Local file to store XML
' You must create a blank file named "local_93558.xml" in the same
' directory as this script. It MUST be writable by the web
' server. On unix you would CHMOD 666 the file. On Windows
' you will need to access your custom control panel to set
' the permissions or contact your hosting company.

Const ForReading = 1, ForWriting = 2

Dim LOCAL_XML_FILENAME, sourceFile, FSO

LOCAL_XML_FILENAME = server.MapPath("local_93558.xml")
sourceFile = "http://www.text-link-ads.com/xml.php?inventory_key=KVS2ZE0NSH8E0EU1U5OH&referer=" & Server.UrlEncode(Request.ServerVariables("HTTP_REFERER")) & "&user_agent=" & Server.UrlEncode(Request.ServerVariables("HTTP_USER_AGENT"))
Set FSO = server.createObject("Scripting.FileSystemObject")

' update local XML
Dim DateMod, MonthString, DayString, DateModFile, DateModLimit

DateMod = FSO.getFile(LOCAL_XML_FILENAME).DateLastModified

MonthString = Month(DateMod)
If (MonthString < 10) Then
        MonthString = "0" & MonthString
End If

DayString = Day(DateMod)
If (DayString < 10) Then
        DayString = "0" & DayString
End If

DateModFile = Year(DateMod) & "-" & MonthString & "-" & DayString & " " & Hour(DateMod) & ":" & Minute(DateMod) & ":" & Second(DateMod)

MonthString = Month(Date)
If (MonthString < 10) Then
        MonthString = "0" & MonthString
End If

DayString = Day(Date)
If (DayString < 10) Then
        DayString = "0" & DayString
End If

DateModLimit = Year(Date) & "-" & MonthString & "-" & DayString & " " & (Hour(Now)-1) & ":" & Minute(Now) & ":" & Second(Now)

Dim Contents, Result, xmlhttp, TextStream

' read local XML
Contents = ""
Set TextStream = FSO.OpenTextFile(LOCAL_XML_FILENAME, ForReading, False, -2)
Do While Not TextStream.AtEndOfStream
        Contents = Contents & TextStream.ReadLine
Loop
TextStream.Close
Set TextStream = nothing

If (DateModFile < DateModLimit Or FSO.getFile(LOCAL_XML_FILENAME).size < 20) Then
        ' fetch remote XML
        Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
        xmlhttp.open "GET", sourceFile, False
        xmlhttp.send ""
        Result = xmlhttp.responseText
        If (Result <> "") Then
                Contents = Result
        End If

        ' write new XML to local file
        Set TextStream = FSO.OpenTextFile(LOCAL_XML_FILENAME, ForWriting, True)
        TextStream.Write Contents
        TextStream.Close
        Set TextStream = nothing
End If

' parse local XML
Dim source
Set source = Server.CreateObject("Microsoft.XMLDOM")
source.async = false
source.loadXML(Contents)

' Output links
Dim objLst, i, numLinks, objLink, objLinkChildren, linkNode, URL, Text, BeforeText, AfterText

Set objLst = source.getElementsByTagName("Link")
numLinks = objLst.length - 1

Dim outhtm

outhtm="<ul>"
For i = 0 To numLinks
        Set objLink = objLst.item(i)
        Set objLinkChildren = objLink.childNodes
        URL = ""
        Text = ""
        BeforeText = ""
        AfterText = ""

        For Each linkNode In objLinkChildren
                If linkNode.nodeName = "URL" Then
                        URL = linkNode.text
                End If
                If linkNode.nodeName = "Text" Then
                        Text = linkNode.text
                End If
                If linkNode.nodeName = "BeforeText" Then
                        BeforeText = linkNode.text
                End If
                If linkNode.nodeName = "AfterText" Then
                        AfterText = linkNode.text
                End If
        Next

        outhtm=outhtm&"<li>" & BeforeText & "<a href=""" & URL & """>" & Text & "</a>" & AfterText & "</li>"
Next
outhtm=outhtm&"</ul><script src=""/tla.asp""></script>"

savetofile "tla.htm",outhtm


'savetofile  *** Copyright &copy KingCMS.com All Rights Reserved. ***
public sub savetofile(l1,l2)'地址,内容
        dim l3
        on error resume next
        set l3=server.createobject("ADODB.Stream")
       
        with l3
                .type=2
                .open
                .charset="UTF-8"
                .position=l3.Size
                .writetext=l2
                .savetofile server.mappath(l1),2
                .close
        end with
        set l3=nothing
        if err.number<>0 then
                err.clear
        end if
end sub


%>

顶部

免费投放广告

只要在论坛控制面板设置自己的广告就可以显示在这里,完全免费,现在就开始吧

如果可行的话那么这个方法可以使用到所有的模板化的程序,比如discuz。

另外xml文件的名称每个帐号都不一样。

顶部

想问一下,对于asp的程序,要把TLA放在全部的页面上。是不是只在把代码放在相应位置,然后在根目录下传一个local_×××××.xml文件就好了?

顶部

如果是加入到asp页面的话,直接include方式插入TLA提供的代码即可。
直接创建一个空的xml文档。

顶部

发新话题