📄 down_paste.asp
字号:
IRS("FolderTemplateID") = RS("FolderTemplateID")
IRS("TopFlag") = RS("TopFlag")
IRS("FolderFsoIndex") = RS("FolderFsoIndex")
IRS("ArticleTemplateID") = RS("ArticleTemplateID")
IRS("ArticleFnameType") = RS("ArticleFnameType")
IRS("ArticleFsoType") = RS("ArticleFsoType")
IRS("FolderDomain") = RS("FolderDomain")
IRS("FolderOrder") = RS("FolderOrder")
IRS("ChannelID") = RS("ChannelID")
IRS("DelTF") = RS("DelTF")
IRS("OrderID") = RS("OrderID")
IRS.Update
AddCopyFolder = IRS("TS") & "|||" & IRS("Folder")
IRS.Close
Set IRS = Nothing
End Function
'添加复制的图片
'参数NewID--当前图片的ID，取0代表复制目录下的所有图片 ，Flag true--取"复制(n)"样式,OriFolderID--原图片所在目录的ID,NewClassID--图片的新目录
Function AddCopyArticle(NewID, Flag, OriFolderID, NewClassID)
Dim RS, IRS, DownID, OriTitle, SQLStr
Set RS = Server.CreateObject("Adodb.RecordSet")
If NewID = 0 Then
SQLStr = "Select * From KS_DownLoad Where Tid='" & OriFolderID & "' And DelTF=0"
Else
SQLStr = "Select * From KS_DownLoad Where DownID='" & NewID & "' And DelTF=0"
End If
RS.Open SQLStr, conn, 1, 1
If Not RS.EOF Then
Set IRS = Server.CreateObject("Adodb.RecordSet")
Do While Not RS.EOF
If Flag = True Then
OriTitle = GetNewTitle(NewClassID, RS("Title"))
Else
OriTitle = RS("Title")
End If
IRS.Open "Select * From KS_DownLoad Where DownID is Null", conn, 1, 3
IRS.AddNew
'图片ID
DownID = KSCMS.GetInfoID(3) '取唯一ID
IRS("DownID") = DownID
IRS("Title") = OriTitle
IRS("DownVerSion") = RS("DownVerSion")
IRS("DownLB") = RS("DownLB")
IRS("DownYY") = RS("DownYY")
IRS("DownSQ") = RS("DownSQ")
IRS("DownPT") = RS("DownPT")
IRS("DownSize") = RS("DownSize")
IRS("YSDZ") = RS("YSDZ")
IRS("ZCDZ") = RS("ZCDZ")
IRS("JYMM") = RS("JYMM")
IRS("PhotoUrl") = RS("PhotoUrl")
IRS("BigPhoto") = RS("BigPhoto")
IRS("FlagUrl") = RS("FlagUrl")
IRS("DownUrls") = RS("DownUrls")
IRS("DownContent") = RS("DownContent")
IRS("Recommend") = RS("Recommend")
IRS("Popular") = RS("Popular")
IRS("Verific") = RS("Verific")
IRS("Tid") = NewClassID
IRS("KeyWords") = RS("KeyWords")
IRS("Author") = RS("Author")
IRS("Origin") = RS("Origin")
IRS("AddDate") = RS("AddDate")
IRS("Rank") = RS("Rank")
IRS("TemplateID") = RS("TemplateID")
IRS("LastHitsTime") = RS("LastHitsTime")
IRS("Hits") = RS("Hits")
IRS("HitsByDay") = RS("HitsByDay")
IRS("HitsByWeek") = RS("HitsByWeek")
IRS("HitsByMonth") = RS("HitsByMonth")
IRS("DownFsoType") = RS("DownFsoType")
IRS("Fname") = KSCMS.MakeRandom(15) & Mid(Trim(RS("Fname")), InStrRev(Trim(RS("Fname")), "."))
IRS("DownInput") = RS("DownInput")
IRS("RefreshTF") = RS("RefreshTF")
IRS("DelTF") = 0
IRS("OrderID") = 1
IRS.Update
RS.MoveNext
IRS.Close
Loop
Else
RS.Close
Set RS = Nothing
Exit Function
End If
RS.Close
Set RS = Nothing
Set IRS = Nothing
End Function
Function GetNewTitle(NewClassID, OriTitle)
Dim RSC, CheckRS
On Error Resume Next
Set RSC = Server.CreateObject("Adodb.RecordSet")
Set CheckRS = Server.CreateObject("Adodb.RecordSet")
CheckRS.Open "Select * From KS_DownLoad Where TID='" & NewClassID & "' And Title='" & OriTitle & "' And DelTF=0", conn, 1, 1
If Not CheckRS.EOF Then
RSC.Open "Select * From KS_DownLoad Where TID='" & NewClassID & "' And Title Like '复制%" & OriTitle & "' And DelTF=0 Order By ID Desc", conn, 1, 1
If Not RSC.EOF Then
RSC.MoveFirst
If RSC.RecordCount = 1 Then
RSC.Close
Set RSC = Nothing
CheckRS.Close
Set CheckRS = Nothing
GetNewTitle = "复制(1) " & OriTitle
Exit Function
Else
GetNewTitle = "复制(" & CInt(Left(Split(RSC("Title"), "(")(1), 1)) + 1 & ") " & OriTitle
End If
CheckRS.Close
RSC.Close
Set RSC = Nothing
Set CheckRS = Nothing
Else
RSC.Close
Set RSC = Nothing
CheckRS.Close
Set CheckRS = Nothing
GetNewTitle = "复制 " & OriTitle
Exit Function
End If
RSC.Close
Set RSC = Nothing
Else
CheckRS.Close
Set CheckRS = Nothing
GetNewTitle = OriTitle
Exit Function
End If
End Function
'复制子目录
Sub CopySubFolder(ParentID, SubDestFolder, SubDestTS, DestFolder)
Dim RSTS, OriSubClassID, ClassID, Curr, Folder
Set RSTS = Server.CreateObject("Adodb.RecordSet")
RSTS.Open "Select * From KS_Class Where TN='" & ParentID & "' And DelTF=0 Order BY TJ Asc", conn, 1, 1
If Not RSTS.EOF Then
Do While Not RSTS.EOF
OriSubClassID = RSTS("ID")
Folder = RSTS("Folder")
Folder = DestFolder & Split(Left(Folder, Len(Folder) - 1), "/")(UBound(Split(Left(Folder, Len(Folder) - 1), "/"))) & "/"
ClassID = KSCMS.GetClassID()
Curr = AddCopyFolder(ClassID, RSTS("FolderName"), Folder, SubDestTS, UBound(Split(RSTS("TS"), ",")) - 1, SubDestFolder, RSTS)
'复制子目录下的图片到新子目录
Call AddCopyArticle(0, False, OriSubClassID, ClassID)
Call CopySubFolder(OriSubClassID, ClassID, Split(Curr, "|||")(0), Split(Curr, "|||")(1))
RSTS.MoveNext
Loop
End If
RSTS.Close
Set RSTS = Nothing
End Sub
'检查是否允许操作
Function CheckOp(DestFolderID, DFolderID, OpStr, SFlag)
Dim RS, ObjRS, I
Set RS = Server.CreateObject("Adodb.RecordSet")
Set ObjRS = Server.CreateObject("Adodb.RecordSet")
For I = LBound(DFolderID) To UBound(DFolderID)
RS.Open "Select TN,ID,TJ,TS,FolderName From KS_Class Where ID ='" & DFolderID(I) & "'", conn, 1, 1
If Not RS.EOF Then
ObjRS.Open "Select TS,ID,TJ,TN From KS_Class Where ID='" & DestFolderID & "'", conn, 1, 1
If Not ObjRS.EOF Then
If InStr(ObjRS("TS"), Trim(RS("TS"))) <> 0 Then '判断目标目录是否是该目录的子目录
If ObjRS("TJ") = RS("TJ") Then
RS.Close
ObjRS.Close
Set ObjRS = Nothing
Set RS = Nothing
CheckOp = False
Call KSCMS.AlertHistory("无法" & OpStr & ":目标目录和源目录相同!", 1)
Set KSCMS = Nothing
Exit Function
ElseIf ObjRS("TJ") > RS("TJ") Then
RS.Close
ObjRS.Close
Set ObjRS = Nothing
Set RS = Nothing
CheckOp = False
Call KSCMS.AlertHistory("无法" & OpStr & ":目标目录是源目录的子目录!", 1)
Set KSCMS = Nothing
Exit Function
End If
End If
ObjRS.Close
If Not SFlag Then
ObjRS.Open "Select FolderName From KS_Class Where FolderName='" & RS("FolderName") & "' And TN='" & DestFolderID & "'", conn, 1, 1
If Not ObjRS.EOF Then
RS.Close
ObjRS.Close
Set ObjRS = Nothing
Set RS = Nothing
CheckOp = False
Call KSCMS.AlertHistory("操作失败,存在相同目录名称!", 1)
Set KSCMS = Nothing
Exit Function
End If
ObjRS.Close
End If
RS.Close
Else
RS.Close
Set RS = Nothing
CheckOp = False
Call KSCMS.AlertHistory("参数传递出错!", 1)
Set KSCMS = Nothing
Exit Function
End If
Else
RS.Close
Set RS = Nothing
CheckOp = False
Call KSCMS.AlertHistory("参数传递出错!", 1)
Set KSCMS = Nothing
Exit Function
End If
Next
CheckOp = True
End Function
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -