📄 batch_add_ok.asp
字号:
<!--#include file="../setup.asp"-->
<!--#include file="login_admin.asp"-->
<%
'================================================================================
'Product:K-Search Version 2.1
'本“软件产品”受《中华人民共和国著作权法》和《中华人民共和国计算机软件保护条例》
'和国际条约的保护。如未经授权而擅自复制或传播本程序（或其中任何部分），将受到严厉
'的刑事及民事制裁，并将在法律许可的范围内受到最大可能的起诉！
'Homepage：http://www.lucoo.com/
'--------------------------------------------------------------------------------
'Copyright(c) 2005 lucoo.com All Rights Reserved 绿色互联 版权所有
'================================================================================
if session("rank")<>1 then
response.write "您的管理员级别不能操作！"
response.end
end if
%>
<!--#include file="conn.asp"-->
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<%
Server.ScriptTimeOut=9000
function filtration(str)
str=replace(str,chr(32),"")
str=replace(str,chr(34),"")
str=replace(str,chr(35),"")
str=replace(str,chr(37),"")
str=replace(str,chr(38),"")
str=replace(str,chr(39),"")
str=replace(str,chr(40),"")
str=replace(str,chr(41),"")
str=replace(str,chr(42),"")
str=replace(str,chr(43),"")
str=replace(str,chr(59),"")
str=replace(str,chr(60),"")
str=replace(str,chr(61),"")
str=replace(str,chr(62),"")
filtration=str
end Function
Function GetURL(url)
GetURL=""
Set Retrieval=Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "GET",url,False
.Send
GetURL=bytes2bstr(.responsebody)
End With
Set Retrieval=Nothing
End Function
function bytes2bstr(vin)
strreturn=""
for i = 1 to lenb(vin)
thischarcode = ascb(midb(vin,i,1))
if thischarcode < &h80 then
strreturn = strreturn & chr(thischarcode)
else
nextcharcode=ascb(midb(vin,i+1,1))
strreturn=strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode))
i = i + 1
end if
next
bytes2bstr = strreturn
end function
Dim rs,sort_id
Dim Url,Html,Title,Keyword,Content
Dim KSearchRegExp,KSearchMatc
sort_id=Request.QueryString("sort_id")
Url=Request.QueryString("Url")
Html=GetURL(Url)
Set KSearchRegExp=New RegExp
KSearchRegExp.IgnoreCase=True
KSearchRegExp.Pattern="<TITLE>([^<]*)</TITLE>"
Set KSearchMatch=KSearchRegExp.Execute(HTML)
if NOT KSearchMatch.Count=0 Then
Title=KSearchMatch.item(0).Value
Title=Replace(Title, "<TITLE>", "", 1, -1, vbTextCompare)
Title=Replace(Title, "</TITLE>", "", 1, -1, vbTextCompare)
end if
set KSearchMatch=Nothing
KSearchRegExp.Pattern="<META[^>]+(name=""keywords""|content=""([^""]*)"")[^>]+(name=""keywords""|content=""([^""]*)"")[^>]*>"
Set KSearchMatch=KSearchRegExp.Execute(HTML)
if NOT KSearchMatch.Count=0 Then
Keyword=KSearchMatch.item(0).Value
Keyword=Mid(Keyword, InStr(1, Keyword, "content=""", vbTextCompare) + 9)
Keyword=Mid(Keyword, 1, InStr(1,Keyword, """", vbTextCompare) -1)
end if
set KSearchMatch=Nothing
KSearchRegExp.Pattern="<META[^>]+(name=""description""|content=""([^""]*)"")[^>]+(name=""description""|content=""([^""]*)"")[^>]*>"
Set KSearchMatch=KSearchRegExp.Execute(HTML)
if NOT KSearchMatch.Count=0 Then
Content=KSearchMatch.item(0).Value
Content=Mid(Content, InStr(1,Content, "content=""", vbTextCompare) + 9)
Content=Mid(Content, 1, InStr(1,Content, """", vbTextCompare) -1)
end if
set KSearchMatch=Nothing
set KSearchRegExp=Nothing
if title="" or instr(title,"Untitled Document")=1 or instr(title,"无标题")=1 then
title=""
end if
if keyword="" then
Keyword=title
end if
if content="" then
Content=title
end if
set rs=server.createobject("adodb.recordset")
rs.open "select * from web where id is null",conn,1,3
rs.addnew
rs("sort_path")=filtration(Request.QueryString("sort_path"))
rs("sort_id")=sort_id
rs("title")=filtration(left(title,25))
rs("url")=url
rs("keyword")=filtration(left(keyword,25))
rs("content")=filtration(left(content,50))
rs("sequence")="0"
rs("commend")="0"
rs("one_click_open")="0"
rs("verify")="0"
rs("click")="0"
rs("time")=date()
rs.update
rs.close
set rs = nothing
conn.close
set conn = nothing
if title="" then
response.write ""&url&" >> 添加失败"
else
response.write ""&url&" >> 添加成功"
end if
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -