asp圖片檔案上傳代碼完全版

<!--#include file="upload_wj.inc"-->
<style>
td{font-size:9pt;line-height:120%;color:#353535}
body{font-size:9pt;line-height:120%}

a:link          { color: #000000; text-decoration: none }
a:visited       { color: #000000; text-decoration: none }
a:active        { color: #000000; text-decoration: none }
a:hover         { color: #336699; text-decoration: none; position: relative; right: 0px; top: 1px }
</style>
<%
set upload=new upload_file
if upload.form("act")="uploadfile" then
 filepath=trim(upload.form("filepath"))
 filelx=trim(upload.form("filelx"))
 
 i=0
 for each formName in upload.File
  set file=upload.File(formName)
 
 fileExt=lcase(file.FileExt) '得到的副檔名不含有.
 if file.filesize<100 then
  response.write "<span style=""font-family: 宋體; font-size: 9pt"">請先選擇你要上傳的檔案！　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
 response.end
 end if
 if (filelx<>"swf") and (filelx<>"jpg") and (filelx<>"gif") then
  response.write "<span style=""font-family: 宋體; font-size: 9pt"">該檔案類型不能上傳！　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
 response.end
 end if
 if filelx="swf" then
 if fileext<>"swf"  then
  response.write "<span style=""font-family: 宋體; font-size: 9pt"">只能上傳swf格式的Flash檔案！　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
  response.end
 end if
 end if
 if filelx="jpg" or filelx="gif" then
 if fileext<>"gif" and fileext<>"jpg"  then
  response.write "<span style=""font-family: 宋體; font-size: 9pt"">只能上傳jpg或gif格式的圖片！　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
  response.end
      end if
 end if
 if filelx="swf" then
 if file.filesize>(500*1024) then
  response.write "<span style=""font-family: 宋體; font-size: 9pt"">最大隻能上傳 500K 的Flash檔案！　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
  response.end
 end if
 end if
 if filelx="jpg" or filelx="gif" then
 if file.filesize>(100*1024) then
  response.write "<span style=""font-family: 宋體; font-size: 9pt"">最大隻能上傳 100K 的圖片檔案！　[ <a href=# onclick=history.go(-1)>重新上傳</a> ]</span>"
  response.end
 end if
 end if

 randomize
 ranNum=int(90000*rnd)+10000
 filename=filepath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&fileExt
%>
<%
 if file.FileSize>0 then         ''如果 FileSize > 0 說明有檔案資料
  'file.SaveAs Server.mappath(filename)   ''儲存檔案
  file.SaveToFile Server.mappath(FileName)
  'response.write file.FileName&"　　上傳成功!　　<br>"
  'response.write "新檔案名稱："&FileName&"<br>"
  'response.write "新檔案名稱已複製到所需的位置，可關閉視窗！"
  if filelx="swf" then
      response.write "<script>window.opener.document."&upload.form("FormName")&".size.value='"&int(file.FileSize/1024)&" K'</script>"
  end if
  response.write "<script>window.opener.document."&upload.form("FormName")&"."&upload.form("EditName")&".value='"&FileName&"'</script>"
%>
<%
 end if
 set file=nothing
 next
 set upload=nothing
end if
%>
<script language="javascript">
window.alert("檔案上傳成功!請不要修改產生的連結地址！");
window.close();
</script>

upload_wj.inc檔案代碼

<%

'檔案屬性：例如上傳檔案為c:myfiledoc.txt
'FileName    檔案名稱       字串    "doc.txt"
'FileSize    檔案大小     數值       1210
'FileType    檔案類型     字串    "text/plain"
'FileExt     副檔名   字串    "txt"
'FilePath    檔案原路徑   字串    "c:myfile"
'使用時注意事項:
'由於Scripting.Dictionary區分大小寫,所以在網頁及ASP頁的項目名都要相同的大小
'寫,如果人習慣用大寫或小寫,為了防止出錯的話,可以把
'sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
'改為
'(小寫者)sFormName = LCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'(大寫者)sFormName = UCase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'**********************************************************************
'----------------------------------------------------------------------
dim oUpFileStream

Class upload_file
 
dim Form,File,Version
 
Private Sub Class_Initialize
   '定義變數
  dim RequestBinDate,sStart,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
  dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
   '代碼開始
  Version="無組件上傳類 Version 0.96"
  set Form = Server.CreateObject("Scripting.Dictionary")
  set File = Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes < 1 then Exit Sub
  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)
  '取得每個項目之間的分隔字元
  sStart = MidB(RequestBinDate,1, InStrB(1,RequestBinDate,bCrLf)-1)
  iStart = LenB (sStart)
  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,sStart)-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
      '取得檔案屬性
      iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
      iFindEnd = InStr(iFindStart,sInfo,"""",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.FileType = 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
      form.Add sFormName,sFormvalue
    end if
    tStream.Close
    iFormStart = iFormStart+iStart+2
    '如果到檔案尾了就退出
    loop until (iFormStart+2) = iFormEnd
  RequestBinDate=""
  set tStream = nothing
End Sub

Private Sub Class_Terminate 
  '清除變數及對像
  if not Request.TotalBytes<1 then
    oUpFileStream.Close
    set oUpFileStream =nothing
    end if
  Form.RemoveAll
  File.RemoveAll
  set Form=nothing
  set File=nothing
End Sub
  
 '取得檔案路徑
Private function GetFilePath(FullPath)
  If FullPath <> "" Then
    GetFilePath = left(FullPath,InStrRev(FullPath, ""))
    Else
    GetFilePath = ""
  End If
End function
 
'取得檔案名稱
Private function GetFileName(FullPath)
  If FullPath <> "" Then
    GetFileName = mid(FullPath,InStrRev(FullPath, "")+1)
    Else
    GetFileName = ""
  End If
End function

'取得副檔名
Private function GetFileExt(FullPath)
  If FullPath <> "" Then
    GetFileExt = mid(FullPath,InStrRev(FullPath, ".")+1)
    Else
    GetFileExt = ""
  End If
End function

End Class

'檔案屬性類
Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
  Private Sub Class_Initialize
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
    FileExt = ""
  End Sub
 
'儲存檔案方法
 Public function SaveToFile(FullPath)
    dim oFileStream,ErrorChar,i
    SaveToFile=1
    if fileExt<>"gif" and fileExt<>"jpg" and fileExt<>"swf" then exit function'檢測副檔名
    if trim(fullpath)="" or right(fullpath,1)="/" then exit function
    set oFileStream=CreateObject("Adodb.Stream")
    oFileStream.Type=1
    oFileStream.Mode=3
    oFileStream.Open
    oUpFileStream.position=FileStart
    oUpFileStream.copyto oFileStream,FileSize
    oFileStream.SaveToFile FullPath,2
    oFileStream.Close
    set oFileStream=nothing
    SaveToFile=0
  end function
End Class
%>