📄 down_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 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 Down_Add
KSCls.Execute()
Set KSCls = Nothing
Class Down_Add
Private KSCMS
Private FolderID, DownTemplateID, DownFnameType, DownFsoType, TN, TI, Navigation, TJ, FolderName, TypeList, I, Action
Private RS, TemplateSql, TemplateRS, KeyWordList, AuthorList, OriginList, TemplateList, TemplateID, KeyRS, OriginRS
Private DownID, DownRS, Title, DownVerSion, PhotoUrl, BigPhoto, FlagUrl, DownContent, DownUrls, Recommend
Private Popular, Verific, Comment, ChangesUrl, KeyWords, Author, Origin, AddDate, Rank, Hits, HitsByDay, HitsByWeek, HitsByMonth
Private CurrPath, InstallDir, ParentID, UpPowerFlag,DownInput
Private DownLb, DownYY, DownSQ, DownPT, DownSize, SizeUnit, YSDZ, ZCDZ, JYMM
Private KeyWord, SearchType, StartDate, EndDate, Page, DisplayMode
Private ComeUrl,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 DownSave()
Else
Call DownAdd()
End If
End Sub
Sub DownAdd()
'On Error Resume Next
With Response
.Write "<script>parent.frames['LeftFrame'].LeftInfoFrame.SetEnabledStatus(true);</script>"
CurrPath = KSCMS.ReturnChannelUpFilesDir(3)
Set RS = Server.CreateObject("ADODB.RecordSet")
If Action = "Add" Then
FolderID = Trim(KSCMS.G("FolderID"))
If Not KSCMS.ReturnPowerResult(3, "KMD10012") Then '检查是否有添加下载的权限
.Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & FolderID & "';</script>")
Call KSCMS.ReturnErr(2, "Down_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&ID=" & FolderID)
Exit Sub
End If
Hits = 0:HitsByDay = 0:HitsByWeek = 0:HitsByMonth = 0:FlagUrl = 0:Comment = 1
KeyWords = Session("keywords")
Author = Session("Author")
Origin = Session("Origin")
DownPT = "Win9x/NT/2000/XP":SizeUnit = "KB":YSDZ = "http://":ZCDZ = "http://"
ElseIf Action = "Edit" Then
DownID = Trim(KSCMS.G("DownID"))
Set DownRS = Server.CreateObject("ADODB.RECORDSET")
DownRS.Open "Select * From KS_DownLoad Where DownID='" & DownID & "'", conn, 1, 1
If DownRS.EOF And DownRS.BOF Then
Call KSCMS.Alert("参数传递出错!", "Down_Main.asp")
Set KSCMS = Nothing
Response.End
Exit Sub
End If
DownID = Trim(DownRS("DownID"))
FolderID = Trim(DownRS("Tid"))
If Not KSCMS.ReturnPowerResult(3, "KMD10013") Then '检查是否有编辑下载的权限
DownRS.Close
Set DownRS = Nothing
If KeyWord = "" Then
.Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?ButtonSymbol=ViewFolder&FolderID=" & FolderID & "';</script>")
Call KSCMS.ReturnErr(1, "Down_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&ID=" & FolderID)
Else
.Write ("<script>parent.frames['BottomFrame'].location.href='../Split.asp?OpStr=下载管理 >> <font color=red>搜索下载结果</font>&ButtonSymbol=DownSearch';</script>")
Call KSCMS.ReturnErr(1, "Down_Main.asp?DisplayMode=" & DisplayMode & "&Page=" & Page & "&KeyWord=" & KeyWord & "&SearchType=" & SearchType & "&StartDate=" & StartDate & "&EndDate=" & EndDate)
End If
Exit Sub
End If
Title = Trim(DownRS("title"))
DownVerSion = Trim(DownRS("DownVerSion"))
PhotoUrl = Trim(DownRS("PhotoUrl")) '缩略图
BigPhoto = Trim(DownRS("BigPhoto")) '大图
DownLb = Trim(DownRS("DownLB"))
DownYY = Trim(DownRS("DownYY"))
DownSQ = Trim(DownRS("DownSQ"))
DownPT = Trim(DownRS("DownPT"))
DownSize = Trim(DownRS("DownSize"))
SizeUnit = Right(DownSize, 2)
DownSize = Replace(DownSize, SizeUnit, "")
If DownSize = 0 Then
DownSize = ""
End If
YSDZ = Trim(DownRS("YSDZ"))
ZCDZ = Trim(DownRS("ZCDZ"))
JYMM = Trim(DownRS("JYMM"))
FlagUrl = DownRS("FlagUrl")
DownUrls = Trim(DownRS("DownUrls"))
DownContent = Trim(DownRS("DownContent"))
Recommend = CInt(DownRS("Recommend"))
Popular = CInt(DownRS("Popular"))
Verific = CInt(DownRS("Verific"))
Comment = CInt(DownRS("Comment"))
AddDate = CDate(DownRS("AddDate"))
Rank = Trim(DownRS("Rank"))
DownFnameType = Trim(Mid(Trim(DownRS("Fname")), InStrRev(Trim(DownRS("Fname")), ".")))
DownTemplateID = CInt(DownRS("TemplateID"))
DownFsoType = CInt(DownRS("DownFsoType"))
Hits = Trim(DownRS("Hits"))
HitsByDay = Trim(DownRS("HitsByDay"))
HitsByWeek = Trim(DownRS("HitsByWeek"))
HitsByMonth = Trim(DownRS("HitsByMonth"))
KeyWords = Trim(DownRS("KeyWords"))
Author = Trim(DownRS("Author"))
Origin = Trim(DownRS("Origin"))
FolderID = DownRS("Tid")
DownRS.Close:Set DownRS = Nothing
End If
'取得上传权限
UpPowerFlag = KSCMS.ReturnPowerResult(3, "KMD10016")
'取得目录导航
RS.Open "Select * From [KS_Class] Where ID='" & FolderID & "'", conn, 1, 1
If Not RS.EOF Then
'获取目录参数
If Action = "Add" Or Action="Verify" Then
DownTemplateID = RS("ArticleTemplateid")
DownFnameType = Trim(RS("ArticleFnameType"))
DownFsoType = RS("ArticleFsoType")
End If
TI = Split(RS("TS"), ",")
TJ = RS("tj")
ParentID = RS("TN")
Else
Call KSCMS.Alert("提示信息:\n\n您没有选择下载目录!", "Down_Main.asp")
Set KSCMS = Nothing
Response.End
End If
RS.Close
Set RS = Nothing
'取得目录树,同时为了提高执行速度,采用Application缓存,减小访问数据库
If Trim(Application(KSCMS.SiteSN & "AddDownFolderID")) <> Trim(FolderID) Or Application(KSCMS.SiteSN & "AddDownTreeList") = "" Then
TypeList = KSCMS.ReturnTree(FolderID, 3)
Application(KSCMS.SiteSN & "AddDownFolderID") = FolderID
Application(KSCMS.SiteSN & "AddDownTreeList") = TypeList
Else
TypeList = Application(KSCMS.SiteSN & "AddDownTreeList")
End If
'取得下载参数
Dim DownLBList, DownYYList, DownSQList, DownPTList, RSP, DownLBStr, LBArr, YYArr, SQArr, PTArr, DownYYStr, DownSQStr, DownPTStr
Set RSP = Server.CreateObject("Adodb.RecordSet")
RSP.Open "Select * From KS_DownParam", conn, 1, 1
If Not RSP.Eof Then
DownLBStr = RSP("DownLB")
DownYYStr = RSP("DownYY")
DownSQStr = RSP("DownSQ")
DownPTStr = RSP("DownPT")
End If
RSP.Close
Set RSP = Nothing
'下载类别
' DownLBList="<option value="""" selected> </option>"
LBArr = Split(DownLBStr, vbCrLf)
For I = 0 To UBound(LBArr)
If LBArr(I) = DownLb Then
DownLBList = DownLBList & "<option value='" & LBArr(I) & "' Selected>" & LBArr(I) & "</option>"
Else
DownLBList = DownLBList & "<option value='" & LBArr(I) & "'>" & LBArr(I) & "</option>"
End If
Next
'下载语言
' DownYYList="<option value="""" selected> </option>"
YYArr = Split(DownYYStr, vbCrLf)
For I = 0 To UBound(YYArr)
If YYArr(I) = DownYY Then
DownYYList = DownYYList & "<option value='" & YYArr(I) & "' Selected>" & YYArr(I) & "</option>"
Else
DownYYList = DownYYList & "<option value='" & YYArr(I) & "'>" & YYArr(I) & "</option>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -