<%
'此程序使用之前必须先在www.123pr.net注册过以后才能使用
'注册完成以后您将获得您的用户名和密码,如果您的密码变动,请将配置里的密码也随之改动
'安装此程序的目录属性必须是“可写”的,linux用户可将目录属性修改为777
'定义变量
dim pr_tier,pr_username,pr_password,pr_the_host,pr_hello_username,pr_hello_order,pr_hello_password,pr_content,pr_filename
dim pr_fsObj,pr_fileObj,pr_data1,pr_num,pr_i,pr_data2,pr_data3,pr_homepagelink,pr_homepagename
'配置开始
pr_tier=8 '这里填写的是显示的列数,默认为8列
pr_username="tobytao" '#请填写好您的用户名
pr_password="68631412" ' #请填写好您的密码
pr_the_host="http://www.123pr.net" '这行不要改动
'配置结束
' 您可以对里面的标题进行编辑,换成您自己的标题。
' 链接显示是一张宽度为100%的表格,以一段asp代码形式编写的,您可以设置
' “列数”;这段代码的位置在之前,您可以对这段代码加入
' 到美工设计当中,但是请不要随意动之前的这段asp代码。
' 我们强烈建议你,如果你的首页是asp的话,把此代码拷贝到首页里面,这样
' 的话,PR的增长效果更加的高。如果不知道如何做,可以来我们的首页上面。
' 一些热心的在线客服人员会免费为你提供帮助。我们的地址是www.123pr.net
'asp远程读取网页源代码的函数
Function pr_GetURL(URL)
Set http=Server.CreateObject("Microsoft.XMLHTTP")
On Error Resume Next
http.Open "GET",URL,False
http.send()
if Err then
Err.Clear
Response.Write("没有找到网页!")
Response.End()
End if
getHTTPPage=pr_BytesToBstr(Http.responseBody,"gb2312")
set http=nothing
pr_GetURL=getHTTPPage
End Function
'转换编码的函数
Function pr_BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
pr_BytesToBstr = objstream.ReadText
objstream.SaveToFile Server.MapPath("123pr.xml"),2
objstream.Close
set objstream = nothing
End Function
'删除文件的函数
function pr_delbackdb(delfile)
on error resume next
dim obj_fso,backdbpath
backdbpath=server.mappath(delfile)
set obj_fso=server.createobject("scripting.filesystemobject")
obj_fso.deletefile backdbpath,true
set obj_fso=nothing
if err.number<>0 then
pr_delbackdb=delfile&"文件删除失败,只有请管理员手动删除了"
else
pr_delbackdb="文件已删除,"
end if
end function
'判断文件是否存在的函数
function pr_isexists(delfile)
on error resume next
dim obj_fso,backdbpath
backdbpath=server.mappath(delfile)
set obj_fso=server.createobject("scripting.filesystemobject")
if obj_fso.fileexists(backdbpath) then
pr_isexists=true
else
pr_isexists=false
end if
end function
'配置及定义函数已完成'
'处理传入的变量
pr_hello_username=request("hello_username")
pr_hello_order=request("hello_order")
pr_hello_password=request("hello_password")
'与服务器进行握手的程序
if pr_hello_username=pr_username and pr_hello_password=pr_password then
select case pr_hello_order
case "update"'当远程命令是UPDATE的时候,就更新远程的数据库
pr_content=pr_GetURL(pr_the_host&"/xml.php?username="&pr_username)'调用读取网页文件并保存方法
response.Write "pr update is ok pr"
case "delete"'当远程命令是DELETE的时候,删除XML文件
pr_filename="123pr.xml"
pr_delbackdb(pr_filename)
response.write"pr delete is ok pr "
case "test"'当远程命令是TEST的时候,尝试建立XML文件
pr_content=pr_GetURL(pr_the_host&"/xml.php?username="&pr_username)'调用读取网页文件并保存方法
response.Write "pr test is ok pr"
end select
end if
' 程序的上半段已经完成,如果你要将代码移植到你现有的首页上去。
' 则将上半段asp代码放到您首页代码的以前的位置。然后请将
' 下半段“显示链接”的代码直接拷贝到您要做链接的位置上面。
%>
<%
' 这是下半段的代码,这个代码的功能是将交换的链接显示出来。
' 显示的形式是一个长度100%的表格,按照每行N个链接排列的方
' 式显示。如果你要将这段代码放到你要的位置,请务用DREAME画
' 一个固定长度的表格,然后将这段PHP代码放到表格里面,这样的
' 话显示的链接就固定了。您可以通过“配置”调节每行链接数量
'阅读XML中链接数据的程序并显示数据
set pr_fsObj = CreateObject("Scripting.FileSystemObject")
If pr_fsObj.FileExists(Server.MapPath("123pr.xml")) Then
if pr_hello_order<>"delete" then
set pr_fileObj = pr_fsObj.OpenTextFile(server.mappath("123pr.xml"),1,false)
do while not pr_fileObj.AtEndOfStream
pr_content=pr_content&server.htmlencode(pr_fileObj.readline)&" "
loop
pr_fileObj.Close
set pr_fileObj = NOTHING
set pr_fsObj = NOTHING
pr_content=replace(pr_content,"<","abcdefggfedcba")'将文档中的<替换为一字符串
pr_content=replace(pr_content,">","ihgfedcbaabcdefghi")'将文档中的>替换为一字符串
pr_data1=split(pr_content,"abcdefggfedcbaitemihgfedcbaabcdefghi")
pr_num=ubound(pr_data1)
if pr_tier<=0 then'如果配置的列数小于等于0,那么列数为8
pr_tier=8
end if
pr_i=1
response.Write ""
response.Write ""
do while pr_i<=pr_num
pr_data2=split(pr_data1(pr_i),"abcdefggfedcba/titleihgfedcbaabcdefghi")
pr_data2(0)=replace(pr_data2(0),"abcdefggfedcbatitleihgfedcbaabcdefghi","")
pr_data2(0)=replace(pr_data2(0),"]]ihgfedcbaabcdefghi","")
pr_data2(0)=replace(pr_data2(0),"abcdefggfedcba![CDATA[","")
pr_data2(1)=replace(pr_data2(1),"abcdefggfedcbalinkihgfedcbaabcdefghi","")
pr_data3=split(pr_data2(1),"abcdefggfedcba/linkihgfedcbaabcdefghi")
pr_homepagelink=replace(pr_data3(0)," ","")
pr_homepagename=pr_data2(0)
pr_homepagename=replace(pr_homepagename," ","")
response.Write ""&pr_homepagename&" | "
if pr_i mod pr_tier=0 then
response.Write" "
end if
pr_i=pr_i+1
loop
response.Write" "
end if
else
set pr_fsObj = NOTHING
response.Write "XML文件不存在,或者目录属性没有设置成“可写”"
end if
%>
|