📄 upfilesave.asp
字号:
<% Option Explicit %>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../../SysCls/KS_Thumbs.asp"-->
<!--#include file="../Inc/Session.asp"-->
<!--#include file="Upfile.asp" -->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统2006 SP1无组件精装版(Access)版本
'最后更新：2006年4月2日
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294,504438432
'技术支持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 UpFileSave
KSCls.Execute()
Set KSCls = Nothing
Class UpFileSave
Private KSCMS
Dim FilePath,MaxFileSize,AllowFileExtStr,AutoReName,RsConfigObj
Dim FormName,Path,UpLoadFrom,TempFileStr,FormPath,ThumbFileName,ThumbPathFileName
Dim UpFileObj,FsoObjName,AddWaterFlag,T,CurrNum,CreateThumbsFlag
Dim DefaultThumb '设定第几张为缩略图
Dim ReturnValue
Private Sub Class_Initialize()
Set T=New Thumb
Set KSCMS=New CommonCls
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConn()
Set T=Nothing
Set KSCMS=Nothing
End Sub
Sub Execute()
Response.Write("<style type='text/css'>" & vbcrlf)
Response.Write("<!--" & vbcrlf)
Response.Write("body {" & vbcrlf)
Response.Write(" margin-left: 0px;" & vbcrlf)
Response.Write(" margin-top: 0px;" & vbcrlf)
Response.Write("}" & vbcrlf)
Response.Write("-->" & vbcrlf)
Response.Write("</style>" & vbcrlf)
FsoObjName=KSCMS.GetConfig("FsoObjName")
Set UpFileObj = New UpFileClass
UpFileObj.GetData
FormPath=UpFileObj.Form("Path")
IF Instr(FormPath,KSCMS.GetConfig("InstallDir"))=0 Then
FormPath=KSCMS.GetConfig("InstallDir") & FormPath
End IF
Call KSCMS.CreateListFolder(FormPath) '生成上传文件存放目录
FilePath=Server.MapPath(FormPath) & "\"
'Response.Write FormPath
'Response.End
AutoReName = UpFileObj.Form("AutoRename")
UpLoadFrom=UpFileObj.Form("UpLoadFrom") '0--通用对话框 2-- 图片中心上传 31--下载中心缩略图 32--下载中心文件 41--Flash中心缩略图 42--Flash中心的Flash文件
IF UpLoadFrom="" then
UpLoadFrom=0
End IF
CurrNum=0
CreateThumbsFlag=false
DefaultThumb=UpFileObj.Form("DefaultUrl")
if DefaultThumb="" then DefaultThumb=0
AddWaterFlag = UpFileObj.Form("AddWaterFlag")
If AddWaterFlag <> "1" Then '生成是否要添加水印标记
AddWaterFlag = "0"
End if
'设置文件上传限制,类型及大小
Select Case UpLoadFrom
Case 0 '默认上传参数
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(0) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(0,0)
Case 1 '文章中心
CreateThumbsFlag=true
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(1) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(1,0)
Case 11 '文章中心缩略图
CreateThumbsFlag=true
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(1) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(1,1)
Case 2 '图片中心
CreateThumbsFlag=true
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(2) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(2,0)
Case 21 '图片中心上传图片
CreateThumbsFlag=true
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(2) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(2,1)
Case 31 '下载中心缩略图
CreateThumbsFlag=true
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(3) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(3,1)
Case 32,3 '下载中心文件
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(3) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(3,0)
Case 41 'Flash中心缩略图
CreateThumbsFlag=true
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(4) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(4,1)
Case 42 'Flash文件
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(4) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(4,2) '取允许上传的Flash类型
Case 4 'Flash简介上传
MaxFileSize = KSCMS.ReturnChannelAllowUpFilesSize(4) '设定文件上传最大字节数
AllowFileExtStr = KSCMS.ReturnChannelAllowUpFilesType(4,0)
End Select
ReturnValue = CheckUpFile(FilePath,MaxFileSize,AllowFileExtStr,AutoReName)
Select Case UpLoadFrom
Case 11 '文章中心的上传缩略图
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
Response.Write("<script language=""JavaScript"">")
if DefaultThumb=0 then
Response.Write("parent.document.all.PicUrl.value='" & replace(TempFileStr,"|","") & "';")
else
If KSCMS.CheckFile(ThumbPathFileName)=true Then '检查是否存在缩略图
Response.Write("parent.document.all.PicUrl.value='" & ThumbPathFileName & "';")
' Call KSCMS.DeleteFile(replace(TempFileStr,"|","")) '删除原图片
Else
Response.Write("parent.document.all.PicUrl.value='" & replace(TempFileStr,"|","") & "';")
End If
Response.Write("parent.ArticleContent.InsertPictureFromUp('" & replace(TempFileStr,"|","") &"');")
end if
Response.Write("document.write(' <font size=2>图片上传成功！</font>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'2; url=../Article/Article_UpPhotoForm.asp\'>');")
Response.Write("</script>")
end if
Case 21 '图片中心的上传图片
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
Response.Write("<script language=""JavaScript"">")
Response.Write("parent.SetPicUrlByUpLoad('" & TempFileStr & "','" & ThumbPathFileName & "');")
Response.Write("document.write('<br><br><div align=center><font size=2>图片上传成功！</font></div>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'1; url=../Picture/Picture_UpForm.asp\'>');")
Response.Write("</script>")
end if
Case 31 '下载中心缩略图
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
Response.Write("<script language=""JavaScript"">")
if DefaultThumb=0 then
Response.Write("parent.DownForm.PhotoUrl.value='" & replace(TempFileStr,"|","") & "';")
Response.Write("parent.DownForm.BigPhoto.value='" & replace(TempFileStr,"|","") & "';")
else
Response.Write("parent.DownForm.PhotoUrl.value='" & ThumbPathFileName & "';")
Response.Write("parent.DownForm.BigPhoto.value='" & replace(TempFileStr,"|","") & "';")
end if
Response.Write("document.write(' <font size=2>图片上传成功！</font>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'2; url=../DownLoad/Down_UpPhotoForm.asp\'>');")
Response.Write("</script>")
end if
Case 32 '下载中心的文件
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
Response.Write("<script language=""JavaScript"">")
Response.Write("parent.SetDownUrlByUpLoad('" & TempFileStr & "');")
Response.Write("document.write('<br><br><div align=center><font size=2>文件上传成功！</font></div>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'1; url=../DownLoad/Down_UpForm.asp\'>');")
Response.Write("</script>")
end if
Case 41 'Flash中心的上传缩略图
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
Response.Write("<script language=""JavaScript"">")
if DefaultThumb=0 Or KSCMS.CheckFile(ThumbPathFileName)=false then '检查是否存在缩略图
Response.Write("parent.document.all.PhotoUrl.value='" & replace(TempFileStr,"|","") & "';")
Response.Write("parent.PreViewPic('" & replace(TempFileStr,"|","") & "');")
else
Response.Write("parent.document.all.PhotoUrl.value='" & ThumbPathFileName & "';")
Response.Write("parent.PreViewPic('" & ThumbPathFileName & "');")
Call KSCMS.DeleteFile(replace(TempFileStr,"|","")) '删除原图片
end if
Response.Write("document.write(' <font size=2>图片上传成功！</font>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'2; url=../Flash/Flash_UpPhotoForm.asp\'>');")
Response.Write("</script>")
end if
Case 42 'Flash文件
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
Response.Write("<script language=""JavaScript"">")
Response.Write("parent.document.all.FlashUrl.value='" & replace(TempFileStr,"|","") & "';")
Response.Write("document.write('<br><br><div align=center><font size=2>文件上传成功！</font></div>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'1; url=../Flash/Flash_UpFlashForm.asp\'>');")
Response.Write("</script>")
end if
Case else
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">"&vbcrlf)
Response.Write("alert('" & ReturnValue & "');"&vbcrlf)
Response.Write("dialogArguments.location.reload();"&vbcrlf)
Response.Write("close();"&vbcrlf)
Response.Write("</script>"&vbcrlf)
else
Response.Write("<script language=""JavaScript"">"&vbcrlf)
Response.Write("dialogArguments.location.reload();"&vbcrlf)
Response.Write("close();"&vbcrlf)
Response.Write("</script>"&vbcrlf)
end if
End Select
Set UpFileObj=Nothing
End Sub
Function CheckUpFile(Path,FileSize,AllowExtStr,AutoReName)
Dim ErrStr,NoUpFileTF,FsoObj,FileName,FileExtName,FileContent,SameFileExistTF
NoUpFileTF = True
ErrStr = ""
Set FsoObj = Server.CreateObject(FsoObjName)
For Each FormName in UpFileObj.File
SameFileExistTF = False
FileName = UpFileObj.File(FormName).FileName
FileExtName = UpFileObj.File(FormName).FileExt
FileContent = UpFileObj.File(FormName).FileData
'是否存在重名文件
if UpFileObj.File(FormName).FileSize > 1 then
NoUpFileTF = False
ErrStr = ""
if UpFileObj.File(FormName).FileSize > CLng(FileSize)*1024 then
ErrStr = ErrStr & FileName & "文件上传失败\n超过了限制，最大只能上传" & FileSize & "K的文件\n"
end if
if AutoRename = "0" then
If FsoObj.FileExists(Path & FileName) = True then
ErrStr = ErrStr & FileName & "文件上传失败,存在同名文件\n"
else
SameFileExistTF = True
end if
else
SameFileExistTF = True
End If
if CheckFileType(AllowExtStr,FileExtName) = False then
ErrStr = ErrStr & FileName & "文件上传失败,文件类型不允许\n允许的类型有" + AllowExtStr + "\n"
end if
if ErrStr = "" then
if SameFileExistTF = True then
SaveFile Path,FormName,AutoReName
else
SaveFile Path,FormName,""
end if
else
CheckUpFile = CheckUpFile & ErrStr
end if
end if
Next
Set FsoObj = Nothing
if NoUpFileTF = True then
CheckUpFile = "没有上传文件"
end if
End Function
Function CheckFileType(AllowExtStr,FileExtName)
Dim i,AllowArray
AllowArray = Split(AllowExtStr,"|")
FileExtName = LCase(FileExtName)
CheckFileType = False
For i = LBound(AllowArray) to UBound(AllowArray)
if LCase(AllowArray(i)) = LCase(FileExtName) then
CheckFileType = True
end if
Next
if FileExtName="asp" or FileExtName="asa" or FileExtName="aspx" then
CheckFileType = False
end if
End Function
Function SaveFile(FilePath,FormNameItem,AutoNameType)
Dim FileName,FileExtName,FileContent,FormName,RandomFigure,n,RndStr
Randomize
n=2* Rnd+10
RndStr=KSCMS.MakeRandom(n)
RandomFigure = CStr(Int((99999 * Rnd) + 1))
FileName = UpFileObj.File(FormNameItem).FileName
FileExtName = UpFileObj.File(FormNameItem).FileExt
FileContent = UpFileObj.File(FormNameItem).FileData
select case AutoNameType
case "1"
FileName= "副件" & FileName
case "2"
FileName= RndStr&"."&FileExtName
Case "3"
FileName= RndStr & FileName
case "4"
FileName= Year(Now())&Right("0"&Month(Now()),2)&Right("0"&Day(Now()),2)&Right("0"&Hour(Now()),2)&Right("0"&Minute(Now()),2)&Right("0"&Second(Now()),2)&RandomFigure&"."&FileExtName
case else
FileName=FileName
End Select
UpFileObj.File(FormNameItem).SaveToFile FilePath &FileName
TempFileStr=TempFileStr & FormPath & FileName & "|"
If AddWaterFlag = "1" Then '在保存好的图片上添加水印
call T.AddWaterMark(FilePath & FileName)
End if
CurrNum=CurrNum+1
IF CreateThumbsFlag=true and cint(CurrNum)=cint(DefaultThumb) Then
ThumbFileName=split(FileName,".")(0)&"_S."&FileExtName
call T.CreateThumbs(FilePath & FileName,FilePath & ThumbFileName)
'取得缩略图地址
ThumbPathFileName=FormPath & ThumbFileName
End if
End Function
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -