📄 article_add.asp
字号:
ChargeType=KSCMS.G("ChargeType"):IF Not IsNumeric(ChargeType) Then ChargeType=0
PitchTime=KSCMS.G("PitchTime"):IF Not IsNumeric(PitchTime) Then PitchTime=0
ReadTimes=KSCMS.G("ReadTimes"):IF Not IsNumeric(ReadTimes) Then ReadTimes=0
InfoPurview=KSCMS.G("InfoPurview"):IF Not IsNumeric(InfoPurview) Then InfoPurview=0
arrGroupID=KSCMS.G("GroupID")
DividePercent=KSCMS.G("DividePercent"):IF Not IsNumeric(DividePercent) Then DividePercent=0
TemplateID = Request("TemplateID"):If TemplateID = "" Then TemplateID = 0
ArticleFsoType = Request.QueryString("ArticleFsoType"):if ArticleFsoType = "" Then ArticleFsoType = 1
If Action = "Add" OR Action="Verify" Then '取得生成文件名
'Fname = KSCMS.GetFileName(ArticleFsoType, AddDate, FnameType)
Fname=KSCMS.G("FileName") & FnameType
End If
If CInt(Changes) = 1 Then Fname = ChangesUrl
If Title = "" Then .Write ("<script>alert('文章标题不能为空!');history.back(-1);</script>")
If CInt(Changes) = 1 Then
If ChangesUrl = "" Then .Write ("<script>alert('请输入文章的链接地址！');history.back(-1);</script>")
End If
If ArticleContent = "" and CInt(Changes) <> 1 Then .Write ("<script>alert('文章内容不能为空!');history.back(-1);</script>")
Set ArticleRS = Server.CreateObject("ADODB.RecordSet")
If Tid = "" Then ErrMsg = ErrMsg & "[文章类别]必选! \n"
If Title = "" Then ErrMsg = ErrMsg & "[文章标题]不能为空! \n"
If Title <> "" And Tid <> "" And (Action = "Add" Or Action="Verify") Then
SqlStr = "select * from KS_Article where Title='" & Title & "' And Tid='" & Tid & "'"
ArticleRS.Open SqlStr, conn, 1, 1
If Not ArticleRS.EOF Then ErrMsg = ErrMsg & "该类别已存在此篇文章! \n"
ArticleRS.Close
End If
If ErrMsg <> "" Then
.Write ("<script>alert('" & ErrMsg & "');history.back(-1);</script>")
.End
Else
'判断是否远程存图
If CInt(BeyondSavePic) = 1 And CInt(Changes) <> 1 Then
If CStr(KSCMS.GetConfig("SaveImgByDate")) = "1" Then
SaveFilePath = "/" & KSCMS.GetConfig("BeyondPicDir") & Year(Now()) & "-" & Right("0" & Month(Now()), 2) & "/"
Else
SaveFilePath = "/" & KSCMS.GetConfig("BeyondPicDir")
End If
KSCMS.CreateListFolder (SaveFilePath)
ArticleContent = KSCMS.ReplaceBeyondUrl(ArticleContent, SaveFilePath)
End If
If Action = "Add" Or Action="Verify" Then '后台添加新文章，或是审核投搞
SqlStr = "select * from KS_Article where NewsID=null"
ArticleRS.Open SqlStr, conn, 1, 3
ArticleRS.AddNew
'生成文章ID
ArticleRS("NewsId") = NewsID
ArticleRS("TitleType") = TitleType
ArticleRS("Title") = Title
ArticleRS("Fulltitle")=Fulltitle
ArticleRS("ShowComment") = ShowComment
ArticleRS("TitleFontColor") = TitleFontColor
ArticleRS("TitleFontType") = TitleFontType
ArticleRS("SubTitle") = Subtitle
ArticleRS("ArticleContent") = KSCMS.ReplaceInnerLink(ArticleContent)
ArticleRS("Changes") = Changes
ArticleRS("PicNews") = PicNews
ArticleRS("PicUrl") = PicUrl
ArticleRS("Recommend") = Recommend
ArticleRS("Rolls") = Rolls
ArticleRS("Strip") = Strip
ArticleRS("Popular") = Popular
ArticleRS("Verific") = Verific
ArticleRS("Tid") = Tid
ArticleRS("SpecialID") = SpecialID
ArticleRS("KeyWords") = KeyWords
ArticleRS("Author") = Author
ArticleRS("Origin") = Origin
ArticleRS("Editor") = Editor
ArticleRS("AddDate") = AddDate
ArticleRS("Rank") = Rank
ArticleRS("Slide") = Slide
ArticleRS("Comment") = Comment
ArticleRS("BeyondSavePic") = BeyondSavePic
ArticleRS("TemplateID") = TemplateID
ArticleRS("Hits") = Hits
ArticleRS("ArticleFsoType") = ArticleFsoType
ArticleRS("Fname") = Fname
if Action="Verify" Then
ArticleRS("ArticleInput")=Trim(KSCMS.G("ArticleInput"))
Else
ArticleRS("ArticleInput") = Request.Cookies(KSCMS.SiteSn)("AdminName")
End IF
ArticleRS("RefreshTF") = Makehtml
ArticleRS("DelTF") = 0
ArticleRS("OrderID") = 1
ArticleRS("ReadPoint")= ReadPoint
ArticleRS("ChargeType")=ChargeType
ArticleRS("PitchTime")=PitchTime
ArticleRS("ReadTimes")=ReadTimes
ArticleRS("InfoPurview")=InfoPurview
ArticleRS("arrGroupID")=arrGroupID
ArticleRS("DividePercent")=DividePercent
ArticleRS.Update
'写入Session,添加下一篇文章调用
Session("KeyWords") = KeyWords
Session("Author") = Author
Session("Origin") = Origin
Session("Editor") = Editor
Session("SpecialID") = SpecialID
Call RefreshHtml(1)
ArticleRS.Close:Set ArticleRS = Nothing
IF Action="Verify" Then '如果是审核投稿文章，对用户，进行加积分等，并返回签收文章管理
Dim UserName,RSObj
Set RSObj=Server.CreateObject("Adodb.RecordSet")
RSObj.Open "Select UserName,Status,VerifyDate From KS_UserArticle Where ID="& KSCMS.G("ArticleID"),Conn,1,3
IF Not RSObj.Eof Then
RSObj(1)=3
RSObj(2)=Now()
RSObj.Update
UserName=RSOBJ(0)
End if
RSObj.Close
'对用户进行增值，及发送通知操作
IF UserName<>"" Then Call KSCMS.SignUserInfoOK(1,UserName,Title)
Conn.Execute("Update KS_User Set ArticleNum=ArticleNum+1 Where UserName='" & UserName & "'")
.Write ("<script> parent.frames['MainFrame'].focus();alert('文章成功签收,系统已发送一封站内通知信给投稿者!');location.href='Article_UserArticleMain.asp?Page=" & Page & "&ArticleStatus=" & KSCMS.G("ArticleStatus")&"';parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=Disabled&OpStr=文章管理 >> <font color=red>签收会员文章</font>';</script>")
End IF
ElseIf Action = "Edit" Then
NewsID = Trim(Request("NewsID"))
SqlStr = "SELECT * FROM KS_Article Where NewsID='" & NewsID & "'"
ArticleRS.Open SqlStr, conn, 1, 3
If ArticleRS.EOF And ArticleRS.BOF Then
.Write ("<script>alert('参数传递出错!');history.back(-1);</script>")
Response.End
End If
ArticleRS("TitleType") = TitleType
ArticleRS("Title") = Title
ArticleRS("Fulltitle")=Fulltitle
ArticleRS("ShowComment") = ShowComment
ArticleRS("TitleFontColor") = TitleFontColor
ArticleRS("TitleFontType") = TitleFontType
ArticleRS("SubTitle") = Subtitle
ArticleRS("ArticleContent") = ArticleContent
ArticleRS("Changes") = Changes
ArticleRS("PicNews") = PicNews
ArticleRS("PicUrl") = PicUrl
ArticleRS("Recommend") = Recommend
ArticleRS("Rolls") = Rolls
ArticleRS("Strip") = Strip
ArticleRS("Popular") = Popular
ArticleRS("Verific") = Verific
ArticleRS("Tid") = Tid
ArticleRS("SpecialID") = SpecialID
ArticleRS("KeyWords") = KeyWords
ArticleRS("Author") = Author
ArticleRS("Origin") = Origin
ArticleRS("Editor") = Editor
ArticleRS("AddDate") = AddDate
ArticleRS("Rank") = Rank
ArticleRS("Slide") = Slide
ArticleRS("Comment") = Comment
ArticleRS("BeyondSavePic") = BeyondSavePic
ArticleRS("TemplateID") = TemplateID
IF Cint(Changes)=1 Then
ArticleRS("Fname") = Fname
End If
'ArticleRS("Fname") = Replace(ArticleRS("Fname"), Trim(Mid(Trim(ArticleRS("Fname")), InStrRev(Trim(ArticleRS("Fname")), "."))), FnameType)
If Makehtml = 1 Then
ArticleRS("RefreshTF") = 1
End If
ArticleRS("Hits") = Hits
ArticleRS("ArticleFsoType") = ArticleFsoType
ArticleRS("ReadPoint")= ReadPoint
ArticleRS("ChargeType")=ChargeType
ArticleRS("PitchTime")=PitchTime
ArticleRS("ReadTimes")=ReadTimes
ArticleRS("InfoPurview")=InfoPurview
ArticleRS("arrGroupID")=arrGroupID
ArticleRS("DividePercent")=DividePercent
ArticleRS.Update
Call RefreshHtml(2)
ArticleRS.Close:Set ArticleRS = Nothing
If KeyWord <> "" Then
.Write ("<script> parent.frames['MainFrame'].focus();alert('文章修改成功!');location.href='Article_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&KeyWord=" & KeyWord & "&SearchType=" & SearchType & "&StartDate=" & StartDate & "&EndDate=" & EndDate & "';parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ArticleSearch&OpStr=文章管理 >> <font color=red>搜索结果</font>';</script>")
End If
End If
End If
End With
End Sub
Sub RefreshHtml(Flag)
Dim TempStr,EditStr,AddStr
If Flag=1 Then
TempStr="添加":EditStr="修改文章":AddStr="继续添加文章"
Else
TempStr="修改":EditStr="继续修改文章":AddStr="添加文章"
End If
With Response
.Write "<link href='../Inc/Admin_Style.CSS' rel='stylesheet' type='text/css'>"
.Write " <table bgcolor=""#CCCCCC"" style=""margin-top:15px"" align=center width=""80%"" border=""0"" cellpadding=""2"" cellspacing=""1"">"
.Write " <tr align=center bgcolor=""#F4F4EA""> "
.Write " <td height=""28"" align=""center"" class=""title""><b>" & TempStr &"文章成功</b></td>" & vbcrlf
.Write " </tr>"
.Write " <tr bgcolor=""#FFFFFF"" height=""20""> "
.Write " <td><table width=""100%"" bgcolor=""#efefef"" border=""0"" cellpadding=""2"" cellspacing=""1"">" & vbcrlf
.Write " <tr bgcolor=""#ffffff"" height=""20""> " & vbcrlf
.Write " <td width=""100"" align=""right""><strong>所属栏目：</strong></td>"
.Write " <td>" & KSCMS.ReturnClassName(Tid) & "</td>"
.Write " </tr>"
.Write " <tr bgcolor=""#ffffff"" height=""20""> "
.Write " <td width=""100"" align=""right""><strong>文章标题：</strong></td>"
.Write " <td>" & Title & "</td>"
.Write " </tr>"
.Write " <tr bgcolor=""#ffffff"" height=""20""> "
.Write " <td width=""100"" align=""right""><strong>作 者：</strong></td>"
.Write " <td>" & Author & "</td>"
.Write " </tr>"
.Write " <tr bgcolor=""#ffffff"" height=""20""> "
.Write " <td width=""100"" align=""right""><strong>来 源：</strong></td>"
.Write " <td>" & Origin & "</td>"
.Write " </tr>"
.Write " <tr bgcolor=""#ffffff"" height=""20""> "
.Write " <td width=""100"" align=""right""><strong>关 键 字：</strong></td>"
.Write " <td>" & KeyWords & "</td>"
.Write " </tr>"
.Write " </table></td>"
.Write " </tr>"
.Write " <tr bgcolor=""#F4F4EA""> "
.Write " <td height=""28"" align=""center"">【<a href=""#"" onclick=""location.href='Article_Add.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&Action=Edit&KeyWord=" & KeyWord &"&SearchType=" & SearchType &"&StartDate=" & StartDate & "&EndDate=" & EndDate &"&NewsID=" & NewsID & "';""><strong>" & EditStr &"</strong></a>】 【<a href=""#"" onclick=""location.href='Article_add.asp?DisplayMode=" & DisplayMode & "&Action=Add&FolderID=" & Tid & "';parent.frames['BottomFrame'].location.href='../Split.asp?OpStr=添加文章&ButtonSymbol=AddArticle&FolderID=" & Tid & "';""><strong>" & AddStr & "</strong></a>】 【<a href=""#"" onclick=""location.href='Article_main.asp?DisplayMode=" & DisplayMode & "&ID=" & Tid & "';parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & Tid & "';""><strong>文章管理</strong></a>】 【<a href=""" & KSCMS.GetDomain &"Article/ShowInfo.asp?ID=" & NewsID & """ target=""_blank""><strong>预览文章内容</strong></a>】</td>"
.Write " </tr>"
.Write " </table>"
'判断是否立即发布
If Makehtml = 1 Then
.Write "<div style=""margin-top:15px;border: #E7E7E7;height:296; overflow: auto; width:100%"">"
If KSCMS.GetChannelConfig(1,"FsoHtmlTF")=0 Then
.Write "<div style=""margin-left:140;height:25px""><li>由于文章中心没有启用生成HTML的功能，所以ID号为 <font color=red>" & NewsID & "</font> 的文章没有生成!</li></div> "
.Write "<div style=""margin-left:140;height:25px""><li>由于文章中心没有启用生成HTML的功能，所以ID号为 <font color=red>" & TID & "</font> 的栏目没有生成!</li></div> "
Else
.Write "<div align=center><iframe src=""../Refresh/RefreshHtmlSave.Asp?ChannelID=1&Types=Content&RefreshFlag=ID&ArticleID=" & NewsID &""" width=""98%"" height=""80"" frameborder=""0""></iframe></div>"
Dim ObjRS:Set ObjRS=Server.CreateObject("Adodb.Recordset")
ObjRS.Open "Select TS From KS_Class Where ID='" & Tid &"'",Conn,1,1
If Not ObjRS.Eof Then
Dim FolderIDArr:FolderIDArr=Split(left(ObjRS(0),Len(ObjRS(0))-1),",")
For I=0 To Ubound(FolderIDArr)
.Write "<div align=center><iframe src=""../Refresh/RefreshHtmlSave.Asp?ChannelID=1&Types=Folder&RefreshFlag=ID&FolderID=" & FolderIDArr(i) &""" width=""98%"" height=""90"" frameborder=""0""></iframe></div>"
Next
End If
ObjRS.Close:Set ObjRS=Nothing
End If
If Split(KSCMS.GetConfig("FsoIndex"),".")(1)="asp" Then
.Write "<div style=""margin-left:140;color:blue;height:25px""><li>由于 <a href=""" & KSCMS.GetDomain & """ target=""_blank""><font color=red>网站首页</font></a> 没有启用生成HTML的功能，所以没有生成!</li></div>"
Else
.Write "<div align=center><iframe src=""../Refresh/RefreshIndex.asp?RefreshFlag=Info"" width=""98%"" height=""80"" frameborder=""0""></iframe></div>"
End If
.Write "</div>"
End If
End With
End Sub
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -