<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title></title>
<style>
td{font-size:12px;}
</style>
</head>
<body>
<TABLE border=0 cellpadding=0 cellspacing=0 width=400>
<form id="form1" name="form1" method="post" action="2.asp教程" onsubmit="return f()">
<TR>
<TD colspan=2 align="center"><b></b></TD>
</TR>
<TR>
<TD>标题</TD>
<TD><input type="text" name="title"></TD>
</TR>
<TR>
<TD>文件</TD>
<TD><input name="pic" type="text" id="pic" size="30" /><input type="button" name="Submit" value="浏览.." onclick="window.open('upload.asp?fuptype=pic&frmname=form1&bdname=pic');"/></TD>
</TR>
<TR>
<TD colspan=2 align="center"><input type="submit" value="保存" style="width:150px;"></TD>
</TR>
</form>
</TABLE>
<script language="javascript教程">
function f()
{
if(document.form1.title.value=="")
{
alert("标题不能为空");
return false;
}
if(document.form1.pic.value=="")
{
alert("图片不能为空");
return false;
}
}
</script>
</body>
</html>
upload.asp文件
<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.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 & " 个文件") & "<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
%>