程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 網頁編程 >> ASP編程 >> ASP技巧 >> aspUpload有組件上傳文件的源碼

aspUpload有組件上傳文件的源碼

編輯:ASP技巧

使用無組件上傳有一個缺點:就是不能上傳大的文件。
如果客戶要上傳大文件,這種方式就不行了,所以解決的方法有兩種:
1、使用FTP上傳大文件,然後將路徑填入到表單中,這樣多了FTP上傳文件過程
2、使用有組件上傳。

這裡介紹aspUpload組件,該組件的下載地址是:http://www.aspbc.com/code/showcode.ASP?id=97
使用有組件上傳,前提是服務器上必須安裝了這個組件。

ASPUpload上傳代碼:

<form method="POST" enctype="multipart/form-data" action="?act=upload">
<input type="file" size="20" name="file1"><input type="submit" value="上傳">
</form>
< % 
if request("act") = "upload" then
'****************************************
'  功能:ASPUpload有組件上傳文件
'  作者:wangsdong
'  網址:www.ASPbc.com
'  原創源碼,轉載請保留此信息,謝謝
'****************************************
AllowExt = "jpg,png,gif,zip,rar,sql,txt,bak"
FileSize=4194304
'On Error Resume Next

' 新建ASPUpload對象
Set Upload = Server.CreateObject("Persits.Upload")

' 限制文件大小
Upload.SetMaxSize FileSize, True

' 上傳路徑--當前目錄下的test目錄
if session("fuptype")="pic" then
 path="images/pic"
else
 path="images/test"
end if 
uploadDir = Server.MapPath(path)
AutoCreateFolder(uploadDir) '創建文件夾

' 嘗試創建路徑文件夾,true表示忽略目錄已存在錯誤
'Upload.CreateDirectory uploadDir, true

' 先上傳文件至服務器內存
Count = Upload.Save()

' 檢測上傳錯誤
If Err.Number = 8 Then
Response.Write chinese2unicode("錯誤: 文件過大!")
Response.end
Else
If Err <> 0 Then
response.write chinese2unicode("發生錯誤:")
response.write chinese2unicode(Err.Description)
response.end
End If
End If

'Response.Write chinese2unicode("共 " & Count & " 個文件") & "<br><br>"

' 指定一個上傳的表單文件
Set File = Upload.Files("file1")
If Not File Is Nothing Then
' 獲取原本文件名
'Filename = File.Filename '如果使用原文件名,請去掉前面的單引號
filename=replace(replace(replace(now()," ",""),"-",""),":","")&File.Ext '以時間為文件名
' 獲取文件擴展名
Fileext = File.Ext
v=path&"/"&filename

' 檢測文件格式是否合格
ChkStr = ","&Lcase(AllowExt)&","
If Instr(ChkStr,","&right(Fileext,3)&",") <= 0 Then
Response.Write chinese2unicode("錯誤: 文件類型不正確!")
response.write "<br>"
response.write chinese2unicode("只允許:"&AllowExt)
' 刪除內存中的臨時文件,以釋放內存或硬盤空間(還可用Copy、Move兩個指令)
File.Delete
' 檢測是否存在文件
elseif Upload.FileExists(uploadDir & "\" & Filename) Then
File.SaveAs uploadDir & "\" & Filename
Response.Write chinese2unicode("已覆蓋存在相同文件名的文件: ") & File.Path
' 保存文件
else
File.SaveAs uploadDir & "\" & Filename
'Response.Write chinese2unicode("文件已保存到: ") & File.Path
'v=Replace(UploadFilePath&file.filename,"../","")   
  response.write "<script>opener.document."&session("frmname")&"."&session("bdname")&".value='"&v&"';window.close();</script>"
end If
Else
Response.Write chinese2unicode("錯誤: 您並沒有選擇文件!")
End If

else
   session("fuptype")=request("fuptype")  '上傳類型
   session("frmname")=request("frmname")  'form名
   session("bdname")=request("bdname")         '表單名
end If

' gb2312轉unicode,解決中文亂碼問題
function chinese2unicode(Str) 
dim i 
dim Str_one 
dim Str_unicode 
for i=1 to len(Str) 
Str_one=Mid(Str,i,1) 
Str_unicode=Str_unicode&chr(38) 
Str_unicode=Str_unicode&chr(35) 
Str_unicode=Str_unicode&chr(120) 
Str_unicode=Str_unicode& Hex(ascw(Str_one)) 
Str_unicode=Str_unicode&chr(59) 
next 
Response.Write Str_unicode 
end function 
'-------------------------------- 
'自動創建指定的多級文件夾 
'strPath為絕對路徑 
Function AutoCreateFolder(strPath) 'As Boolean 
        On Error Resume Next 
        Dim astrPath, ulngPath, i, strTmpPath 
        Dim objFSO 
        If InStr(strPath, "\") <=0 or InStr(strPath, ":") <= 0 Then 
                AutoCreateFolder = False 
                Exit Function 
        End If 
        Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
        If objFSO.FolderExists(strPath) Then 
                AutoCreateFolder = True 
                Exit Function 
        End If 
        astrPath = Split(strPath, "\") 
        ulngPath = UBound(astrPath) 
        strTmpPath = "" 
        For i = 0 To ulngPath 
                strTmpPath = strTmpPath & astrPath(i) & "\" 
                If Not objFSO.FolderExists(strTmpPath) Then 
                        '創建 
                        objFSO.CreateFolder(strTmpPath) 
                End If 
        Next 
        Set objFSO = Nothing 
        If Err = 0 Then 
                AutoCreateFolder = True 
        Else 
                AutoCreateFolder = False 
        End If 
End Function   
% >

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved