user_url.asp
来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 709 行 · 第 1/2 页
ASP
709 行
End If
%>
<script language=javascript>
function VerifySubmit()
{
if (document.oblogform.url.value.length==0){
alert("订阅地址必须填写");
document.oblogform.url.focus();
return false;
}
return true;
}
</script>
<body scroll="no" style="overflow-x:hidden;background:#fff">
<ul id="user_page_top">
<li id='p1'><a href="user_url.asp">管理订阅</a></li>
<li id='p1'><a href="user_subject.asp?t=3">分类维护</a></li>
</ul>
<div id="user_setting_content">
<div id="cnt">
<div id="dTab12" class="Box">
<form action="user_url.asp?action=save&id=<%=id%>" method="post" name="oblogform" id="oblogform" onSubmit="return VerifySubmit()">
<table class="dTab12_body" align="center" border="0" cellpadding="0" cellspacing="1">
<tr>
<td align="right">分类：</td><td>
<%
If rsSubject.Eof Then
%>
您目前还没有设定订阅分类，您可以继续添加或者<a href="user_subject.asp?t=3">设定分类后添加</a>
<%
Else
%>
<select name="subjectid">
<%
Do While Not rsSubject.Eof
%>
<option value="<%=rsSubject("subjectid")%>" <%If rsSubject("subjectid")=sSubjectId Then Response.Write "checked" End If%>><%=rsSubject("subjectname")%></option>
<%
rsSubject.MoveNext
Loop
%>
</select>
<%
End If
%>
</td>
</tr>
<tr <%=OutRssDisplay%>>
<td align="right"> Rss地址：</td><td>
<input name="url" type=text size="60" maxlength="250" value="<%=sUrl%>" >
</td>
</tr>
<tr>
<td align="right">标题：</td><td><input name="title" type=text size="60" maxlength="100" value="<%=sTitle%>" ></td>
</tr>
<tr <%=OutRssDisplay%>>
<td align="right">编码：</td><td><select name="encodeing">
<option value='auto'>自动检测</option>
<option value='utf-8' <%if encodeing="utf-8" then response.Write("selected")%> >utf-8</option>
<option value='gb2312' <%if encodeing="gb2312" then response.Write("selected")%>>gb2312</option>
</select>
</td>
</tr>
<tr>
<td > </td><td>
<input type="hidden" value="<%=mainuserid%>" name="mainuserid" />
<input type="submit" value=" 保 存 " />
<input type="reset" value=" 清 除 " />
</td>
</tr>
</table>
</form>
</div>
</div>
</div>
<%
End Sub
Sub Save()
If oblog.ChkPost() = False Then
oblog.AddErrStr ("系统不允许从外部提交！")
oblog.showUserErr
Exit Sub
End If
'Get
dim encodeing
sUrl=Request.Form("url")
sTitle=Request.Form("title")
sSubjectId=Request.Form("subjectid")
sTags=Request.Form("tags")
sMemo=Request.Form("Memo")
IsPrivate=Request.Form("isPrivate")
encodeing=Request.Form("encodeing")
if request("mainuserid")<>"" then
mainuserid=clng(request("mainuserid"))
else
mainuserid=0
end if
If IsPrivate<>"1" Then IsPrivate="0"
'Check
If Id="" Then
If sUrl = "" Or oblog.strLength(sUrl) > 200 Then oblog.AddErrStr ("订阅长度不能为空且不能大于200个字符长度")
If sTitle = "" Or oblog.strLength(sTitle) > 50 Then oblog.AddErrStr ("标题不能为空且不能大于50个字符长度")
If oblog.chk_badword(sTitle) > 0 Then oblog.AddErrStr ("标题中含有系统不允许发布的关键字！")
End If
'If oblog.chk_badword(sTags) > 0 Then oblog.AddErrStr ("标签中含有系统不允许发布的关键字！")
'If oblog.chk_badword(sMemo) > 0 Then oblog.AddErrStr ("备注信息中含有系统不允许发布的关键字！")
'if left(surl,7)<>"http://" and mainuserid=0 then oblog.AddErrStr ("订阅地址必须以""http://""开头！")
If oblog.ErrStr <> "" Then oblog.showUserErr
if encodeing="auto" and mainuserid=0 then
encodeing=test_encodeing(surl)
end if
if mainuserid>0 then encodeing="gb2312"
If Trim(Id)<>"" Then
rs.Open "Select * From oblog_myurl Where Id=" & Int(Id) & " And userid=" & oblog.l_uid,conn,1,3
If rs.Eof Then
rs.Close
Set rs=Nothing
oblog.AddErrStr ("目标数据不存在，请返回重新操作！")
oblog.showUserErr
End If
Else
'urlid=CheckMyUrl(sUrl,sTitle)
'If urlid="" Then Exit Sub
rs.Open "Select * From oblog_myurl Where userid="&oblog.l_uid&" and url='"&oblog.filt_badstr(surl)&"'",conn,1,3
if not rs.eof then
rs.close
set rs=nothing
oblog.AddErrStr ("您已经订阅过此博客的更新！")
oblog.showUserErr
exit sub
else
rs.AddNew
'rs("urlid") = 0
end if
End If
'开始写入操作
rs("classid") = 0
If sSubjectId<>"" Then rs("subjectid") = sSubjectId else rs("subjectid")=0
If sTags<>"" Then rs("tags") = sTags
rs("url")=sUrl
rs("userid")=oblog.l_uid
rs("isprivate")=IsPrivate
If sMemo<>"" Then rs("memo") = sMemo
rs("addtime") = ServerDate(Now)
rs("encodeing")=encodeing
rs("title")=sTitle
rs("mainuserid")=mainuserid
if id="" and mainuserid>0 then rs("isupdate")=1
rs.Update
rs.Close
if mainuserid>0 then oblog.execute("update oblog_user set sub_num=sub_num+1 where userid="&mainuserid)
Response.Write "<script>parent.getfeedlist();</script>"
response.Flush()
if id="" then
oblog.showok "添加成功","user_url.asp"
else
oblog.showok "修改成功","user_url.asp"
end if
End Sub
Sub List()
Dim Sql,i,lPage,lAll,lPages,iPage,Subjectid,keyword,cmd,sGuide
Subjectid=Request("Subjectid")
keyword=Request("keyword")
If Keyword <> "" Then Keyword = oblog.filt_badstr(Keyword)
cmd=LCase(Request("cmd"))
Select Case cmd
Case "11"
If keyword<>"" Then
Sql="Select top 500 * From oblog_myurl Where userid=" & oblog.l_uid & " and Title like '%" & keyword&"%' Order By id Desc"
' Else
' If Subjectid<>"" Then
' Subjectid=Int(Subjectid)
' Sql="Select top 500 a.id,a.subjectid,b.* From oblog_myurl a,oblog_url b Where a.userid=" & oblog.l_uid & " And a.subjectid=" & subjectid &" And a.urlid=b.urlid Order By a.subjectid,a.addtime Desc"
' End If
End If
Case Else
Sql="Select top 500 * From oblog_myurl a Where a.userid=" & oblog.l_uid & " Order By id Desc"
End Select
rs.Open Sql,conn,1,3
lAll=INT(rs.recordcount)
If lAll=0 Then
rs.Close
Set rs=Nothing
%>
<div id="user_page_content">
<div id="content_li">
<ul class="content_li_conten">
<li class="t1"></li>
<li class="t3"> </li>
</ul>
<ul class="content_li_conten">
<li class="t1"></li>
<li class="t3"><%=sGuide & " 没有相关纪录" %><a href="user_url.asp?action=add" <%=OutRssDisplay%>>新增一个订阅</a></li></ul>
</div>
</div>
<%
Exit Sub
End If
iPage=12
'分页
If Request("page") = "" Or Request("page") ="0" then
lPage = 1
Else
lPage = Int(Request("page"))
End If
'设置缓存大小 = 每页需显示的记录数目
rs.CacheSize = iPage
rs.PageSize = iPage
rs.movefirst
lPages = rs.PageCount
If lPage>lPages Then lPage=lPages
rs.AbsolutePage = lPage
i=0
%>
<body scroll="no" style="overflow-x:hidden;background:#fff">
<style type="text/css">
<!--
.content_li_top .t1 {width:50px;text-align:center;}
.content_li_top .t2 {width:105px;text-align:left;}
.content_li_top .t3 {width:300px;text-align:left;}
.content_li_top .t4 {width:80px;text-align:left;}
.content_li_top .t5 {width:100px;text-align:left;}
#content_li .content_li_conten .t1 {width:40px;text-align:center;}
#content_li .content_li_conten .t2 {width:103px;color:#999;}
#content_li .content_li_conten .t3 {width:316px;}
#content_li .content_li_conten .t4 {width:80px;text-align:left;}
#content_li .content_li_conten .t5 {width:100px;text-align:left;}
#content_li .content_li_conten .t5 a {color:#000;}
#content_li .content_li_conten .t5 a:hover {color:#333;}
-->
</style>
<ul id="user_page_top">
<li id="p7"><a href="#" onclick="chk_idAll(myform,1)">全部选择</a></li>
<li id="p8"><a href="#" onclick="chk_idAll(myform,0)">全部取消</a></li>
<li id="p4"><a href="#" onclick="if (chk_idBatch(myform,'删除选中的订阅吗?')==true) { document.myform.submit();}">删除订阅</a></li>
<li> </li>
<li id="p1" <%=OutRssDisplay%>><a href="user_url.asp?action=add">增加订阅</a></li>
<li id="p1"><a href="user_subject.asp?t=3">分类维护</a></li>
<li id="p1"><a href="user_logzip.asp?action=saversslist" target="_blank">导出订阅</a></li>
</ul>
<div id="showpage">
<%=MakeMiniPageBar(lAll,iPage,lPage,G_P_FileName)%>
</div>
<div id="user_page_content">
<ul class="content_li_top">
<li class="t1">选中</li>
<li class="t2">分类</li>
<li class="t3">描述</li>
<li class="t4"></li>
<li class="t5">操作</li>
</ul>
<div id="content_li">
<form name="myform" method="Post" action="user_url.asp?action=del" onSubmit="return confirm('确定要执行选定的操作吗？');">
<%
Do while not rs.EOF
i = i + 1%>
<ul class="content_li_conten" id="u<%=rs("id")%>" onclick="chk_iddiv('<%=rs("id")%>')">
<li class="t1"><input name='id' type='checkbox' id="c<%=rs("id")%>" value="<%=cstr(rs("id"))%>" onclick="chk_iddiv('<%=rs("id")%>')" /></li>
<li class="t2">
<%
If Not IsNull(rs("subjectid")) And rs("subjectid")<>"" Then
rsSubject.Filter="subjectid=" & rs("subjectid")
If Not rsSubject.Eof Then
Response.Write rsSubject("subjectname")
Else
Response.Write "未分类"
End If
Else
Response.Write "未分类"
End If
%></li>
<li class="t3" onclick="chk_id('<%=rs("id")%>')"><a href="user_url.asp?action=read&feedurl=<%=rs("url")%>&encodeing=<%=rs("encodeing")%>&title=<%=rs("title")%>&mainuserid=<%=rs("mainuserid")%>" ><%=rs("title")%></a> </li>
<li class="t4"></li>
<li class="t5"><a href="user_url.asp?action=edit&id=<%=rs("id")%>">修改</a>
<a href="user_url.asp?action=del&id=<%=rs("id")%>" onClick="return confirm('确定要删除此订阅信息吗？');">删除</a>
</li>
</ul>
<%
i = i + 1
If i >= G_P_PerMax Then Exit Do
rs.Movenext
Loop
%>
</form>
</div>
</div>
<%
End Sub
'系统中保存的Url最后都不需要加/
'如果存在，则返回UrlId
'如果不存在，则写入基本表并返回UrlId
Function CheckMyUrl(byval sUrl,byval sTitle)
Dim rst,urlId
If sUrl="" Then Exit Function
If oblog.chk_badword(sUrl) Then Exit Function
If Right(sUrl,1)="/" Then sUrl=Left(sUrl,Len(sUrl)-1)
sUrl=Lcase(Trim(sUrl))
Set rst=Server.CreateObject("Adodb.RecordSet")
rst.Open "Select * From Oblog_Url Where url='" & sUrl & "'",conn,1,3
If rst.Eof Then
rst.AddNew
rst("url")=sUrl
rst("title")=sTitle
rst("iCount")=1
rst("vCount")=0
rst("lasttime")=ServerDate(Now)
rst.Update
rst.Close
Set rst=oblog.Execute("Select urlid From oblog_url Where url='" & sUrl & "'")
urlId=rst("urlid")
Else
rst("iCount")=rst("iCount")+1
rst("lasttime")=ServerDate(Now)
urlId=rst("urlid")
rst.Update
End If
rst.Close
Set rst=Nothing
CheckMyUrl=urlId
End Function
function test_encodeing(sUrl)
On Error Resume Next
dim http,re,encodeing
Set http=Server.CreateObject("Microsoft.XMLHTTP")
http.Open "GET",sUrl,False
http.send
if http.status="200" then
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="encoding=\""gb2312"
if re.test(http.responseText) then
encodeing="gb2312"
else
encodeing="utf-8"
end if
set re=nothing
end if
If Err Then
Err.Clear
test_encodeing="utf-8"
else
test_encodeing=encodeing
End If
set http=nothing
end function
%>⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?