📄 article_add.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../../SysCls/KS_RefreshCls.asp"-->
<!--#include file="../Inc/Session.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 Sp1个人Access版
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New Article_Add
KSCls.Execute()
Set KSCls = Nothing
Class Article_Add
Private KSCMS,ComeUrl
Private FolderID, ArticleTemplateID, ArticleFnameType, ArticleFsoType, TN, TI, Navigation, TJ, FolderName, TypeList, I, Action
Private RS, TemplateSql, TemplateRS, Speciallist, KeyWordList, AuthorList, OriginList, EditorList, TemplateList, TemplateID, KeyRS, OriginRS, SpecialRS, SpecialSql
Private NewsID, ArticleRS, TitleType, Title,Fulltitle,ShowComment, TitleFontColor, TitleFontType, Subtitle, PicNews, ArticleContent, PicUrl, Changes, Recommend
Private Strip, Popular, Verific, Comment, Slide, BeyondSavePic, ChangesUrl, Rolls, KeyWords, Author, Origin, Editor, AddDate, Rank, Hits, SpecialID
Private CurrPath, InstallDir, ParentID, UpPowerFlag
Private KeyWord, SearchType, StartDate, EndDate, Page, DisplayMode
Private ArticleInput,FileName
Private SqlStr,Errmsg,Makehtml,FnameType,Tid,Fname,KSRObj,SaveFilePath
Private ReadPoint,ChargeType,PitchTime,ReadTimes,InfoPurview,arrGroupID,DividePercent
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
End Sub
Private Sub Class_Terminate()
Set KSCMS=Nothing
End Sub
'主体部分
Public Sub Execute()
'收集搜索参数
KeyWord = KSCMS.G("KeyWord")
SearchType = KSCMS.G("SearchType")
StartDate = KSCMS.G("StartDate")
EndDate = KSCMS.G("EndDate")
ComeUrl=Request.ServerVariables("HTTP_REFERER")
DisplayMode = KSCMS.G("DisplayMode")
Page = KSCMS.G("page")
Action = KSCMS.G("Action") 'Add添加新文章 Edit编辑文章 Verify 审核前台投搞
IF KSCMS.G("Method")="Save" Then
Call ArticleSave()
Else
Call ArticleAdd()
End If
Call KSCMS.CloseConn()
End Sub
'添加
Sub ArticleAdd()
With Response
.Write "<script>parent.frames['LeftFrame'].LeftInfoFrame.SetEnabledStatus(true);</script>"
CurrPath = KSCMS.ReturnChannelUpFilesDir(1)
Set RS = Server.CreateObject("ADODB.RecordSet")
If Action = "Add" Then
FolderID = Trim(KSCMS.G("FolderID"))
If Not KSCMS.ReturnPowerResult(1, "KMA10012") Then '检查是否有添加文章的权限
.Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & FolderID & "';</script>")
Call KSCMS.ReturnErr(2, "Article_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&ID=" & FolderID)
Exit Sub
End If
Hits = 0:Comment = 1
' ReadPoint=0:ChargeType=0:PitchTime=24:ReadTimes=10:InfoPurview=0:arrGroupID=0:DividePercent=0
KeyWords = Session("keywords")
Author = Session("Author")
Origin = Session("Origin")
Editor = Session("Editor")
SpecialID = Session("SpecialID")
ElseIF Action="Verify" Then '审核前台会员投稿的文章
If KSCMS.ReturnPowerResult(1, "KMA10019") Then '检查是否有审核前台会员投稿文章的权限
Set ArticleRS = Server.CreateObject("ADODB.RECORDSET")
ArticleRS.Open "Select * From KS_UserArticle Where ID=" & KSCMS.G("ID") , conn, 1, 1
IF ArticleRS.Eof And ArticleRS.Bof Then
.Write "<script>alert('参数传递错误!');history.back();</script>"
Set KSCMS = Nothing
Response.End
Exit Sub
Else
NewsID=ArticleRS("ArticleID")
FolderID=ArticleRS("ClassID")
Title=ArticleRS("Title")
Author=ArticleRS("Author")
ArticleInput=ArticleRS("UserName")
ArticleContent=ArticleRS("Content")
Origin=ArticleRS("Origin")
Editor=ArticleInput
AddDate=ArticleRS("AddDate")
KeyWords=ArticleRS("KeyWords")
PicNews=ArticleRS("PicNews")
PicUrl=ArticleRS("PicUrl")
Rank="★★★":Hits=0:Comment = 1
End IF
End IF
ElseIf Action = "Edit" Then
NewsID = Trim(KSCMS.G("NewsID"))
Set ArticleRS = Server.CreateObject("ADODB.RECORDSET")
ArticleRS.Open "Select * From KS_Article Where NewsID='" & NewsID & "'", conn, 1, 1
If ArticleRS.EOF And ArticleRS.BOF Then
Call KSCMS.Alert("参数传递出错!", ComeUrl)
.End
Exit Sub
End If
NewsID = Trim(ArticleRS("NewsID"))
FolderID = Trim(ArticleRS("Tid"))
If Not KSCMS.ReturnPowerResult(1, "KMA10013") Then '检查是否有编辑文章的权限
ArticleRS.Close
Set ArticleRS = Nothing
If KeyWord = "" Then
.Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & FolderID & "';</script>")
Call KSCMS.ReturnErr(1, "Article_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&ID=" & FolderID)
Else
.Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?OpStr=文章管理 >> <font color=red>搜索文章结果</font>&ButtonSymbol=ArticleSearch';</script>")
Call KSCMS.ReturnErr(1, "Article_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&KeyWord=" & KeyWord & "&SearchType=" & SearchType & "&StartDate=" & StartDate & "&EndDate=" & EndDate)
End If
Exit Sub
End If
TitleType = Trim(ArticleRS("TitleType"))
Title = Trim(ArticleRS("title"))
Fulltitle=Trim(ArticleRS("Fulltitle"))
ShowComment = ArticleRS("ShowComment")
TitleFontColor = Trim(ArticleRS("TitleFontColor"))
TitleFontType = Trim(ArticleRS("TitleFontType"))
Subtitle = Trim(ArticleRS("SubTitle"))
PicUrl = Trim(ArticleRS("PicUrl"))
PicNews = CInt(ArticleRS("PicNews"))
SpecialID = Trim(ArticleRS("SpecialID"))
Rolls = CInt(ArticleRS("Rolls"))
Changes = CInt(ArticleRS("Changes"))
Recommend = CInt(ArticleRS("Recommend"))
Strip = CInt(ArticleRS("Strip"))
Popular = CInt(ArticleRS("Popular"))
Verific = CInt(ArticleRS("Verific"))
Comment = CInt(ArticleRS("Comment"))
Slide = CInt(ArticleRS("Slide"))
BeyondSavePic = CInt(ArticleRS("BeyondSavePic"))
AddDate = CDate(ArticleRS("AddDate"))
Rank = Trim(ArticleRS("Rank"))
FileName=ArticleRS("Fname")
ArticleFnameType = Trim(Mid(Trim(FileName), InStrRev(Trim(FileName), ".")))
ArticleTemplateID = CInt(ArticleRS("TemplateID"))
ArticleFsoType = CInt(ArticleRS("ArticleFsoType"))
Hits = Trim(ArticleRS("Hits"))
KeyWords = Trim(ArticleRS("KeyWords"))
Author = Trim(ArticleRS("Author"))
Origin = Trim(ArticleRS("Origin"))
Editor = Trim(ArticleRS("Editor"))
ReadPoint=ArticleRS("ReadPoint")
ChargeType=ArticleRS("ChargeType")
PitchTime=ArticleRS("PitchTime")
ReadTimes=ArticleRS("ReadTimes")
InfoPurview=ArticleRS("InfoPurview")
arrGroupID=ArticleRS("arrGroupID")
DividePercent=ArticleRS("DividePercent")
If CInt(Changes) = 1 Then
ArticleContent = " "
ChangesUrl = Trim(ArticleRS("Fname"))
Else
ArticleContent = Trim(ArticleRS("ArticleContent"))
End If
FolderID = ArticleRS("Tid")
ArticleRS.Close:Set ArticleRS = Nothing
End If
'取得上传权限
UpPowerFlag = KSCMS.ReturnPowerResult(1, "KMA10016")
'取得目录导航
RS.Open "Select * From KS_Class Where ID='" & FolderID & "'", conn, 1, 1
If Not RS.EOF Then
'获取目录参数
If Action = "Add" OR Action="Verify" Then
ArticleTemplateID = RS("ArticleTemplateid")
ArticleFnameType = Trim(RS("ArticleFnameType"))
ArticleFsoType = RS("ArticleFsoType")
FileName=KSCMS.GetFileName(ArticleFsoType, Now, "")
ReadPoint=RS("DefaultReadPoint")
ChargeType=RS("DefaultChargeType")
PitchTime=RS("DefaultPitchTime")
ReadTimes=RS("DefaultReadTimes")
DividePercent=RS("DefaultReadPoint")
InfoPurview=0:arrGroupID=0
End If
TI = Split(RS("TS"), ",")
TJ = RS("tj")
ParentID = RS("TN")
Else
Call KSCMS.Alert("提示信息:\n\n您没有选择文章目录!", "Article_main.asp")
Response.End
End If
RS.Close
Set RS = Nothing
'取得目录树
TypeList = KSCMS.ReturnTree(FolderID, 1)
'取得专题
Speciallist = "<option value="""" selected> </option><option value="""" style=""color:red"">清空</option>"
Set SpecialRS = Server.CreateObject("ADODB.RECORDSET")
SpecialSql = "Select id,SpecialName From [KS_Special] Where ChannelID=1 And FolderID='" & TI(0) & "' Order By SpecialAddDate Desc"
SpecialRS.Open SpecialSql, conn, 1, 1
Do While Not SpecialRS.EOF
If Trim(SpecialID) = Trim(SpecialRS(0)) Then
Speciallist = Speciallist & "<option value=" & SpecialRS(0) & " selected>" & SpecialRS(1) & "</option>"
Else
Speciallist = Speciallist & "<option value=" & SpecialRS(0) & ">" & SpecialRS(1) & "</option>"
End If
SpecialRS.MoveNext
Loop
SpecialRS.Close:Set SpecialRS = Nothing
'取得关键字
KeyWordList = "<option value="""" selected> </option><option value=""Clean"" style=""color:red"">清空</option>"
Set KeyRS = conn.Execute("Select KeyText FROM [KS_KeyWords] Where ChannelID=1 Order BY AddDate Desc")
If Not KeyRS.EOF Then
Do While Not KeyRS.EOF
KeyWordList = KeyWordList & "<option value=""" & KeyRS(0) & """>" & KeyRS(0) & "</option>"
KeyRS.MoveNext
Loop
End If
KeyRS.Close:Set KeyRS = Nothing
'取得作者列表
AuthorList = "<option value="""" selected> </option><option value="""" style=""color:red"">清空</option>"
Set OriginRS = conn.Execute("Select OriginName FROM [KS_Origin] Where ChannelID=1 And OriginType=1 Order BY AddDate Desc")
If Not OriginRS.EOF Then
Do While Not OriginRS.EOF
AuthorList = AuthorList & "<option value=""" & OriginRS(0) & """>" & OriginRS(0) & "</option>"
OriginRS.MoveNext
Loop
End If
OriginRS.Close:Set OriginRS=Nothing
'取得来源列表
OriginList = "<option value="""" selected> </option><option value="""" style=""color:red"">清空</option>"
Set OriginRS = conn.Execute("Select OriginName FROM [KS_Origin] Where ChannelID=1 And OriginType=0 Order BY AddDate Desc")
If Not OriginRS.EOF Then
Do While Not OriginRS.EOF
OriginList = OriginList & "<option value=""" & OriginRS(0) & """>" & OriginRS(0) & "</option>"
OriginRS.MoveNext
Loop
End If
OriginRS.Close:Set OriginRS=Nothing
'取得责任编辑列表
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -