asp 無組件檔案上傳代碼

最後更新：2017-01-13 來源：互聯網

上載者：User

創建阿里雲帳戶，並獲得超過 40 款產品的免費試用版；而企業帳戶則可以享有總值 $1200 的免費試用版。立即註冊！

<html>
<head>
<title>檔案上傳</title>
<meta name="Description" Content="">
<link rel="stylesheet" href="manage.css" type="text/css">
</head>
<body>
<%

fuptype=session("fuptype")'上傳類型
fupname=session("fupname")'檔案名稱
frmname=session("frmname")'form名
bdname=session("bdname") '表單名
if fuptype="" or fupname="" or frmname="" then
response.write "<script language='javascript'>"
response.write "alert('出現錯誤，請重新上傳！');"
response.write "location.href='javascript:history.go(-1)';"
response.write "</script>"
response.end
end if
%>

<%
set upload=new upload_5xsoft
set file=upload.file("file1")
if file.fileSize>0 then
filename=fupname+"."
filenameend=file.filename
filenameend=split(filenameend,".")
n=UBound(filenameend)
filename=filename&filenameend(n)
if fuptype<>"db" then
if file.fileSize>1572864 then
response.write "<script language='javascript'>"
response.write "alert('您上傳的檔案太大，上傳不成功，單個檔案最大不能超過1500K！');"
response.write "location.href='javascript:history.go(-1)';"
response.write "</script>"
response.end
end if
end if
if fuptype="adv" or fuptype="pic" then
if LCase(filenameend(n))<>"gif" and LCase(filenameend(n))<>"jpg" and LCase(filenameend(n))<>"doc" and LCase(filenameend(n))<>"xls" and LCase(filenameend(n))<>"rar" and LCase(filenameend(n))<>"zip" and LCase(filenameend(n))<>"txt" then
response.write "<script language='javascript'>"
response.write "alert('不允許上傳您選擇的檔案格式，請檢查後重新上傳！');"
response.write "location.href='javascript:history.go(-1)';"
response.write "</script>"
response.end
end if
end if
if fuptype="pic" then
savepath="../pic_1/"&filename
end If

file.saveAs Server.mappath(savepath)
'response.write "檔案上傳成功!上傳檔案的實體路徑為："
'response.write "<font color=red>"&Server.mappath(savepath)&"</font><br><br>"
'response.write "<a href='"&savepath&"' target='_blank'>點擊預覽上傳的檔案</a>"
'response.write "<br><br><INPUT onclick='javascript:window.close();' type=submit value='上傳完成'>"
response.write "<script>opener.document."&frmname&"."&bdname&".value='"&Replace(savepath,"../","")&"';window.close();</script>"

%>
<%
else
response.write "<script language='javascript'>"
response.write "alert('檔案內容不可為空，單擊“確定”返回上一頁！');"
response.write "location.href='javascript:history.go(-1)';"
response.write "</script>"
response.end
end if
set upload=nothing
session("fuptype")=""
session("fupname")=""
session("frmname")=""
%>
</body>
</html>

下面是upload_5xsoft.inc檔案直接下載儲存這段代碼

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim upfile_5xSoft_Stream
Class upload_5xSoft
dim Form,File,Version
Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version="化境編程界HTTP上傳程式 Version 1.0"
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
upfile_5xSoft_Stream.mode=3
upfile_5xSoft_Stream.type=1
upfile_5xSoft_Stream.open
upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)
vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
while iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
if iFileNameStart>0 and iFileNameStart<iFormEnd then
   iFileNameEnd=inString(iFileNameStart+10,"""")
   mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
   iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
   iEnd=inString(iStart+4,vbEnter&strDiv)
   if iEnd>iStart then
    mFileSize=iEnd-iStart-4
   else
    mFileSize=0
   end if
   set theFile=new FileInfo
   theFile.FileName=getFileName(mFileName)
   theFile.FilePath=getFilePath(mFileName)
   theFile.FileSize=mFileSize
   theFile.FileStart=iStart+4
   theFile.FormName=FormName
   file.add mFormName,theFile
else
   iStart=inString(iEnd+1,vbEnter&vbEnter)
   iEnd=inString(iStart+4,vbEnter&strDiv)

   if iEnd>iStart then
    mFormValue=subString(iStart+4,iEnd-iStart-4)
   else
    mFormValue=""
   end if
   form.Add mFormName,mFormValue
end if

iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
wend
End Sub

Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_5xSoft_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
   if upfile_5xSoft_Stream.EOS then Exit for
   c=ascB(upfile_5xSoft_Stream.Read(1))
   If c > 127 Then
    if upfile_5xSoft_Stream.EOS then Exit for
    stemp=stemp&Chrw(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))
    i=i+1
   else
    stemp=stemp&Chr(c)
   End If
Next
subString=stemp
End function

Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_5xSoft_Stream.Size-theLen
   if i>upfile_5xSoft_Stream.size then exit Function
   upfile_5xSoft_Stream.Position=i-1
   if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
    InString=i
    for j=2 to theLen
      if upfile_5xSoft_Stream.EOS then
        inString=0
        Exit for
      end if
      if AscB(upfile_5xSoft_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
        InString=0
        Exit For
      end if
    next
    if InString<>0 then Exit Function
   end if
next
End Function

Private Sub Class_Terminate
form.RemoveAll
file.RemoveAll
set form=nothing
set file=nothing
upfile_5xSoft_Stream.close
set upfile_5xSoft_Stream=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 toByte(Str)
   dim i,iCode,c,iLow,iHigh
   toByte=""
   For i=1 To Len(Str)
   c=mid(Str,i,1)
   iCode =Asc(c)
   If iCode<0 Then iCode = iCode + 65535
   If iCode>255 Then
     iLow = Left(Hex(Asc(c)),2)
     iHigh =Right(Hex(Asc(c)),2)
     toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
   Else
     toByte = toByte & chrB(AscB(c))
   End If
   Next
End function
End Class

Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileStart
Private Sub Class_Initialize
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
End Sub

Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=1
    if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function
    if FileStart=0 or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    upfile_5xSoft_Stream.position=FileStart-1
    upfile_5xSoft_Stream.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing
    SaveAs=0
end function
End Class
</SCRIPT>

本文章原先以中文撰寫並發佈於 aliyun.com，亦設英文版本，僅作資訊用途。本網站不對文章的準確性，完整性或可靠性或其任何翻譯作出任何明示或暗示的陳述或保證。如對該文章有任何疑慮或投訴，請傳送電郵至 info-contact@alibabacloud.com 並提供相關疑慮或投訴的詳細說明。職員會於 5 個工作天內與您聯絡，一經驗證之後，即會刪除該侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

Get Started for Free

Sales Support

1 on 1 presale consultation

Chat Contact Sales
After-Sales Support

24/7 Technical Support 6 Free Tickets per Quarter Faster Response

Open a Ticket
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.

Learn More

asp 無組件檔案上傳代碼

聯繫我們

A Free Trial That Lets You Build Big!

Sales Support

After-Sales Support