📄 upfilesave.asp
字号:
<% Option Explicit %>
<!--#include file="User_conn.asp"-->
<%
'****************************************************
' Software name:Kesion CMS 4.5
' Email: service@kesion.com . QQ:111394,9537636
' Web: http://www.kesion.com http://www.kesion.cn
' Copyright (C) Kesion Network All Rights Reserved.
'****************************************************
Dim KSCls
Set KSCls = New UpFileSave
KSCls.Kesion()
Set KSCls = Nothing
Class UpFileSave
Private KS,KSUser
Dim FilePath,MaxFileSize,AllowFileExtStr,AutoReName,RsConfigObj
Dim FormName,Path,BasicType,ChannelID,UpType,TempFileStr,FormPath,ThumbFileName,ThumbPathFileName
Dim UpFileObj,FsoObjName,AddWaterFlag,T,CurrNum,CreateThumbsFlag,FieldName
Dim DefaultThumb '设定第几张为缩略图
Dim ReturnValue
Private Sub Class_Initialize()
Set T=New Thumb
Set KS=New PublicCls
Set KSUser = New UserCls
End Sub
Private Sub Class_Terminate()
Call CloseConn()
Set T=Nothing
Set KS=Nothing
Set KSUser=Nothing
End Sub
Sub Kesion()
Dim UserHS
Set UserHS = New Art_User
IF Cbool(UserHS.UserLoginChecked)=false then
Response.Write "<script>top.location.href ='login.asp' ;</script>"
Response.end
End If
If Trim(Request.ServerVariables("HTTP_REFERER"))="" Then
Response.Write "<script>alert('非法上传！');history.back();</script>"
Response.end
End If
if instr(lcase(Request.ServerVariables("HTTP_REFERER")),"user_upfile.asp")<=0 then
Response.Write "<script>alert('非法上传！');history.back();</script>"
Response.end
end if
IF GetFolderSize(KSUser.GetUserFolder(ksuser.username))/1024>=ChkClng(Setting(50)) Then
Response.Write "<script>alert('上传失败，您的可用空间不够！');history.back();</script>"
response.end
End If
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(" font-size: 12px;" & vbcrlf)
'Response.Write(" background:#EEF8FE;" & vbcrlf)
Response.Write("}" & vbcrlf)
Response.Write("-->" & vbcrlf)
Response.Write("</style>" & vbcrlf)
FsoObjName=Setting(99)
Set UpFileObj = New UpFileClass
UpFileObj.GetData
AutoReName = UpFileObj.Form("AutoRename")
BasicType=ChkClng(UpFileObj.Form("BasicType")) ' 2-- 图片中心上传 3--下载中心缩略图/文件 41--动漫中心缩略图 42--动漫中心的动漫文件
ChannelID=ChkClng(UpFileObj.Form("ChannelID"))
UpType=UpFileObj.Form("Type")
IF BasicType=0 then
Response.Write "<script>alert('请不要非法上传！');history.back();</script>"
Response.end
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
'设置文件上传限制,类型及大小
If UpType="Field" Then
Dim RS:Set RS=Conn.Execute("Select FieldName,AllowFileExt,MaxFileSize From KS_Field Where FieldID=" & ChkClng(UpFileObj.Form("FieldID")))
If Not RS.Eof Then
FieldName=RS(0):MaxFileSize=RS(2):AllowFileExtStr=RS(1)
FormPath = ReturnChannelUserUpFilesDir(ChannelID,KSUser.UserName) & Year(Now()) & Right("0" & Month(Now()), 2) & "/"
Else
Response.End()
End IF
RS.Close:Set RS=Nothing
Else
Select Case BasicType
Case 9999 '用户头像
MaxFileSize = 50 '设定文件上传最大字节数
AllowFileExtStr = "jpg|gif|png" '取允许上传的动漫类型
FormPath = ReturnChannelUserUpFilesDir(9999,KSUser.UserName)
Case Else
MaxFileSize=0:AllowFileExtStr=""
Response.end
End Select
End If
FormPath=Replace(FormPath,".","")
IF Instr(FormPath,Setting(3))=0 Then FormPath=Setting(3) & FormPath
FilePath=Server.MapPath(FormPath) & "\"
Call CreateListFolder(FormPath) '生成上传文件存放目录
ReturnValue = CheckUpFile(FilePath,MaxFileSize,AllowFileExtStr,AutoReName)
if ReturnValue <> "" then
Response.Write("<script language=""JavaScript"">")
Response.Write("alert('" & ReturnValue & "');")
Response.Write("history.back(-1);")
Response.Write("</script>")
else
If UpType="Field" Then
Response.Write("<script language=""JavaScript"">")
Response.Write("parent.document.all."& FieldName & ".value='" & replace(TempFileStr,"|","") & "';")
Response.Write("document.write(' <font size=2>恭喜，上传成功！</font>');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'2; url=user_upfile.asp?ChannelID=" & ChannelID & "&Type=Field&FieldID=" & UpFileObj.Form("FieldID") &"\'>');")
Response.Write("</script>")
Response.End()
End If
Select Case BasicType
Case 9999 '用户头像
Response.Write("<script language=""JavaScript"">")
Response.Write("parent.tcjdxr.UserFace.value='" & right(replace(TempFileStr,"|",""),len(replace(TempFileStr,"|",""))-1) & "';")
Response.Write("parent.tcjdxr.showimages.src='" & replace(TempFileStr,"|","") & "';")
Response.Write("document.write('<br> 图片上传成功！');")
Response.Write("document.write('<meta http-equiv=\'refresh\' content=\'2; url=User_upfile.asp?channelid=9999\'>');")
Response.Write("</script>")
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
End If
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
If NoIllegalStr(FileName)=False Then ErrStr=ErrStr&"文件：上传被禁止！\n"
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 ChkClng(GetFolderSize(KSUser.GetUserFolder(ksuser.username))/1024+UpFileObj.File(FormName).FileSize/1024)>=ChkClng(Setting(50)) Then
Response.Write "<script>alert('上传失败1，您的可用空间不够！');history.back();</script>"
response.end
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 NoIllegalStr(Byval FileNameStr)
Dim Str_Len,Str_Pos
Str_Len=Len(FileNameStr)
Str_Pos=InStr(FileNameStr,Chr(0))
If Str_Pos=0 or Str_Pos=Str_Len then
NoIllegalStr=True
Else
NoIllegalStr=False
End If
End function
Function DealExtName(Byval UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
DealExtName = Lcase(UpFileExt)
DealExtName = Replace(DealExtName,Chr(0),"")
DealExtName = Replace(DealExtName,".","")
DealExtName = Replace(DealExtName,"'","")
DealExtName = Replace(DealExtName,"asp","")
DealExtName = Replace(DealExtName,"asa","")
DealExtName = Replace(DealExtName,"aspx","")
DealExtName = Replace(DealExtName,"cer","")
DealExtName = Replace(DealExtName,"cdx","")
DealExtName = Replace(DealExtName,"htr","")
DealExtName = Replace(DealExtName,"php","")
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" or FileExtName="php" or FileExtName="php3" or FileExtName="php4" or FileExtName="php5"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=MakeRandom(n)
RandomFigure = CStr(Int((99999 * Rnd) + 1))
FileName = UpFileObj.File(FormNameItem).FileName
FileExtName = UpFileObj.File(FormNameItem).FileExt
FileExtName = DealExtName(FileExtName)
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -