picture_paste.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

<%@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  :[e-mail] [e-mail]
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New Picture_Paste
KSCls.Execute()
Set KSCls = Nothing

Class Picture_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(2, "KMP10017") 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='Picture_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_Photo Set Tid='" & DestFolderID & "'  Where PicID 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 PicID,Tid From KS_Photo Where PicID='" & 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")