⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 picture_add.asp

📁 SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.
💻 ASP
📖 第 1 页 / 共 3 页
字号:
<%@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 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 Picture_Add
KSCls.Execute()
Set KSCls = Nothing

Class Picture_Add
        Private KSCMS
		Private FolderID, PictureTemplateID, PictureFnameType, PictureFsoType, TN, TI, Navigation, TJ, FolderName, TypeList, I, Action
		Private RS, TemplateSql, TemplateRS, KeyWordList, AuthorList, OriginList, TemplateList, TemplateID, KeyRS, OriginRS
		Private PicID, PictureRS, Title, PhotoUrl, PictureContent, PicUrls, Recommend
		Private Popular, Strip, Verific, Comment, Slide, BeyondSavePic, ChangesUrl, Rolls, KeyWords, Author, Origin, AddDate, Rank, Hits, HitsByDay, HitsByWeek, HitsByMonth
		Private CurrPath, InstallDir, ParentID, PreViewObj, UpPowerFlag
		Private PictureInput,SaveFilePath
		Private KeyWord, SearchType, StartDate, EndDate, Page, DisplayMode,ComeUrl
		Private SqlStr,Errmsg,Makehtml,FnameType,Tid,Fname,KSRObj
		Private ReadPoint,ChargeType,PitchTime,ReadTimes,InfoPurview,arrGroupID,DividePercent
		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		End Sub
        Private Sub Class_Terminate()
		 Call KSCMS.CloseConn()
		 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")
			Action = Trim(KSCMS.G("Action"))
			Page = KSCMS.G("page")
			DisplayMode = KSCMS.G("DisplayMode")
				
			IF KSCMS.G("Method")="Save" Then
				 Call PictureSave()
			Else 
				 Call PictureAdd()
			End If
		End Sub

        '添加
        Sub PictureAdd() 
			With Response
			 .Write "<script>parent.frames['LeftFrame'].LeftInfoFrame.SetEnabledStatus(true);</script>"
			CurrPath = KSCMS.ReturnChannelUpFilesDir(2)
						
			Set RS = Server.CreateObject("ADODB.RecordSet")
			If Action = "Add" Then
			  FolderID = Trim(KSCMS.G("FolderID"))
			  
			  If Not KSCMS.ReturnPowerResult(2, "KMP10012") Then          '检查是否有添加图片的权限
			   .Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & FolderID & "';</script>")
			   Call KSCMS.ReturnErr(2, "Picture_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&ID=" & FolderID)
			   Exit Sub
			  End If
			  Hits = 0:HitsByDay = 0: HitsByWeek = 0:HitsByMonth = 0:Comment = 1
			  PreViewObj = "<br><br><br>图片预览区"
			  KeyWords = Session("keywords")
			  Author = Session("Author")
			  Origin = Session("Origin")
			ElseIf Action = "Edit" Then
			
			   PicID = Trim(KSCMS.G("PicID"))
			   Set PictureRS = Server.CreateObject("ADODB.RECORDSET")
			   PictureRS.Open "Select * From KS_Photo Where PicID='" & PicID & "'", conn, 1, 1
			   If PictureRS.EOF And PictureRS.BOF Then
				Call KSCMS.Alert("参数传递出错!", ComeUrl)
				Set KSCMS = Nothing:.End:Exit Sub
			   End If
				PicID = Trim(PictureRS("PicID"))
				FolderID = Trim(PictureRS("Tid"))
				
				If Not KSCMS.ReturnPowerResult(2, "KMP10013") Then     '检查是否有编辑图片的权限
				PictureRS.Close:Set PictureRS = Nothing
				 If KeyWord = "" Then
				  .Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & FolderID & "';</script>")
				  Call KSCMS.ReturnErr(1, "Picture_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&ID=" & FolderID)
				 Else
				  .Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?OpStr=图片管理 >> <font color=red>搜索图片结果</font>&ButtonSymbol=PictureSearch';</script>")
				  Call KSCMS.ReturnErr(1, "Picture_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&KeyWord=" & KeyWord & "&SearchType=" & SearchType & "&StartDate=" & StartDate & "&EndDate=" & EndDate)
				 End If
				 Exit Sub
			   End If
			   
				Title = Trim(PictureRS("title"))
				PhotoUrl = Trim(PictureRS("PhotoUrl"))
				PreViewObj = "<img src='" & PhotoUrl & "' border='0'>"
				PicUrls = Trim(PictureRS("PicUrls"))
				PictureContent = Trim(PictureRS("PictureContent"))
				Rolls = CInt(PictureRS("Rolls"))
				Strip = CInt(PictureRS("Strip"))
				Recommend = CInt(PictureRS("Recommend"))
				Popular = CInt(PictureRS("Popular"))
				Verific = CInt(PictureRS("Verific"))
				Comment = CInt(PictureRS("Comment"))
				Slide = CInt(PictureRS("Slide"))
				BeyondSavePic = CInt(PictureRS("BeyondSavePic"))
				AddDate = CDate(PictureRS("AddDate"))
				Rank = Trim(PictureRS("Rank"))
				PictureFnameType = Trim(Mid(Trim(PictureRS("Fname")), InStrRev(Trim(PictureRS("Fname")), ".")))
				PictureTemplateID = CInt(PictureRS("TemplateID"))
				PictureFsoType = CInt(PictureRS("PictureFsoType"))
				Hits = Trim(PictureRS("Hits"))
				HitsByDay = Trim(PictureRS("HitsByDay"))
				HitsByWeek = Trim(PictureRS("HitsByWeek"))
				HitsByMonth = Trim(PictureRS("HitsByMonth"))
				KeyWords = Trim(PictureRS("KeyWords"))
				Author = Trim(PictureRS("Author"))
				Origin = Trim(PictureRS("Origin"))
				FolderID = PictureRS("Tid")
				PictureRS.Close:Set PictureRS = Nothing
			End If
			'取得上传权限
			UpPowerFlag = KSCMS.ReturnPowerResult(2, "KMP10016")
			
			
			'取得目录导航
			RS.Open "Select * From [KS_Class] Where ID='" & FolderID & "'", conn, 1, 1
				If Not RS.EOF Then
				  '获取目录参数
				  If Action = "Add" Or Action="Verify" Then
				   PictureTemplateID = RS("ArticleTemplateid")
				   PictureFnameType = Trim(RS("ArticleFnameType"))
				   PictureFsoType = RS("ArticleFsoType")
				  End If
				  TI = Split(RS("TS"), ",")
				  TJ = RS("tj")
				  ParentID = RS("TN")
				Else
				  Call KSCMS.Alert("提示信息:\n\n您没有选择图片目录!", "Picture_Main.asp")
				  Set KSCMS = Nothing
				  .End
				End If
			  RS.Close
			 Set RS = Nothing
			 
			 '取得目录树,同时为了提高执行速度,采用Application缓存,减小访问数据库
			 If Trim(Application(KSCMS.SiteSN & "AddPictureFolderID")) <> Trim(FolderID) Or Application(KSCMS.SiteSN & "AddPictureTreeList") = "" Then
			  TypeList = KSCMS.ReturnTree(FolderID, 2)
			  Application(KSCMS.SiteSN & "AddPictureFolderID") = FolderID
			  Application(KSCMS.SiteSN & "AddPictureTreeList") = TypeList
			 Else
			  TypeList = Application(KSCMS.SiteSN & "AddPictureTreeList")
			 End If
				
			'取得关键字
			   KeyWordList = "<option value="""" selected> </option><option value=""Clean"" style=""color:red"">清空</option>"
			   Set KeyRS = conn.Execute("Select KeyText FROM [KS_KeyWords] Where ChannelID=2 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=2 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
			  
			'取得来源列表
			 OriginList = "<option value="""" selected> </option><option value="""" style=""color:red"">清空</option>"
			  Set OriginRS = conn.Execute("Select OriginName FROM [KS_Origin] Where ChannelID=2 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
			  
			'取得模板列表
			   TemplateSql = "Select TemplateID,TemplateName,IsDefault From KS_Template Where ChannelID=2 And TemplateType=3 Order By TemplateID" '3图片内容页模板
			   Set TemplateRS = conn.Execute(TemplateSql)
					If TemplateRS.EOF And TemplateRS.BOF Then
						 TemplateList = "<option value=0>请先添加图片模板</option>"
					Else
						 Do While Not TemplateRS.EOF
						  If CInt(TemplateRS(0)) = CInt(PictureTemplateID) Then
						  TemplateList = TemplateList & "<option value=" & TemplateRS(0) & " selected>" & TemplateRS(1) & "</option>"
						  Else
						  TemplateList = TemplateList & "<option value=" & TemplateRS(0) & ">" & TemplateRS(1) & "</option>"
						  End If
						 TemplateRS.MoveNext
						 Loop
				 End If
				 TemplateRS.Close:Set TemplateRS = Nothing
			
			.Write "<html>"
			.Write "<head>"
			.Write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"
			.Write "<title>添加图片</title>"
			.Write "<link href='../Inc/Admin_Style.CSS' rel='stylesheet' type='text/css'>"
			.Write "<script language='JavaScript' src='../JS/Common.js'></script>"
			.Write "<script>var PicUrls='" & PicUrls & "';</script>"
			.Write "<script language='JavaScript' src='../Common/PictureAdd.JS'></script>"
			.Write "</head>"
			.Write "<body leftmargin='0' topmargin='0' marginwidth='0' onkeydown='if (event.keyCode==83 && event.ctrlKey) SubmitFun();' marginheight='0'>"
			.Write "<div align='center'>"
			.Write " <TABLE width='100%' height='100%' BORDER='0' cellpadding='0'  cellspacing='0' style='border-collapse: collapse'>"
			.Write "    <form action='Picture_Add.asp?Method=Save&PictureFsoType=" & PictureFsoType & "' method='post' name='PictureForm' onsubmit='return(SubmitFun())'>"
			.Write "      <input type='hidden' value='" & PicID & "' name='PicID'>"
			.Write "      <input type='hidden' value='" & Action & "' name='Action'>"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -