上传文件时,怎样让上传后的文件名为当前时间(年月日时分秒)

fkueyga6 2010-08-22 04:54:57
Ft_admin_upload.asp代码如下:
<!--#include file="Ft_config.asp"-->
<form name="up" method="post" action="Ft_admin_upfile.asp" enctype="multipart/form-data" onSubmit="return chk1();">
<input name="img" type="file" size="10"> <input type="submit" name="submit2" value="上传" class="submit">
<span class="STYLE1">只能上传30K大小的文件(规格约为100×100)</span>
</form>

Ft_config.asp代码如下:
<%
'====="上传设置"=====
Const allowupfile="gif;txt;jpg;jpeg;png;bmp;rar;zip" '各扩展名以英文分号分隔!系统默认允许文件列表为:gif;txt;jpg;jpeg;png;bmp;rar;zip;txt
Const allowupfilesize=30720 '上传文件大小设置,单位为:KB,注意不能设置过大,WIN2003有200K上传大小限制
%>

Ft_admin_upfile.asp代码如下:
<!--#include file="Ft_admin_upfile_class.asp"-->
<%
dim upfile,upmax,updir,checkupfile,SaveFilename
'==================================
'=参数设置:
'upmax为上传文件大小,此处设置为300KB,计算方法为 307200/1024=300K,注意不能过大,否则影响后面的自动检测功能;
'updir为上传目录,按月分别建立,总目录在程序根目录下的FUploadFile中;
'checkupfile为检测函数使用开关,0为关闭,1为启用
'==================================
'upmax=307200
upmax=allowupfilesize
updir="FUploadFile/"
checkupfile=1 '检测函数使用开关,0为关闭,1为启用
set upfile=new upfile_class
upfile.GetData (upmax)
'检查上传文件夹
Dim chk
set chk = Server.CreateObject("Scripting.FileSystemObject")
if chk.FolderExists(Server.MapPath(updir)) =false then
chk.CreateFolder(Server.MapPath(updir))
end if
set chk=nothing
'执行保存文件代码
dim path,FSPath
FSPath=GetFilePath(Server.mappath("upfile.asp"),"\")'取得当前文件在服务器路径
FSPath=FSPath&updir
path =FSPath&upfile.File("img").filename
upfile.SaveToFile "img",path
select case upfile.isErr
case 1
Response.Write "你没有填写上传数据  [<a href='Ft_admin_upload.asp'>重新上传</a>]"
case 2
response.Write "文件过大,应小于"&upmax/1024&"KB  [<a href='Ft_admin_upload.asp'>重新上传</a>]"
case 3
response.Write "该文件类型不允许上传  [<a href='Ft_admin_upload.asp'>重新上传</a>]"
case else
if checkupfile=1 then
'==================================
'=功能:自动检测上传文件是否含有非法代码
'=版本:feitec V1.0
'=作者:绯心剑客
'==================================
Dim objFSO,objTS,strText,ComStr,i,filebb,strArray
filebb=updir&upfile.file("img").filename
Set objFSO=Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(Server.MapPath(filebb)) Then
Set objTS=objFSO.OpenTextFile(Server.MapPath(filebb),1)
strText=lcase(objTS.ReadAll)
objTS.Close
'禁止字符,可随时添加
ComStr="cookie|.getfolder|.createfolder|.deletefolder|.createdirectory|.deletedirectory|0n error resume next|站长助手|密码|海阳|adodb.stream|createobject|scripting.filesystemobject|strbackdoor|password|command.com"
ComStr=ComStr&"|.saveas|wscript.shell|shell.application|script.encode|folderpath|session|request|iframe|frame|execute|object|server.mappath"
strArray=split(ComStr,"|")
for i=0 to ubound(strArray)
if instr(strText,strArray(i))<>0 then
objFSO.DeleteFile Server.MapPath(filebb),True
response.write"<font color=red>非法文件,禁止上传!</font>  [<a href='Ft_upload.asp'>重新上传</a>]"
response.end
end if
next
Set objFSO=nothing
else
response.write"该文件不存在"
end if
end if
response.write"<script>parent.Dvbbs_Composition.document.body.innerHTML+='<img src="&updir&upfile.file("img").filename &">'</script>"
'==================================
'代码检测结束
'==================================
response.Write "<font color=green style='font-size:12px'>上传成功!复制文件路径"&updir&upfile.file("img").filename &"到下面的文本框内  [<a href='Ft_admin_upload.asp'>继续上传</a>]</font>"
end select
set upfile=nothing
Function GetFilePath(FullPath,str)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, str))
Else
GetFilePath = ""
End If
End function
%>
...全文
674 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
fkueyga6 2010-08-23
  • 打赏
  • 举报
回复
已解决了
fkueyga6 2010-08-23
  • 打赏
  • 举报
回复
这些代码在保存的时候只保存为原文件名,所以才提问的
fkueyga6 2010-08-22
  • 打赏
  • 举报
回复
[Quote=引用 2 楼 gentle_sword 的回复:]
楼上正解
[/Quote]
什么楼上正解?那也是我发的代码,正在用的代码
gentle_sword 2010-08-22
  • 打赏
  • 举报
回复
楼上正解
fkueyga6 2010-08-22
  • 打赏
  • 举报
回复
Ft_admin_upfile_class.asp代码如下:
<%
Class UpFile_Class
Dim Form,File
Dim AllowExt_
Dim NoAllowExt_
Private oUpFileStream
Private isErr_
Private ErrMessage_
Private isGetData_
Public Function alertAndRemoveFile(Byval PathAndFileName)
on error resume next
dim MyFileObject,MyTextFile,NeedDel,StrCheckFile
alertAndRemoveFile=false
Set MyFileObject=Server.CreateObject("Scripting.FileSystemObject")
Set MyTextFile=MyFileObject.OpenTextFile(PathAndFileName)
DO
If MytextFile.AtEndOfStream Then Exit Do
StrCheckFile=MytextFile.ReadLine
if includeBadWord(StrCheckFile) Then
alertAndRemoveFile=true
NeedDel=true
Exit Do
End If
Loop
MYTextFile.Close
If NeedDel Then MyFileObject.DeleteFile PathAndFileName
set MYTextFile=nothing
set MyFileObject=nothing
End Function
Private Function includeBadWord(Byval FileStr)
includeBadWord=false
dim StrBadWord,ArrStrBadWord,i
StrBadWord="server.|.createobject|execute|.encode|eval|request" ArrStrBadWord=split(StrBadWord,"|")
For i=0 to ubound(ArrStrBadWord)
if Instr(LCase(FileStr),ArrStrBadWord(i))>0 Then
'response.write(ArrStrBadWord(i))
includeBadWord=true
Exit For
End If
Next
End Function
Public Property Get Version
Version="无惧上传类 Version V2.0"
End Property

Public Property Get isErr
isErr=isErr_
End Property

Public Property Get ErrMessage
ErrMessage=ErrMessage_
End Property

Public Property Get AllowExt
AllowExt=AllowExt_
End Property

Public Property Let AllowExt(Value)
AllowExt_=LCase(Value)
End Property

Public Property Get NoAllowExt
NoAllowExt=NoAllowExt_
End Property

Public Property Let NoAllowExt(Value)
NoAllowExt_=LCase(Value)
End Property
Private Sub Class_Initialize
isErr_ = 0
NoAllowExt=""
NoAllowExt=LCase(NoAllowExt)
AllowExt=allowupfile
'AllowExt="gif;txt;jpg;jpeg;png;bmp;rar;zip;txt"
AllowExt=LCase(AllowExt)
isGetData_=false
End Sub
Private Sub Class_Terminate
on error Resume Next
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End Sub
Public Sub GetData (MaxSize)
on error Resume Next
if isGetData_=false then
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
If Request.TotalBytes < 1 Then
isErr_ = 1
ErrMessage_="没有数据上传"
Exit Sub
End If
If MaxSize > 0 Then '如果限制大小
If Request.TotalBytes > MaxSize Then
isErr_ = 2
ErrMessage_="上传的数据超出限制大小"
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sInfo = tStream.ReadText
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = GetFileName(sFileName)
oFileInfo.FilePath = GetFilePath(sFileName)
oFileInfo.FileExt = GetFileExt(sFileName)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gb2312"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
Form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
Loop Until (iFormStart+2) >= iFormEnd
RequestBinDate = ""
Set tStream = Nothing
isGetData_=true
end if
End Sub
'保存到文件,自动覆盖已存在的同名文件
Public Function SaveToFile(Item,Path)
SaveToFile=SaveToFileEx(Item,Path,True)
End Function
'保存到文件,自动设置文件名
Public Function AutoSave(Item,Path)
AutoSave=SaveToFileEx(Item,Path,false)
End Function
'保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim oFileStream
Dim tmpPath
isErr=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
tmpPath=Path
if Over then
if isAllowExt(GetFileExt(tmpPath)) then
oFileStream.SaveToFile tmpPath,2
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
End if
Else
Path=GetFilePath(Path)
if isAllowExt(File(Item).FileExt) then
do
Err.Clear()
tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
oFileStream.SaveToFile tmpPath
loop Until Err.number<1
oFileStream.SaveToFile Path
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
End if
End if
oFileStream.Close
Set oFileStream = Nothing
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function
Public Function FileData(Item)
isErr_=0
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_="该后缀名的文件不允许上传!"
FileData=""
End if
End Function
'取得文件路径
Public function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
'取得文件名
Public Function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
'取得文件的后缀名
Public Function GetFileExt(FullPath)
If FullPath <> "" Then
GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
Else
GetFileExt = ""
End If
End function
'取得一个不重复的序号
Public Function GetNewFileName()
dim ranNum
dim dtNow
dtNow=Now()
ranNum=int(90000*rnd)+10000
'以下这段由webboy提供
GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function
Public Function isAllowExt(Ext)
if NoAllowExt="" then
isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
else
isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
end if
End Function
End Class
'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>
PowerBI系列之Power Query专题1.  获取数据 数据源种类介绍和获取Excel数据源输入数据和拷贝数据:创建辅助表解析Json/XML数据格式获取Web网页数据和URL添加动态参数连接数据的四种模式:Import、DirectQuery、Live Connection、Dual双 属于混合模式连接数据库:Sql server、 Mysql(直连但是必须先安装一个mysql插件)DirectQuery直连查询:Sql serverODBC方式获取数据表关联或多个Sql或调用存储过程获取数据SQL中动态传参和自定义函数: sql中使用参数或数据库名称使用参数连接Sharepoint和OneDrive数据源连接Dataset和Dataflow 替换本地数据源为Sharepoint数据源并保留数据处理操作 终止当前数据刷新Loading:Cancel Query数据源设置-重置数据连接凭证PBIDS连接数据源创建和使用报表模块(输入或值列表)利用报表模板和参数控制线下报表数据权限DirectQuery启用自动页面刷新和更改检测管理聚合表提高DirectQuery查询性能动态M查询参数提高DirectQuery查询性能添加数据刷新 DateTime.LocalNow()和Getdate()2.  数据清洗和M语言M语言和官方文档介绍PowerQuery中查阅M函数:=#shared, Ctrl+Space提示数据清洗之常用技能:提升标题、更改数据类型、保留删除错误或空行,删除重复项、选择列和删除列、填充单元格、合并列、拆分、提取、替换、条件替换、添加自定义列,添加条件列、添加索引列、分组、添加年月日列、追加和合并查询透视和逆透视以及转置合并单元格的Excel文件处理导入文件夹中多Excel文件并合并解决多文件合并中列顺序不一致使用参数和函数批量导入文件 文本中提取中文、英文、数字等处理双引号转义 列拆分详解解决列名改变错误解决列丢失错误动态显示、排序和重命名列为所有列名添加前缀列名字母大写和分隔符调整Trim标题列中的多余空格如何处理load数据错误为什么load的Excel数据有null空行为什么load的Excel数据标题在第二行灵活添加占位符规范同类相似数据数据按多列排序为分组添加Index序号分组内值合并诊断工具分析数据处理过程PowerQuery小技巧分享 新冠病例活动轨迹地图标识 

28,390

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧