📄 article_paste.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%Option Explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../Inc/Session.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'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_Paste
KSCls.Execute()
Set KSCls = Nothing
Class Article_Paste
Private KSCMS
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConn()
Set KSCMS=Nothing
End Sub
'主体部分
Sub Execute()
If Not KSCMS.ReturnPowerResult(1, "KMA10017") Then Call KSCMS.ReturnErr(1, "") '剪切、复制权限检查
Dim DisplayMode, Page
Dim PasteTypeID, DestFolderID, SourceFolderID, FolderID, ContentID
DisplayMode = KSCMS.G("DisplayMode")
Page = KSCMS.G("Page")
PasteTypeID = KSCMS.G("PasteTypeID")
DestFolderID = KSCMS.G("DestFolderID")
SourceFolderID = KSCMS.G("SourceFolderID")
FolderID = KSCMS.G("FolderID")
ContentID = KSCMS.G("ContentID")
If PasteTypeID = "" Then PasteTypeID = 0
If DestFolderID = "" Then DestFolderID = "0"
If FolderID = "" Then
FolderID = "0"
End If
If ContentID = "" Then
ContentID = "0"
Else
ContentID = "'" & Replace(ContentID, ",", "','") & "'"
End If
If DestFolderID = "0" Or PasteTypeID = 0 Then
Call KSCMS.AlertHistory("参数传递出错!", 1)
Set KSCMS = Nothing
Exit Sub
End If
If PasteTypeID = 1 Then '剪切操作
Call PasteByCut(SourceFolderID, DestFolderID, FolderID, ContentID)
ElseIf PasteTypeID = 2 Then '复制操作
Call PasteByCopy(SourceFolderID, DestFolderID, FolderID, ContentID)
Else
Call KSCMS.AlertHistory("非法操作!", 1)
Set KSCMS = Nothing
Exit Sub
End If
Response.Write "<script>location.href='Article_main.asp?ID=" & DestFolderID & "&DisplayMode=" & DisplayMode & "&Page=" & Page & "';</script>"
End Sub
'过程:PasteByCut剪切粘贴
'参数:SourceFolderID--源目录,DestFolderID--目标目录,FolderID---被剪切的目录,ContentID---被剪切的文件
Sub PasteByCut(SourceFolderID, DestFolderID, FolderID, ContentID)
Dim RS, OriFolderID, DestTS, DestTJ, DestFolder, SubDestTS, DFolderID, I, Folder
If (SourceFolderID = DestFolderID) Then
Exit Sub
End If
If FolderID <> "0" Then
Set RS = Server.CreateObject("Adodb.RecordSet")
'取得目标目录信息
RS.Open "Select TS,TJ,Folder From KS_Class Where ID='" & DestFolderID & "'", conn, 1, 1
DestTS = RS("TS")
DestTJ = RS("TJ")
DestFolder = RS("Folder")
RS.Close
DFolderID = Split(FolderID, ",")
If CheckOp(DestFolderID, DFolderID, "剪切", False) Then '检查是否允许剪切
For I = LBound(DFolderID) To UBound(DFolderID)
RS.Open "Select TN,ID,TJ,TS,Folder From KS_Class Where ID ='" & DFolderID(I) & "'", conn, 1, 3
OriFolderID = RS("ID") '记住原父ID
RS("TS") = DestTS & RS("ID") & ","
Folder = RS("Folder")
RS("Folder") = DestFolder & Split(Left(Folder, Len(Folder) - 1), "/")(UBound(Split(Left(Folder, Len(Folder) - 1), "/"))) & "/"
RS("TN") = DestFolderID
RS("TJ") = DestTJ + 1
RS.Update
'对该目录下子目录信息做相应改变
SubDestTS = RS("TS")
Call CutSubFolder(OriFolderID, SubDestTS, DestFolder)
RS.Close
Next
End If
Set RS = Nothing
End If
If ContentID <> "0" Then
conn.Execute ("Update KS_Article Set Tid='" & DestFolderID & "' Where NewsID In (" & ContentID & ")")
End If
End Sub
'剪切子目录
Sub CutSubFolder(ParentID, SubDestTS, DestFolder)
Dim RSTS, OriSubClassID, Folder
Set RSTS = Server.CreateObject("Adodb.RecordSet")
RSTS.Open "Select TS,ID ,TJ,Folder From KS_Class Where TN='" & ParentID & "' Order BY TJ Asc", conn, 1, 3
If Not RSTS.EOF Then
Do While Not RSTS.EOF
OriSubClassID = RSTS("ID")
RSTS("TS") = SubDestTS & RSTS("ID") & ","
Folder = RSTS("Folder")
RSTS("Folder") = DestFolder & Split(Left(Folder, Len(Folder) - 1), "/")(UBound(Split(Left(Folder, Len(Folder) - 1), "/"))) & "/"
RSTS("TJ") = UBound(Split(RSTS("TS"), ","))
RSTS.Update
Call CutSubFolder(OriSubClassID, RSTS("TS"), RSTS("Folder"))
RSTS.MoveNext
Loop
End If
RSTS.Close
Set RSTS = Nothing
End Sub
'过程:PasteByCopy复制粘贴
'参数:SourceFolderID--源目录,DestFolderID--目标目录,FolderID---被复制的目录,ContentID---被复制的文件
Sub PasteByCopy(SourceFolderID, DestFolderID, FolderID, ContentID)
Dim RS, CheckRS, RSC, RSTS, I, DFolderID, OriFolderName, OriFolderID, DestTS, DestTJ, DestFolder, SubDest, SubDestFolderID, ClassID
Dim CurrTS, OriSubClassID
Dim NContentID, Folder
On Error Resume Next
'复制目录
If FolderID <> "0" Then
Set RS = Server.CreateObject("AdoDb.RecordSet")
'取得目标目录信息
RS.Open "Select TS,TJ,Folder From KS_Class Where ID='" & DestFolderID & "'", conn, 1, 1
DestTS = RS("TS")
DestTJ = RS("TJ")
DestFolder = RS("Folder")
RS.Close
DFolderID = Split(FolderID, ",")
If CheckOp(DestFolderID, DFolderID, "复制", True) Then '检查是否允许复制
Set CheckRS = Server.CreateObject("Adodb.RecordSet")
For I = LBound(DFolderID) To UBound(DFolderID)
RS.Open "Select * From KS_Class Where ID='" & DFolderID(I) & "'", conn, 1, 1
If Not RS.EOF Then
Folder = RS("Folder")
Folder = DestFolder & Split(Left(Folder, Len(Folder) - 1), "/")(UBound(Split(Left(Folder, Len(Folder) - 1), "/"))) & "/"
OriFolderName = RS("FolderName")
OriFolderID = RS("ID")
CheckRS.Open "Select * From KS_Class Where TN='" & DestFolderID & "' And FolderName='" & OriFolderName & "' And DelTF=0", conn, 1, 1
If Not CheckRS.EOF Then
Set RSC = Server.CreateObject("Adodb.RecordSet")
RSC.Open "Select * From KS_Class Where TN='" & DestFolderID & "' And FolderName Like '复制%" & OriFolderName & "' And DelTF=0 Order By CreateDate Desc", conn, 1, 1
If Not RSC.EOF Then
RSC.MoveFirst
If RSC.RecordCount = 1 Then
OriFolderName = "复制(1) " & OriFolderName
Else
OriFolderName = "复制(" & Left(Split(RSC("FolderName"), "(")(1), 1) + 1 & ") " & OriFolderName
End If
Else
OriFolderName = "复制 " & OriFolderName
End If
RSC.Close
Set RSC = Nothing
End If
CheckRS.Close
ClassID = KSCMS.GetClassID()
SubDestFolderID = ClassID
SubDest = AddCopyFolder(ClassID, OriFolderName, Folder, DestTS, DestTJ, DestFolderID, RS)
'复制原目录下的文章到新目录
Call AddCopyArticle(0, True, DFolderID(I), ClassID)
'复制该目录下子目录
Call CopySubFolder(OriFolderID, ClassID, Split(SubDest, "|||")(0), Split(SubDest, "|||")(1))
RS.Close
Else
RS.Close
Set RS = Nothing
Call KSCMS.AlertHistory("参数传递出错!", 1)
Exit Sub
Set KSCMS = Nothing
End If
Next
End If
End If
Set RS = Nothing
'复制文章
If ContentID <> "0" Then
NContentID = Split(Replace(Replace(ContentID, "','", ","), "'", ""), ",")
Set RS = Server.CreateObject("Adodb.RecordSet")
For I = LBound(NContentID) To UBound(NContentID)
RS.Open "Select NewsID,Tid From KS_Article Where NewsID='" & NContentID(I) & "' And DelTF=0", conn, 1, 1
Call AddCopyArticle(RS(0), True, RS(1), DestFolderID)
RS.Close
Next
End If
Set RS = Nothing
End Sub
'添加复制的目录
Function AddCopyFolder(ClassID, OriFolderName, Folder, DestTS, DestTJ, DestFolderID, RS)
Dim IRS
Set IRS = Server.CreateObject("AdoDb.RecordSet")
IRS.Open "Select * From KS_Class Where ID IS Null", conn, 1, 3
IRS.AddNew
IRS("ID") = ClassID
IRS("FolderName") = OriFolderName
IRS("TS") = DestTS & ClassID & ","
IRS("TN") = DestFolderID
IRS("TJ") = DestTJ + 1
IRS("Folder") = Folder
IRS("Creater") = RS("Creater")
IRS("CreateDate") = RS("CreateDate")
IRS("FolderTemplateID") = RS("FolderTemplateID")
IRS("TopFlag") = RS("TopFlag")
IRS("FolderFsoIndex") = RS("FolderFsoIndex")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -