【www.gdgbn.com--上传工具】

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

asp教程" onsubmit="return f()"> 

 


 标题
 


 文件
 


 

<script language="javascript教程">
function f()
{
    if(document.form1.title.value=="")
 {
    alert("标题不能为空");
    return false;
 }
 if(document.form1.pic.value=="")
 {
    alert("图片不能为空");
    return false;
 }
}
</script>

upload.asp文件

<%
if request("act") = "upload" then

"****************************************
"  功能：aspUpload有组件上传文件
"  作者：wangsdong
"  网址：www.111cn.net教程
"  原创源码教程，转载请保留此信息，谢谢
"****************************************

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 & " 个文件") & "

"

" 指定一个上传的表单文件
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 "
"
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  
%>

本文来源：http://www.gdgbn.com/shipin/24032/