标题:请教上传组件中的上传重命名问题!
只看楼主
yus99
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2011-9-11
 问题点数:0 回复次数:2 
请教上传组件中的上传重命名问题!
我用的是 秋忆文件管理,
秋忆工作室在线文件管理器v4.4.rar (132 KB)
,上学生做作业上传文件后,文件常被人覆盖,能不能将 秋忆文件管理4.4版中,incupload.asp 文件修改成上传文件后,文件重命名为 原文件名+随机数,或者 原文件名+用户名+随机数?如果能够入文件能入库更好,谢谢!
搜索更多相关主题的帖子: 文件管理 命名 上传文件 用户名 
2011-09-11 10:38
yus99
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2011-9-11
得分:0 
可以参考
在开始接触ASP时,还没有真正体会到ASP的先天不良,直到1年前制作文件上传时,才让我吃了不少苦:|现特地整理出来,以供大家参考!
ASP文件上传最核心的代码实际很简单(代码如下)
 upload.asp文件
  <%
  Function GetFileName(ByVal strFile)
  If strFile <> "" Then
   GetFileName = mid(strFile,InStrRev(strFile, "\")+1)
  Else
   GetFileName = ""
  End If
  End  function
  strFileName = Request.Form("file1")
  Set objStream = Server.CreateObject("ADODB.Stream")
  objStream.Type = 1 ' adTypeBinary
  objStream.Open
  objStream.LoadFromFile strFileName
  objStream.SaveToFile Server.MapPath(GetFileName(strFileName)),2
  objStream.Close
  %>
upload.htm文件
  <form name="FORM" action="upload.asp" method="post">
  <input type="file" name="file1" style="width:400"  value="">
      <input type="submit" name="submit" value="文件上传">
  </form>
 
当然只有以上代码,虽然可以上传,但有很多的漏洞及不完善。因此网上有很多高人都对此进行了修改,用的最多的是稻香老农的ASP文件上传。此后又有一些高人在稻香老农的基础上进行了修改,增添了文件上传进度条,如宝玉。从中我们也可以感受到每个人对ASP做出的努力!
 
闲话少说,本人以目前较成熟的宝玉ASP上传为基础,进行修改,修改部分如下:
 1、支持多文件上传 (默认同时上传5个文件)
 2、格式限制
 3、上传总大小限制
 4、文件自动更名,防止重名 (自动以数字对文件名进行更名)
 5、上传文档信息至数据库,文件上传至站点
具体代码如下,内附解释!(如有问题,可与我联系)
 
 
  default.htm文件(默认只能上传JPG或GIF格式文件,可根据需要进行修改)
 
<html>
<head><title>带进度条</title></head>
<script language="javascript">
<!--
function ShowProgress() {
 var ProgressID = (new Date()).getTime() % 1000000000;
 var Form = document.MyForm;
        var t1=Form.t1.value;
 var t2=Form.t2.value;
 Form.action = "Savefiles.asp?ProgressID=" + ProgressID;
 for(i=1;i<=window.MyForm.upcount.value;i++) {
        val = eval("Form.File"+i)
 fil = val.value
        ext =fil.substr(fil.length-3,3).toLowerCase();
  if (t1 == "") {
   alert("请填写内容1!")
   Form.t1.focus();
   return false;
  }
  if (t1.length > 20) {
   alert("内容1字数超过20字了!")
   Form.t1.focus();
   return false;
  }
  if (t2.length > 200) {
   alert("内容2字数超过200字了!")
   Form.t2.focus();
   return false;
  }
  if (fil == "") {
   alert("请选择上传文件!")
   val.focus();
          return false;
  }
  if (ext != "jpg" && ext !="gif") {
  alert("文件格式错误!\n只能上传JPG或GIF格式文件!")
  val.focus();
  return false;
  }
}
  var Ver = navigator.appVersion;
  if (Ver.indexOf("MSIE") > -1 && Ver.substr(Ver.indexOf("MSIE") + 5, 1) > 4) {
   window.showModelessDialog("Progress.asp?Count=0&ProgressID=" + ProgressID, null, "dialogWidth=360px; dialogHeight:190px; help:no; status:no; scroll:no");
  }
  else
  {
   window.open("Progress.asp?Count=0&ProgressID=" + ProgressID, "_blank", "left=240,top=240,width=360,height=190,toolbar=no,menubar=no,scrollbars=no,resizable=no,location=no,status=no");
  }
  return true;
}
//-->
</script>
<body onload="setid()">
<form onsubmit="return ShowProgress();" action="Savefiles.asp" enctype="multipart/form-data" method="post" name="MyForm">
   只能上传RAR或EXE格式文件:<br>
<table>
<tr>
    <td>*内容1:</td>
    <td align="left"><input type='text' name='t1' size='30'></td>
</tr>
<tr>
    <td colspan="2">选择上传的文件数(请不要多选):
     <select name="upcount" onchange="setid()">
     <option value="1" select>1</option>
     <option value="2">2</option>
     <option value="3">3</option>
     <option value="4">4</option>
     <option value="5">5</option>
     </select></td>
</tr>
<tr >  
 <td align="left" colspan="2" id="upid"></td>
<tr>
     <td valign='top'>内容2:</td>
     <td><textarea name='t2' cols='40'rows='5'></textarea></td>
</tr>
<tr>
     <td colspan='2'><input type="submit" value="上 传" name="subbutt">
                     <input type="reset" name="Button"  value="重 置"></td>
</tr>
</table>
</form>
<script language="javascript">
   function setid()
   {
   str='<br>';
   if(!window.MyForm.upcount.value)
    window.MyForm.upcount.value=1;
    for(i=1;i<=window.MyForm.upcount.value;i++)
      str+='文件'+i+':<input type="file" name="File'+i+'" size="30"><br><br>';
   window.upid.innerHTML=str+'<br>';
   }
</script>
</body>
</html>   
 
 
  upload.asp文件
 
<%
'-------------------------------------------------------------------------------------
' 描述: 无组件多文件带进度条上传,宝玉1.0 Beta的改进版
' 作者: 辰禹(chenyustudio@)
' 修改: 1、支持多文件上传 2、格式限制 3、上传大小限制(10M) 4、文件自动更名,防止重名 5、上传文档内容至数据库
' 版本: 1.0
' 日期:2005年4月24日
' 版权: 本作品由辰禹工作室修改,但是请勿移除版权信息
'-------------------------------------------------------------------------------------
Dim DoteyUpload_SourceData
Class DoteyUpload
 
 Public Files
 Public Form
 Public MaxTotalBytes
 Public Version
 Public ProgressID
 Public ErrMsg
 
 Private BytesRead
 Private ChunkReadSize
 Private Info
 Private Progress
 Private UploadProgressInfo
 Private CrLf
 Private Sub Class_Initialize()
  Set Files = Server.CreateObject("Scripting.Dictionary") ' 上传文件集合
  Set Form = Server.CreateObject("Scripting.Dictionary") ' 表单集合
  UploadProgressInfo = "DoteyUploadProgressInfo"  ' Application的Key
  MaxTotalBytes = 10*1024 *1024   ' 默认最大10M
  ChunkReadSize = 64 * 1024   ' 分块大小64K
  CrLf = Chr(13) & Chr(10)   ' 换行
  Set DoteyUpload_SourceData = Server.CreateObject("ADODB.Stream")
  DoteyUpload_SourceData.Type = 1   ' 二进制流
  DoteyUpload_SourceData.Open
  Version = "1.0 Beta"    ' 版本
  ErrMsg = ""     ' 错误信息
  Set Progress = New ProgressInfo
 End Sub
 ' 将文件根据其文件名统一保存在某路径下
 Public Sub SaveTo(path)
            
  Upload() ' 上传
  if right(path,1) <> "/" then path = path & "/"
  ' 遍历所有已上传文件
  For Each fileItem In Files.Items
   fileItem.SaveAs path & fileItem.FileName
  Next
  ' 保存结束后更新进度信息
  Progress.ReadyState = "complete" '上传结束
  UpdateProgressInfo progressID
 End Sub

 ' 分析上传的数据,并保存到相应集合中
 Public Sub Upload ()
  Dim TotalBytes, Boundary
  TotalBytes = Request.TotalBytes  ' 总大小
  If TotalBytes < 1 Then
   Raise("无数据传入")
   Exit Sub
  End If
  If TotalBytes > MaxTotalBytes Then
   Raise("您当前上传大小为" & TotalBytes/1000 & " K,最大允许为" & MaxTotalBytes/1024 & "K")
   Exit Sub
  End If
  Boundary = GetBoundary()
  If IsNull(Boundary) Then
   Raise("如果form中没有包括multipart/form-data上传是无效的")
   Exit Sub  ''如果form中没有包括multipart/form-data上传是无效的
  End If
  Boundary = StringToBinary(Boundary)
  
  Progress.ReadyState = "loading" '开始上传
  Progress.TotalBytes = TotalBytes
  UpdateProgressInfo progressID
  Dim DataPart, PartSize
  BytesRead = 0
  '循环分块读取
  Do While BytesRead < TotalBytes
   '分块读取
   PartSize = ChunkReadSize
   if PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
   DataPart = Request.BinaryRead(PartSize)
   BytesRead = BytesRead + PartSize
   DoteyUpload_SourceData.Write DataPart
   Progress.UploadedBytes = BytesRead
   Progress.LastActivity = Now()
   ' 更新进度信息
   UpdateProgressInfo progressID
  Loop
  ' 上传结束后更新进度信息
  Progress.ReadyState = "loaded" '上传结束
  UpdateProgressInfo progressID
  Dim Binary
  DoteyUpload_SourceData.Position = 0
  Binary = DoteyUpload_SourceData.Read
  Dim BoundaryStart, BoundaryEnd, PosEndOfHeader, IsBoundaryEnd
  Dim Header, bFieldContent
  Dim FieldName
  Dim File
  Dim TwoCharsAfterEndBoundary
  BoundaryStart = InStrB(Binary, Boundary)
  BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary, 0)
  Do While (BoundaryStart > 0 And BoundaryEnd > 0 And Not IsBoundaryEnd)
   ' 获取表单头的结束位置
   PosEndOfHeader = InStrB(BoundaryStart + LenB(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
      
   ' 分离表单头信息,类似于:
   ' Content-Disposition: form-data; name="file1"; filename="G:\homepage.txt"
   ' Content-Type: text/plain
   Header = BinaryToString(MidB(Binary, BoundaryStart + LenB(Boundary) + 2, PosEndOfHeader - BoundaryStart - LenB(Boundary) - 2))
   ' 分离表单内容
   bFieldContent = MidB(Binary, (PosEndOfHeader + 4), BoundaryEnd - (PosEndOfHeader + 4) - 2)
   
   FieldName = GetFieldName(Header)
   ' 如果是附件
   If InStr (Header,"filename=""") > 0 Then
    Set File = New FileInfo
   
    ' 获取文件相关信息
    Dim clientPath
    clientPath = GetFileName(Header)
    File.FileName = GetFileNameByPath(clientPath)
    File.FileExt = GetFileExt(clientPath)
    File.FilePath = clientPath
    File.FileType = GetFileType(Header)
    File.FileStart = PosEndOfHeader + 3
    File.FileSize = BoundaryEnd - (PosEndOfHeader + 4) - 2
    File.FormName = FieldName
    ' 如果该文件不为空并不存在该表单项保存之
    If Not Files.Exists(FieldName) And File.FileSize > 0 Then
     Files.Add FieldName, File
    End If
   '表单数据   
   Else
    ' 允许同名表单
    If Form.Exists(FieldName) Then
     Form(FieldName) = Form(FieldName) & "," & BinaryToString(bFieldContent)
    Else
     Form.Add FieldName, BinaryToString(bFieldContent)
    End If
   End If
   ' 是否结束位置
   TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, BoundaryEnd + LenB(Boundary), 2))
   IsBoundaryEnd = TwoCharsAfterEndBoundary = "--"
   If Not IsBoundaryEnd Then ' 如果不是结尾, 继续读取下一块
    BoundaryStart = BoundaryEnd
    BoundaryEnd = InStrB(BoundaryStart + LenB(Boundary), Binary, Boundary)
   End If
  Loop
  
  ' 解析文件结束后更新进度信息
  Progress.UploadedBytes = TotalBytes
  Progress.ReadyState = "interactive" '解析文件结束
  UpdateProgressInfo progressID
 End Sub
 '异常信息
 Private Sub Raise(Message)
  ErrMsg = ErrMsg & "[" & Now & "]" & Message & "<BR>"
  
  Progress.ErrorMessage = Message
  UpdateProgressInfo ProgressID
  
  'call Err.Raise(vbObjectError, "DoteyUpload", Message)
 End Sub
 ' 取边界值
 Private Function GetBoundary()
  Dim ContentType, ctArray, bArray
  ContentType = Request.ServerVariables("HTTP_CONTENT_TYPE")
  ctArray = Split(ContentType, ";")
  If Trim(ctArray(0)) = "multipart/form-data" Then
   bArray = Split(Trim(ctArray(1)), "=")
   GetBoundary = "--" & Trim(bArray(1))
  Else '如果form中没有包括multipart/form-data上传是无效的
   GetBoundary = null
   Raise("如果form中没有包括multipart/form-data上传是无效的")
  End If
 End Function
 ' 将二进制流转化成文本
 Private Function BinaryToString(xBinary)
  Dim Binary
  if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary
  
   Dim RS, LBinary
   Const adLongVarChar = 201
   Set RS = CreateObject("ADODB.Recordset")
   LBinary = LenB(Binary)
  
  if LBinary>0 then
   RS.Fields.Append "mBinary", adLongVarChar, LBinary
   RS.Open
   RS.AddNew
    RS("mBinary").AppendChunk Binary
   RS.Update
   BinaryToString = RS("mBinary")
  Else
   BinaryToString = ""
  End If
 End Function

 Function MultiByteToBinary(MultiByte)
   Dim RS, LMultiByte, Binary
   Const adLongVarBinary = 205
   Set RS = CreateObject("ADODB.Recordset")
   LMultiByte = LenB(MultiByte)
  if LMultiByte>0 then
   RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
   RS.Open
   RS.AddNew
    RS("mBinary").AppendChunk MultiByte & ChrB(0)
   RS.Update
   Binary = RS("mBinary").GetChunk(LMultiByte)
  End If
   MultiByteToBinary = Binary
 End Function

 ' 字符串到二进制
 Function StringToBinary(String)
  Dim I, B
  For I=1 to len(String)
   B = B & ChrB(Asc(Mid(String,I,1)))
  Next
  StringToBinary = B
 End Function
 '返回表单名
 Private Function GetFieldName(infoStr)
  Dim sPos, EndPos
  sPos = InStr(infoStr, "name=")
  EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")
  If EndPos = 0 Then
   EndPos = inStr(sPos + 6, infoStr, Chr(34))
  End If
  GetFieldName = Mid(infoStr, sPos + 6, endPos - _
   (sPos + 6))
 End Function
 '返回文件名
 Private Function GetFileName(infoStr)
  Dim sPos, EndPos
  sPos = InStr(infoStr, "filename=")
  EndPos = InStr(infoStr, Chr(34) & CrLf)
  GetFileName = Mid(infoStr, sPos + 10, EndPos - _
   (sPos + 10))
 End Function
 '返回文件的 MIME type
 Private Function GetFileType(infoStr)
  sPos = InStr(infoStr, "Content-Type: ")
  GetFileType = Mid(infoStr, sPos + 14)
 End Function
 '根据路径获取文件名
 Private Function GetFileNameByPath(FullPath)
  Dim pos
  pos = 0
  FullPath = Replace(FullPath, "/", "\")
  pos = InStrRev(FullPath, "\") + 1
  If (pos > 0) Then
   GetFileNameByPath = Mid(FullPath, pos)
  Else
   GetFileNameByPath = FullPath
  End If
 End Function
 '根据路径获取扩展名
 Private Function GetFileExt(FullPath)
  Dim pos
  pos = InStrRev(FullPath,".")
  if pos>0 then GetFileExt = Mid(FullPath, Pos)
 End Function
 ' 更新进度信息
 ' 进度信息保存在Application中的ADODB.Recordset对象中
 Private Sub UpdateProgressInfo(progressID)
  Const adTypeText = 2, adDate = 7, adUnsignedInt = 19, adVarChar = 200
  
  If (progressID <> "" And IsNumeric(progressID)) Then
   Application.Lock()
   if IsEmpty(Application(UploadProgressInfo)) Then
    Set Info = Server.CreateObject("ADODB.Recordset")
    Set Application(UploadProgressInfo) = Info
    Info.Fields.Append "ProgressID", adUnsignedInt
    Info.Fields.Append "StartTime", adDate
    Info.Fields.Append "LastActivity", adDate
    Info.Fields.Append "TotalBytes", adUnsignedInt
    Info.Fields.Append "UploadedBytes", adUnsignedInt
    Info.Fields.Append "ReadyState", adVarChar, 128
    Info.Fields.Append "ErrorMessage", adVarChar, 4000
    Info.Open
     Info("ProgressID").Properties("Optimize") = true
    Info.AddNew
   Else
    Set Info = Application(UploadProgressInfo)
    If Not Info.Eof Then
     Info.MoveFirst()
     Info.Find "ProgressID = " & progressID
    End If
    If (Info.EOF) Then
     Info.AddNew
    End If
   End If
   Info("ProgressID") = clng(progressID)
   Info("StartTime") = Progress.StartTime
   Info("LastActivity") = Now()
   Info("TotalBytes") = Progress.TotalBytes
   Info("UploadedBytes") = Progress.UploadedBytes
   Info("ReadyState") = Progress.ReadyState
   Info("ErrorMessage") = Progress.ErrorMessage
   Info.Update
   Application.UnLock
  End IF
 End Sub
 ' 根据上传ID获取进度信息
 Public Function GetProgressInfo(progressID)
  Dim pi, Infos
  Set pi = New ProgressInfo
  If Not IsEmpty(Application(UploadProgressInfo)) Then
   Set Infos = Application(UploadProgressInfo)
   If Not Infos.Eof Then
    Infos.MoveFirst
    Infos.Find "ProgressID = " & progressID
    If Not Infos.EOF Then
     pi.StartTime = Infos("StartTime")
     pi.LastActivity = Infos("LastActivity")
     pi.TotalBytes = clng(Infos("TotalBytes"))
     pi.UploadedBytes = clng(Infos("UploadedBytes"))
     pi.ReadyState = Trim(Infos("ReadyState"))
     pi.ErrorMessage = Trim(Infos("ErrorMessage"))
     Set GetProgressInfo = pi
    End If
   End If
  End If
  Set GetProgressInfo = pi
 End Function
 ' 移除指定的进度信息
 Private Sub RemoveProgressInfo(progressID)
  If Not IsEmpty(Application(UploadProgressInfo)) Then
   Application.Lock
   Set Info = Application(UploadProgressInfo)
   If Not Info.Eof Then
    Info.MoveFirst
    Info.Find "ProgressID = " & progressID
    If  Not Info.EOF Then
     Info.Delete
    End If
   End If
   ' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
   If Info.RecordCount = 0 Then
    Info.Close
    Application.Contents.Remove UploadProgressInfo
   End If
   Application.UnLock
  End If
 End Sub
 ' 移除指定的进度信息
 Private Sub RemoveOldProgressInfo(progressID)
  If Not IsEmpty(Application(UploadProgressInfo)) Then
   Dim L
   Application.Lock
   Set Info = Application(UploadProgressInfo)
   Info.MoveFirst
   Do
    L = Info("LastActivity").Value
    If IsEmpty(L) Then
     Info.Delete()
    ElseIf DateDiff("d", Now(), L) > 30 Then
     Info.Delete()
    End If
    Info.MoveNext()
   Loop Until Info.EOF
   ' 如果没有记录了, 直接释放, 避免'800a0bcd'错误
   If Info.RecordCount = 0 Then
    Info.Close
    Application.Contents.Remove UploadProgressInfo
   End If
   Application.UnLock
  End If
 End Sub
End Class
'---------------------------------------------------
' 进度信息 类
'---------------------------------------------------
Class ProgressInfo
 
 Public UploadedBytes
 Public TotalBytes
 Public StartTime
 Public LastActivity
 Public ReadyState
 Public ErrorMessage
 Private Sub Class_Initialize()
  UploadedBytes = 0 ' 已上传大小
  TotalBytes = 0  ' 总大小
  StartTime = Now() ' 开始时间
  LastActivity = Now() ' 最后更新时间
  ReadyState = "uninitialized" ' uninitialized,loading,loaded,interactive,complete
  ErrorMessage = ""
 End Sub
 ' 总大小
 Public Property Get TotalSize
  TotalSize = FormatNumber(TotalBytes / 1024, 0, 0, 0, -1) & " K"
 End Property
 ' 已上传大小
 Public Property Get SizeCompleted
  SizeCompleted = FormatNumber(UploadedBytes / 1024, 0, 0, 0, -1) & " K"
 End Property
 ' 已上传秒数
 Public Property Get ElapsedSeconds
  ElapsedSeconds = DateDiff("s", StartTime, Now())
 End Property
 ' 已上传时间
 Public Property Get ElapsedTime
  If ElapsedSeconds > 3600 then
   ElapsedTime = ElapsedSeconds \ 3600 & " 时 " & (ElapsedSeconds mod 3600) \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
  ElseIf ElapsedSeconds > 60 then
   ElapsedTime = ElapsedSeconds \ 60 & " 分 " & ElapsedSeconds mod 60 & " 秒"
  else
   ElapsedTime = ElapsedSeconds mod 60 & " 秒"
  End If
 End Property
 ' 传输速率
 Public Property Get TransferRate
  If ElapsedSeconds > 0 Then
   TransferRate = FormatNumber(UploadedBytes / 1024 / ElapsedSeconds, 2, 0, 0, -1) & " K/秒"
  Else
   TransferRate = "0 K/秒"
  End If
 End Property
 ' 完成百分比
 Public Property Get Percentage
  If TotalBytes > 0 Then
   Percentage = fix(UploadedBytes / TotalBytes * 100) & "%"
  Else
   Percentage = "0%"
  End If
 End Property
 ' 估计剩余时间
 Public Property Get TimeLeft
  If UploadedBytes > 0 Then
   SecondsLeft = fix(ElapsedSeconds * (TotalBytes / UploadedBytes - 1))
   If SecondsLeft > 3600 then
    TimeLeft = SecondsLeft \ 3600 & " 时 " & (SecondsLeft mod 3600) \ 60 & " 分 " & SecondsLeft mod 60 & " 秒"
   ElseIf SecondsLeft > 60 then
    TimeLeft = SecondsLeft \ 60 & " 分 " & SecondsLeft mod 60 & " 秒"
   else
    TimeLeft = SecondsLeft mod 60 & " 秒"
   End If
  Else
   TimeLeft = "未知"
  End If
 End Property
End Class
'---------------------------------------------------
' 文件信息 类
'---------------------------------------------------
Class FileInfo
 
 Dim FormName, FileName, FilePath, FileSize, FileType, FileStart, FileExt, NewFileName
 Private Sub Class_Initialize
  FileName = ""  ' 文件名
  FilePath = ""  ' 客户端路径
  FileSize = 0  ' 文件大小
  FileStart= 0  ' 文件开始位置
  FormName = ""  ' 表单名
  FileType = ""  ' 文件Content Type
  FileExt = ""  ' 文件扩展名
  NewFileName = "" '上传后文件名
 End Sub
 Public Function Save()
  SaveAs(FileName)
 End Function
 ' 保存文件
 Public Function SaveAs(fullpath)
  Dim dr
   
  NewFileName = GetFileNameByPath(fullpath)
  Set dr = CreateObject("Adodb.Stream")
  dr.Mode = 3
  dr.Type = 1
  dr.Open
  DoteyUpload_SourceData.position = FileStart
  DoteyUpload_SourceData.copyto dr, FileSize
  dr.SaveToFile MapPath(FullPath), 2
 '文件上传至站点的特定文件夹UploadFiles中,一定要在站点中先建立UploadFiles文件夹
               'dr.SaveToFile MapPath(GetFileNameByPath(FullPath)), 2 ''文件上传至站点中
  dr.Close
  set dr = nothing
  SaveAs = true
 End function
 ' 取服务器端路径
 Private Function MapPath(Path)
 If InStr(1, Path, ":") > 0 Or Left(Path, 2) = "\\" Then
   MapPath = Path
  Else
   MapPath = Server.MapPath(Path)
  End If
 End function
 '根据路径获取文件名
 Private Function GetFileNameByPath(FullPath)
  Dim pos
  pos = 0
  FullPath = Replace(FullPath, "/", "\")
  pos = InStrRev(FullPath, "\") + 1
  If (pos > 0) Then
   GetFileNameByPath = Mid(FullPath, pos)
  Else
   GetFileNameByPath = FullPath
  End If
 End Function

End Class
%>
 
 
 
  savefiles.asp文件
 
<!--#include file="connect.asp"-->
<!-- #include file="Upload.asp" -->
<!-- 本例说明如何对上传文件进行重命名 -->
<%
Server.ScriptTimeout = 900
formPath = "UploadFiles/"
 
'===================================取当前年月日时分秒及两位随时数,组成文件名。  2009年2月17日修改
Fnow=now()   
Fname=year(Fnow) & right("0" & month(Fnow),2) & right("0" & day(Fnow),2) & right("0" & hour(Fnow),2) & right("0" & minute
(Fnow),2) & right("0" & second(Fnow),2)
 
'====================================
 
Set upload= New DoteyUpload
  Upload.ProgressID = Request.QueryString("ProgressID")
Upload.Upload() '上传文件
'-----上传文件总大小限制-----------------------------------------------------
if Request.TotalBytes>10*1024*1024 then   
  Response.Write "<script language='Jscript'>"&vbcrlf
  Response.Write "alert('上传文件总大小不能超过10M!');"&vbcrlf
  Response.Write "history.back(-1)"&vbcrlf
  Response.Write "</script>"&vbcrlf
  response.end
end if
'-----------------------------------------------------------------------------

For Each fileItem In Upload.Files.Items  ' 遍历所有已上传文件
'------上传格式限制(多个文件中可以上传正常格式,限制的格式不上传)-------------
Dim FixFileExt,fnN,FileExtname,FixFnN,intFix,FileExtM,lenm
FixFileExt=".exe|.asp|.aspx|.asa|.asax|.ascx|.ashx|.asmx|.axd|.cdx|.cer|.config|.cs|.csproj|.licx|.rem|.resx|.htm|.html|.shtm
l|.shtm|.soap|.stm|.vb|.vbproj|.webinfo|.cgi|.pl|.php|.phtml|.php3" ''限制格式用|隔开,注意扩展名是以.开头
fnN=fileItem.FileExt
FileExtname=trim(fnN)
FixFnN=split(FixFileExt,"|")
intFix=Ubound(FixFnN)
for i=0 to intFix
 if FileExtname=FixFnN(i) Then
lenm=len(FileExtname)
FileExtM=Ucase(mid(FileExtname,2,lenm))
  Response.Write "<script language='Jscript'>"&vbcrlf
  Response.Write "alert('"&FileExtM &" 为限制的格式,文件不能上传!');"&vbcrlf
  Response.Write "history.back(-1)"&vbcrlf
  Response.Write "</script>"&vbcrlf
  response.end
 end if
next
next
 
Randomize '初始化随机数生成器。
For Each fileItem In Upload.Files.Items  ' 遍历所有已上传文件
'-----------------------------------------------------------------------------
 fileItem.SaveAs formPath & Fname & Int((90 * Rnd) + 10) & fileItem.FileExt   '取当前年月日时分秒及两位随时数,组成文件名。2009年2月17日修改
 'fileItem.SaveAs formPath & Int((99999 * Rnd) + 1) & fileItem.FileExt           '取4-5位随机数,组成文件名

Next
 
If upload.ErrMsg = "" then
'====================列出所有Form中的数据====================================
 Response.Write ("列出所有form数据:<BR>")
 Response.Write ("内容1:")
 Response.Write upload.Form("t1")&"<BR>"
 Response.Write ("内容2:")
 Response.Write upload.Form("t2")&"<BR>"
'--------------------也可用下面方法列出Form中所有数据------------------------
  'For each formName in upload.Form ''列出所有form数据
  'Response.write formName & "=" & upload.Form(formName) & "<br>"
  'next
'=============================================================================
 Response.Write ("<BR><BR>列出所有上传了的文件:<BR>")
 For Each formName In upload.Files ''列出所有上传了的文件
  Set file = upload.Files(formName)  ''生成一个文件对象
'-------------------写入数据库-------------------------------------------------
Sql = "insert into upfile_table (subject,filename,n_filename,filepath,filesize) values"
        Sql = Sql& " ('"& upload.Form("t1") &"','"& File.FileName &"','"& File.NewFileName &"','"& formPath &"','"&
file.FileSize &"')"
 conn.execute(sql)
'-------------------------------------------------------------------------------
  response.write file.FilePath  & " (" & file.FileType & "/" & file.FileSize/1024 &"K) => <a target=_blank href='" & formPath
& File.NewFileName & "'>" & formPath & File.FileName & "</a> 成功!<br>"
  response.write "<br /><BR>"
  Set file=nothing
 Next
Else
 Response.Write("上传过程中出现错误:<br>" & Upload.ErrMsg)
End If
conn.close
set conn=nothing
Set upload=nothing
%>

 
 
  progress.asp文件
 
<%@language=vbscript enablesessionstate=false lcid=1033%>
<!-- #include file="Upload.asp" -->
<%
 Response.CacheControl = "no-cache"
 Response.Expires = -1
 progressID = Request.QueryString("ProgressID")
 Set upload = New DoteyUpload
 Set Info = upload.GetProgressInfo(progressID)
If Info.ReadyState = "loaded" Then
%>
文件上传结束
<script>window.close();</script>
<%
Else
%>
<html>
<head>
 <meta http-equiv="refresh" content="1;url=Progress.asp?ProgressID=<%=ProgressID%>">
 <title>已上传<%= Info.Percentage %></title>
<style type="text/css">
<!--
div {
 font-size: 12px;
 color: #333333;
 text-decoration: none;
}
-->
</style>
</head>
<body bgcolor="#EFEBDE" topmargin=5 leftmargin=5>
<div align="left">
总 大 小:<%= Info.TotalSize %><br>
已经上传:<%= Info.SizeCompleted %><br>
平均速率:<%= Info.TransferRate %><br>
使用时间:<%= Info.ElapsedTime %><br>
剩余时间:<%= Info.TimeLeft %><br>
</div>
<table border="1" cellpadding="0" cellspacing="0" width="340px">
 <tr>
  <td>
   <table border="0" cellpadding="0" cellspacing="0" width="100%">
    <tr><td width="<%= Info.Percentage %>" bgcolor="blue"></td><td>&nbsp</td></tr>
   </table>
  </td>
 </tr>
</table><br>
<div align="center"><a href="mailto:chenyustudio@辰禹工作室</a>·技术支持</div>
</body>
</html>
<%
End If
%>
 
 
 
  connect.asp文件
 
<%
Dim conn
Dim connstr
Dim ServerPath
ServerPath=Server.MapPath("\data.mdb")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ServerPath
Set conn=Server.CreateObject("Adodb.Connection")
conn.Open connstr
%>
 
另外与以上文件一起在站点根目录中建立一个数据库文件data.mdb,建立一个文件夹UploadFiles即可!
2011-09-11 10:40
yus99
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2011-9-11
得分:0 
upprocess.asp 文件修改后,可以达到 时间组成数字+原文件名命名
在哪儿修改可以达到  原文件名+用户名+时间组成数字 的新命名啊
<!--#include file="checklogin.asp"-->
<!--#include file="incupload.asp"-->
<%
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
Server.ScriptTimeOut = Script_Timeout
dim upload,filepath,frompath,obj_fso,i,formName,file,act,msg

if popedom then        '管理员不限制上传
    FileMaxSize=0
    NotAllowFileType=""
    AllowFileType=""
end if

CreateUploadObj(UploadObject)

if act="uploadfile" then
    if filepath<>"" then
        filepath=replace(filepath,"\","/")
        filepath=replace(filepath,"//","/")
    end if
    if right(filepath,1)<>"/" then
        filepath=filepath&"/"
    end if
    if InvalidChar(filepath,0) then
        msg = msg & "<font color='#ff0000'>抱歉,没有填写路径或路径中含有非法字符!</font><br><br>"
        msg = msg & "<input type='button' style='width:65px;height:20px;font-size:12px' value='返回' onclick='window.history.go(-1)'>   <input type='button' style='width:65px;height:20px;font-size:12px' value='关闭' onclick='window.close()'>"&vbcrlf
        call main("出错信息",msg)
        response.end
    end if
    Call CheckPath(PathCanModify,filepath)

    frompath=Server.mappath(filepath)
    set obj_fso=server.createobject("scripting.filesystemobject")
    if not obj_fso.folderexists(frompath) then
        set obj_fso=nothing
        set upload=nothing
        msg = msg & "<font color='#ff0000'>抱歉,目录“"&filepath&"”不存在,请先创建该目录!</font><br>"&vbcrlf
        msg = msg & "<br><input type='button' style='width:65px;height:20px;font-size:12px' value='返回' onclick='window.history.go(-1)'>   <input type='button' style='width:65px;height:20px;font-size:12px' value='关闭' onclick='window.close()'>"
        call main("出错信息",msg)
        response.end
    end if
   
    i=0
    select case UploadObject
        case 1        'Aspupload 组件上传
            aspupload()
        case 2        'SA-FileUp 组件上传
            saupload()
        case 3        'LyfUpload 组件上传
            lyfupload()
        case else    '无组件上传
            nogroupware()
    end select
   
    set upload=nothing
    set obj_fso=nothing
    msg = msg & "<br><br><b>共&nbsp;<font color='#ff0000'>"&i&"</font>&nbsp;个文件上传成功!</b><br>"
    msg = msg & "<br><input type='button' style='width:65px;height:20px;font-size:12px' value='返回' onclick='window.history.go(-1)'>   <input type='button' style='width:65px;height:20px;font-size:12px' value='关闭' onclick='window.close()'>"&vbcrlf
    call main("上传成功",msg)
else
    call main("提交参数不正确","<br>act=" & act)
    set upload=nothing
end if



function CanUpload(Fileurl)
    Fileurl = lcase("|"& Mid(Fileurl, InstrRev(Fileurl, ".") + 1)& "|")
    NotAllowFileType = "|"&NotAllowFileType&"|"
    if instr(NotAllowFileType,Fileurl)>0 then
        CanUpload = false
    else
        CanUpload = true
    end if
end function



function CreateUploadObj(Upload_Object)
    on error resume next
    If Err Then Err.Clear
    select case Upload_Object
        case 1        'Aspupload 组件上传
            set upload=Server.CreateObject("Persits.Upload")
        case 2        'SA-FileUp 组件上传
            set upload=Server.CreateObject("SoftArtisans.FileUp")
        case 3        'LyfUpload 组件上传
            set upload=Server.CreateObject("LyfUpload.UploadFile")
        case else    '无组件上传
            set upload=new DoteyUpload
    end select
    if Err then
        Err.Clear
        msg = msg & "抱歉,服务器不支持 "
        select case Upload_Object
            case 1
                msg = msg & "AspUpload组件"
            case 2
                msg = msg & "SA-FileUp组件"
            case 3
                msg = msg & "LyfUpload组件"
            case else
                msg = msg & "无组件"
        end select
        msg = msg & " 上传,请在config.asp文件里设置服务器支持的组件"
        call main("出错信息","<font color='#ff0000'>"&msg&"</font>")
        response.end
    end if
   
    select case Upload_Object
        case 1        'Aspupload 组件上传
            act=lcase(trim(request.QueryString("action")))
            filepath=lcase(trim(request.QueryString("path")))
        case 2        'SA-FileUp 组件上传
            act=lcase(trim(upload.form("act")))
            filepath=trim(upload.form("filepath"))
        case 3        'LyfUpload 组件上传
            act=lcase(trim(upload.request("act")))
            filepath=trim(upload.request("filepath"))
        case else    '无组件上传
            upload.ProgressID = Request.QueryString("ProgressID")
            upload.Upload()
            act=lcase(trim(upload.Form("act")))
            filepath=trim(upload.Form("filepath"))
    end select
end function


function aspupload()
    On Error Resume Next
    if Request.QueryString("PID") = "" then
        upload.ProgressID="010D60EB00C5AA4B"
    else
        upload.ProgressID=Request.QueryString("PID")
    end if
    if FileMaxSize>0 then
        upload.SetMaxSize FileMaxSize, True
    end if
    upload.save(frompath)
    If Err.Number = 8 Then
        Err.Clear
        msg = msg & "<font color=red>上传的部分文件大小超过限制(不超过"& formatnumber(FileMaxSize/1024,2,-1) &"K)</font><br>"
    end if
    For Each file in upload.Files
        if not CanUpload(file.ext) then
            if trim(file.filename)&""<>"" then
                File.Delete
                msg = msg & "<font color=red>文件"&file.filename &"("&formatnumber(file.size/1024,2,-1)&" K) 格式不允许上传!</font><br>"
            end if
        else
            i=i+1
            msg = msg & file.filename & " ("&formatnumber(file.size/1024,2,-1)&" K)&nbsp;上传至&nbsp;"
            msg = msg & Server.MapPath(filepath & file.filename) & "&nbsp;成功!<br><br>"
        end if
    next
    If Err Then
        Err.Clear
        msg = msg & "出现错误: " & Err.Number & "<br>" & Err.Description
    End If
end function


function saupload()
    dim temp_N,Filesize,thisfiletype,canup
    for each FormName in upload.Form
        canup=true
        if IsObject(upload.Form(FormName)) Then
            If Not upload.Form(FormName).IsEmpty Then
                if FileMaxSize>0 then
                    upload.Form(FormName).Maxbytes = FileMaxSize
                end if
                Filesize = upload.Form(FormName).TotalBytes
                temp_N = mid(upload.Form(FormName).UserFileName,InStrRev(upload.Form(FormName).UserFileName,"\")+1)
                thisfiletype= Mid(temp_N, InStrRev(temp_N, ".")+1)
                if FileMaxSize>0 then
                    If Filesize>FileMaxSize then
                        canup=false
                        msg = msg & "<font color=red>文件"&upload.Form(FormName).UserFilename&"("&formatnumber(Filesize/1024,2,-1)&" K)超过大小限制(不超过"& formatnumber(FileMaxSize/1024,2,-1) &"K)</font><br>"
                    end if
                end if
                if not CanUpload(thisfiletype) then
                    canup=false
                    if trim(temp_N)<>"" then
                        msg = msg & "<font color=red>文件"&temp_N&"("&Filesize&") 格式不允许上传!</font><br>"
                    end if
                end if
                if canup=true then
                    upload.Form(FormName).SaveAs frompath & "\" & temp_N
                    msg = msg & upload.Form(FormName).UserFilename&" ("&formatnumber(Filesize/1024,2,-1)&" K)&nbsp;上传至&nbsp;"
                    msg = msg & upload.Form(FormName).ServerName&"&nbsp;成功!<br><br>"
                    i=i+1
                end if
            end if
        end if
    next
end function


function lyfupload()
    if FileMaxSize>0 then
        upload.maxsize=FileMaxSize
    end if
    if AllowFileType<>"" then
        upload.extname=AllowFileType
    end if
   
    dim filename(4),filesize(4),j,canup
    filename(0)=upload.SaveFile("file1",frompath,true)
    filesize(0)=upload.FileSize
    filename(1)=upload.SaveFile("file2",frompath,true)
    filesize(1)=upload.FileSize
    filename(2)=upload.SaveFile("file3",frompath,true)
    filesize(2)=upload.FileSize
    filename(3)=upload.SaveFile("file4",frompath,true)
    filesize(3)=upload.FileSize
    filename(4)=upload.SaveFile("file5",frompath,true)
    filesize(4)=upload.FileSize
    for j=0 to 4
        canup=true
        if filename(j)<>"" then
            if FileMaxSize>0 then
                if filename(j)="0" then
                    canup=false
                    msg = msg & "<font color=red>第"&j+1&"个文件大小超过限制(不超过"& formatnumber(FileMaxSize/1024,2,-1) &"K)</font><br>"
                end if
            end if
            if AllowFileType<>"" then
                if filename(j)="1" then
                    canup=false
                    msg = msg & "<font color=red>第"&j+1&"个文件格式不允许上传</font><br>"
                end if
            end if
            if canup=true then
                i=i+1
                msg = msg & filename(j)&" ("&formatnumber(filesize(j)/1024,2,-1)&" K)&nbsp;上传至&nbsp;"
                msg = msg & Server.MapPath(filepath&filename(j))&"&nbsp;成功!<br>"
            end if
        end if
    next
    erase filename
    erase filesize
end function


function nogroupware()
    dim canup,fileobj,clientpath
    dim username
username=trim(request.querystring("username"))
    dim ranNum,Fname,Fnow
        ranNum=int(90000*rnd)+10000
    Fnow=now()   
Fname=year(Fnow) & right("0" & month(Fnow),2) & right("0" & day(Fnow),2) & right("0" & hour(Fnow),2) & right("0" & minute(Fnow),2) & right("0" & second(Fnow),2)
    for each fileobj in upload.Files.Items
        canup=true
        clientpath=fileobj.FilePath
        if len(clientpath)>80 then
            clientpath="..."&right(clientpath,77)
        end if
        if FileMaxSize>0 then
            if fileobj.FileSize>FileMaxSize then
                canup=false
                msg = msg & "<font color=red>文件"&clientpath&"("&formatnumber(fileobj.FileSize/1024,2,-1)&"K)超过大小限制(不超过"& formatnumber(FileMaxSize/1024,2,-1) &"K)</font><br>"
            end if
        end if
        if trim(fileobj.FileExt)&""<>"" then
            if not CanUpload(fileobj.FileExt) then
                canup=false
                msg = msg & "<font color=red>文件"&clientpath&"("&formatnumber(fileobj.FileSize/1024,2,-1)&"K)格式不允许上传</font><br>"
            end if
        end if
        if canup=true and trim(fileobj.FileName)&""<>"" then
            fileobj.SaveAs frompath&"\"&Fname&"_"&fileobj.FileName
                        msg = msg & clientpath&" ("&formatnumber(fileobj.FileSize/1024,2,-1)&" K)&nbsp;上传至&nbsp;"
            msg = msg & Server.MapPath(filepath&fileobj.FileName)&"&nbsp;成功!<br>"
            i=i+1
        end if
    next
end function


sub main(title,body)
%><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.
<html xmlns="http://www.
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title><%=SystemName&" - "&title%></title>
<link rel="stylesheet" type="text/css" href="images/upresult.css" />
</head>
<body<%if title="上传成功" then response.write " onload='opener.window.location.reload()'"%>>
<div id="bodyposition">
    <div id="content">
      <div id="title"><%=SystemName&" - 文件上传结果报告"%></div>
      <div id="main"><br><%=body%><br><br><br></div>
      <div id="footer"></div>
    </div>
</div>
</body>
</html>
<%end sub%>
2011-09-13 12:46



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-349684-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.057900 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved