求ASP图片上传源码
1、图片上传到img文件夹2、图片地址存到access里3、图片名字更改为与其它图片不重复的名字分不是问题，要多少给多少...
1、图片上传到img文件夹
2、图片地址存到access里
3、图片名字更改为与其它图片不重复的名字
分不是问题，要多少给多少 展开
2、图片地址存到access里
3、图片名字更改为与其它图片不重复的名字
分不是问题，要多少给多少 展开
9个回答
展开全部
<%
Response.Buffer = True
Server.ScriptTimeOut=9999999
On Error Resume Next
%>
<!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" />
<meta http-equiv="Content-Language" content="zh-cn" />
<meta content="all" name="robots" />
<meta name="author" content="木目,Woodeye" />
<meta name="description" content="木目ASP文件上传工具" />
<meta name="keywords" content="木目,ASP,Upload,文件上传" />
<style type="text/css">
<!--
body,input {font-size:12px;}
-->
</style>
<title>木目ASP文件上传工具</title>
</head>
<body id="body">
<%
ExtName = "jpg,gif,png,txt,rar,zip,doc" '允许扩展名
SavePath = "img" '保存路径
If Right(SavePath,1)<>"/" Then SavePath=SavePath&"/" '在目录后加(/)
CheckAndCreateFolder(SavePath)
UpLoadAll_a = Request.TotalBytes '取得客户端全部内容
If(UpLoadAll_a>0) Then
Set UploadStream_c = Server.CreateObject("ADODB.Stream")
UploadStream_c.Type = 1
UploadStream_c.Open
UploadStream_c.Write Request.BinaryRead(UpLoadAll_a)
UploadStream_c.Position = 0
FormDataAll_d = UploadStream_c.Read
CrLf_e = chrB(13)&chrB(10)
FormStart_f = InStrB(FormDataAll_d,CrLf_e)
FormEnd_g = InStrB(FormStart_f+1,FormDataAll_d,CrLf_e)
Set FormStream_h = Server.Createobject("ADODB.Stream")
FormStream_h.Type = 1
FormStream_h.Open
UploadStream_c.Position = FormStart_f + 1
UploadStream_c.CopyTo FormStream_h,FormEnd_g-FormStart_f-3
FormStream_h.Position = 0
FormStream_h.Type = 2
FormStream_h.CharSet = "GB2312"
FormStreamText_i = FormStream_h.Readtext
FormStream_h.Close
FileName_j = Mid(FormStreamText_i,InstrRev(FormStreamText_i,"\")+1,FormEnd_g)
If(CheckFileExt(FileName_j,ExtName)) Then
SaveFile = Server.MapPath(SavePath & FileName_j)
If Err Then
Response.Write "文件上传： <span style=""color:red;"">文件上传出错!</span> <a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
Err.Clear
Else
SaveFile = CheckFileExists(SaveFile)
k=Instrb(FormDataAll_d,CrLf_e&CrLf_e)+4
l=Instrb(k+1,FormDataAll_d,leftB(FormDataAll_d,FormStart_f-1))-k-2
FormStream_h.Type=1
FormStream_h.Open
UploadStream_c.Position=k-1
UploadStream_c.CopyTo FormStream_h,l
FormStream_h.SaveToFile SaveFile,2
SaveFileName = Mid(SaveFile,InstrRev(SaveFile,"\")+1)
Response.write "文件上传： <span style=""color:red;"">" & SaveFileName & " </span>文件上传成功! <a href=""" & Request.ServerVariables("URL") &""">继续上传文件</a><br />"
End If
Else
Response.write "文件上传： <span style=""color:red;"">文件格式不正确!</span> <a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
End If
Else
%>
<script language="Javascript">
<!--
function ValidInput()
{
if(document.upform.upfile.value=="")
{
alert("请选择上传文件！")
document.upform.upfile.focus()
return false
}
return true
}
// -->
</script>
<form action='<%= Request.ServerVariables("URL") %>' method='post' name="upform" onsubmit="return ValidInput()" enctype="multipart/form-data">
文件上传：
<input type='file' name='upfile' size="40"> <input type='submit' value="上传">
</form>
<%
End if
Set FormStream_h = Nothing
UploadStream.Close
Set UploadStream = Nothing
%>
</body>
</html>
<%
'判断文件类型是否合格
Function CheckFileExt(FileName,ExtName) '文件名,允许上传文件类型
FileType = ExtName
FileType = Split(FileType,",")
For i = 0 To Ubound(FileType)
If LCase(Right(FileName,3)) = LCase(FileType(i)) then
CheckFileExt = True
Exit Function
Else
CheckFileExt = False
End if
Next
End Function
'检查上传文件夹是否存在，不存在则创建文件夹
Function CheckAndCreateFolder(FolderName)
fldr = Server.Mappath(FolderName)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fldr) Then
fso.CreateFolder(fldr)
End If
Set fso = Nothing
End Function
'检查文件是否存在，重命名存在文件
Function CheckFileExists(FileName)
Set fso=Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(SaveFile) Then
i=1
msg=True
Do While msg
CheckFileExists = Replace(SaveFile,Right(SaveFile,4),"_" & i & Right(SaveFile,4))
If not fso.FileExists(CheckFileExists) Then
msg=False
End If
i=i+1
Loop
Else
CheckFileExists = FileName
End If
Set fso=Nothing
End Function
%>
Response.Buffer = True
Server.ScriptTimeOut=9999999
On Error Resume Next
%>
<!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" />
<meta http-equiv="Content-Language" content="zh-cn" />
<meta content="all" name="robots" />
<meta name="author" content="木目,Woodeye" />
<meta name="description" content="木目ASP文件上传工具" />
<meta name="keywords" content="木目,ASP,Upload,文件上传" />
<style type="text/css">
<!--
body,input {font-size:12px;}
-->
</style>
<title>木目ASP文件上传工具</title>
</head>
<body id="body">
<%
ExtName = "jpg,gif,png,txt,rar,zip,doc" '允许扩展名
SavePath = "img" '保存路径
If Right(SavePath,1)<>"/" Then SavePath=SavePath&"/" '在目录后加(/)
CheckAndCreateFolder(SavePath)
UpLoadAll_a = Request.TotalBytes '取得客户端全部内容
If(UpLoadAll_a>0) Then
Set UploadStream_c = Server.CreateObject("ADODB.Stream")
UploadStream_c.Type = 1
UploadStream_c.Open
UploadStream_c.Write Request.BinaryRead(UpLoadAll_a)
UploadStream_c.Position = 0
FormDataAll_d = UploadStream_c.Read
CrLf_e = chrB(13)&chrB(10)
FormStart_f = InStrB(FormDataAll_d,CrLf_e)
FormEnd_g = InStrB(FormStart_f+1,FormDataAll_d,CrLf_e)
Set FormStream_h = Server.Createobject("ADODB.Stream")
FormStream_h.Type = 1
FormStream_h.Open
UploadStream_c.Position = FormStart_f + 1
UploadStream_c.CopyTo FormStream_h,FormEnd_g-FormStart_f-3
FormStream_h.Position = 0
FormStream_h.Type = 2
FormStream_h.CharSet = "GB2312"
FormStreamText_i = FormStream_h.Readtext
FormStream_h.Close
FileName_j = Mid(FormStreamText_i,InstrRev(FormStreamText_i,"\")+1,FormEnd_g)
If(CheckFileExt(FileName_j,ExtName)) Then
SaveFile = Server.MapPath(SavePath & FileName_j)
If Err Then
Response.Write "文件上传： <span style=""color:red;"">文件上传出错!</span> <a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
Err.Clear
Else
SaveFile = CheckFileExists(SaveFile)
k=Instrb(FormDataAll_d,CrLf_e&CrLf_e)+4
l=Instrb(k+1,FormDataAll_d,leftB(FormDataAll_d,FormStart_f-1))-k-2
FormStream_h.Type=1
FormStream_h.Open
UploadStream_c.Position=k-1
UploadStream_c.CopyTo FormStream_h,l
FormStream_h.SaveToFile SaveFile,2
SaveFileName = Mid(SaveFile,InstrRev(SaveFile,"\")+1)
Response.write "文件上传： <span style=""color:red;"">" & SaveFileName & " </span>文件上传成功! <a href=""" & Request.ServerVariables("URL") &""">继续上传文件</a><br />"
End If
Else
Response.write "文件上传： <span style=""color:red;"">文件格式不正确!</span> <a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
End If
Else
%>
<script language="Javascript">
<!--
function ValidInput()
{
if(document.upform.upfile.value=="")
{
alert("请选择上传文件！")
document.upform.upfile.focus()
return false
}
return true
}
// -->
</script>
<form action='<%= Request.ServerVariables("URL") %>' method='post' name="upform" onsubmit="return ValidInput()" enctype="multipart/form-data">
文件上传：
<input type='file' name='upfile' size="40"> <input type='submit' value="上传">
</form>
<%
End if
Set FormStream_h = Nothing
UploadStream.Close
Set UploadStream = Nothing
%>
</body>
</html>
<%
'判断文件类型是否合格
Function CheckFileExt(FileName,ExtName) '文件名,允许上传文件类型
FileType = ExtName
FileType = Split(FileType,",")
For i = 0 To Ubound(FileType)
If LCase(Right(FileName,3)) = LCase(FileType(i)) then
CheckFileExt = True
Exit Function
Else
CheckFileExt = False
End if
Next
End Function
'检查上传文件夹是否存在，不存在则创建文件夹
Function CheckAndCreateFolder(FolderName)
fldr = Server.Mappath(FolderName)
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fldr) Then
fso.CreateFolder(fldr)
End If
Set fso = Nothing
End Function
'检查文件是否存在，重命名存在文件
Function CheckFileExists(FileName)
Set fso=Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(SaveFile) Then
i=1
msg=True
Do While msg
CheckFileExists = Replace(SaveFile,Right(SaveFile,4),"_" & i & Right(SaveFile,4))
If not fso.FileExists(CheckFileExists) Then
msg=False
End If
i=i+1
Loop
Else
CheckFileExists = FileName
End If
Set fso=Nothing
End Function
%>
本回答由提问者推荐
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
准确的说有几个方案可以实现，你提问的问题不明确，比如用什么方式传？无组件上传？FTP？组件上传？
对于第一种，目前有很多种无组件上传模块，比如化境无组件上传，他可以把客户端的文件上传到服务器，你把他设定为上传到IMG文件夹就可以了，图片地址可以获取，图片名字如果用上传时间作为文件名这个问题就解决了。
第二种。。就如一楼说的，用flashfxp这些FTP工具就可以实现了。
你来这里要源码，获得的结果可能不怎么样，不如让大家给你思路，自己去研究，这样学程序才有意义。随便贴代码谁都会，问题是你能学到什么？
对于第一种，目前有很多种无组件上传模块，比如化境无组件上传，他可以把客户端的文件上传到服务器，你把他设定为上传到IMG文件夹就可以了，图片地址可以获取，图片名字如果用上传时间作为文件名这个问题就解决了。
第二种。。就如一楼说的，用flashfxp这些FTP工具就可以实现了。
你来这里要源码，获得的结果可能不怎么样，不如让大家给你思路，自己去研究，这样学程序才有意义。随便贴代码谁都会，问题是你能学到什么？
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
共有两个页面
<html>
<head>
<title>图片上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
body {
margin-left: 0px;
margin-top: 0px;
}
-->
</style></head>
<body>
<form name="form1" method="post" action="upfile.asp" enctype="multipart/form-data" >
<table width="80%" border="0" align=left>
<tr><td><input type="file" name="file1" value="">
<input type="submit" name="Submit" value=" 上 传 "></td></tr>
</table>
</form>
</body>
</html>
以下代码要存在另一个代页面 名字是upfile.asp
<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>
<!--#include file="upload_5xsoft.inc"-->
<html>
<head>
<title>文件上传</title>
</head>
<body>
<%
''将当前的日期和时间转为文件名
function makefilename()
dim fname
fname = now()
fname = trim(fname)
fname = replace(fname,"-","")
fname = replace(fname,"/","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
makefilename=fname
end function
dim upload,file,formName,formPath,mc
dim i,l,fileType,newfilename,filenamelist
'创建新文件名称
newfilename = makefilename()
'建立上传对象
set upload=new upload_5xsoft
'上传文件目录
formPath = Server.mappath("../images")&"/"
'列出所有上传了的文件
for each formName in upload.objFile
'生成一个文件对象
set file=upload.file(formName)
mc= upload.form("mc")
'如果 FileSize > 0 说明有文件数据
if file.FileSize>0 then
'取得文件扩展名
fileType = file.FileName '文件名以及扩展名
i = instr(fileType,".") '是否存在“.”
l = Len(fileType)
if i>0 then
fileType = Right(fileType,l-i+1) '得到扩展名
end if
newfilename = newfilename & fileType
filenamelist = formPath&newfilename '新文件绝对地址和名称
file.SaveAs filenamelist ''保存文件
end if
set file=nothing
next
'将文件信息传入内容字段
response.write "<script>parent.document.form1.tu.value='../images/"&newfilename&"'</script>"
response.Write("你已经成功的上传了")
set upload=nothing ''删除此对象
%>
</body>
</html>
<html>
<head>
<title>图片上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
body {
margin-left: 0px;
margin-top: 0px;
}
-->
</style></head>
<body>
<form name="form1" method="post" action="upfile.asp" enctype="multipart/form-data" >
<table width="80%" border="0" align=left>
<tr><td><input type="file" name="file1" value="">
<input type="submit" name="Submit" value=" 上 传 "></td></tr>
</table>
</form>
</body>
</html>
以下代码要存在另一个代页面 名字是upfile.asp
<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>
<!--#include file="upload_5xsoft.inc"-->
<html>
<head>
<title>文件上传</title>
</head>
<body>
<%
''将当前的日期和时间转为文件名
function makefilename()
dim fname
fname = now()
fname = trim(fname)
fname = replace(fname,"-","")
fname = replace(fname,"/","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
makefilename=fname
end function
dim upload,file,formName,formPath,mc
dim i,l,fileType,newfilename,filenamelist
'创建新文件名称
newfilename = makefilename()
'建立上传对象
set upload=new upload_5xsoft
'上传文件目录
formPath = Server.mappath("../images")&"/"
'列出所有上传了的文件
for each formName in upload.objFile
'生成一个文件对象
set file=upload.file(formName)
mc= upload.form("mc")
'如果 FileSize > 0 说明有文件数据
if file.FileSize>0 then
'取得文件扩展名
fileType = file.FileName '文件名以及扩展名
i = instr(fileType,".") '是否存在“.”
l = Len(fileType)
if i>0 then
fileType = Right(fileType,l-i+1) '得到扩展名
end if
newfilename = newfilename & fileType
filenamelist = formPath&newfilename '新文件绝对地址和名称
file.SaveAs filenamelist ''保存文件
end if
set file=nothing
next
'将文件信息传入内容字段
response.write "<script>parent.document.form1.tu.value='../images/"&newfilename&"'</script>"
response.Write("你已经成功的上传了")
set upload=nothing ''删除此对象
%>
</body>
</html>
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
用FTP工具连接站点后，就显示站点的文件夹，直接把文件拉到那个文件夹里就行。
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
将文件信息传入内容字段
response.write "<script>parent.document.form1.tu.value='../images/"&newfilename&"'</script>"
response.Write("你已经成功的上传了")
set upload=nothing ''删除此对象
%>
</body>
</html>
response.write "<script>parent.document.form1.tu.value='../images/"&newfilename&"'</script>"
response.Write("你已经成功的上传了")
set upload=nothing ''删除此对象
%>
</body>
</html>
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
展开全部
这是我用到的
upflie.asp内容如下
<!--#include file="con.asp"-->
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="../css.css" rel="stylesheet" type="text/css">
<!--#include file="up.inc"-->
<%
Set Upload = New UpFile_Class
Upload.InceptFileType = "gif,jpg,bmp,jpeg,png"
Upload.MaxSize = 10240000
Upload.GetDate()
If Upload.Err > 0 Then
Select Case Upload.Err
Case 1 : Response.Write "请先选择你要上传的文件 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
Case 2 : Response.Write "图片大小超过了限制 "&Dvbbs.Forum_Setting(56)&"K [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
Case 3 : Response.Write "所上传类型不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
End Select
Else
FormPath=Upload.Form("filepath")
For Each FormName in Upload.file
Set File = Upload.File(FormName)
If File.Filesize<10 Then
Response.Write "请先选择你要上传的图片 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
End If
FileExt = FixName(File.FileExt)
If Not ( CheckFileExt(FileExt) and CheckFileType(File.FileType) ) Then
Response.Write "文件格式不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
End If
FileName=FormPath&UserFaceName(FileExt)
If File.FileSize>0 Then
File.SaveToFile Server.mappath(FileName)
response.write "<script>window.opener.document."&upload.form("FormName")&"."&upload.form("EditName")&".value='"&FileName&"'</script>"
Response.Write "<script language=""javascript"">window.alert(""文件上传成功!请不要修改生成的链接地址！"");window.close();</script>"
End If
Set File=Nothing
Next
End If
Set Upload=Nothing
Private Function CheckFileExt(FileExt)
Dim ForumUpload,i
ForumUpload="gif,jpg,bmp,jpeg,png"
ForumUpload=Split(ForumUpload,",")
CheckFileExt=False
For i=0 to UBound(ForumUpload)
If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
CheckFileExt=True
Exit Function
End If
Next
End Function
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Lcase(UpFileExt)
FixName = Replace(FixName,Chr(0),"")
FixName = Replace(FixName,".","")
FixName = Replace(FixName,"asp","")
FixName = Replace(FixName,"asa","")
FixName = Replace(FixName,"aspx","")
FixName = Replace(FixName,"cer","")
FixName = Replace(FixName,"cdx","")
FixName = Replace(FixName,"htr","")
End Function
Private Function UserFaceName(FileExt)
Randomize
RanNum = Int(90000*rnd)+10000
UserFaceName = UserID&Year(now)&Month(now)&Day(now)&Hour(now)&Minute(now)&Second(now)&RanNum&"."&FileExt
End Function
Private Function CheckFileType(FileType)
CheckFileType = False
If Left(Cstr(Lcase(Trim(FileType))),6)="image/" Then CheckFileType = True
End Function
%>
up.inc文件内容
Dim oUpFileStream
Class UpFile_Class
Public Form,File,Version,Err
Private CHK_FileType,CHK_MaxSize
Private Sub Class_Initialize
Version = "无惧上传类 Version V1.0"
Err = -1
CHK_FileType = ""
CHK_MaxSize = -1
Set Form = Server.CreateObject ("Scripting.Dictionary")
Set File = Server.CreateObject ("Scripting.Dictionary")
Set oUpFileStream = Server.CreateObject ("Adodb.Stream")
Form.CompareMode = 1
File.CompareMode = 1
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
End Sub
Private Sub Class_Terminate
'清除变量及对像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End Sub
Public Property Get InceptFileType
InceptFileType = CHK_FileType
End Property
Public Property Let InceptFileType(Byval vType)
CHK_FileType = vType
End Property
Public Property Get MaxSize
MaxSize = CHK_MaxSize
End Property
Public Property Let MaxSize(vSize)
If IsNumeric(vSize) Then CHK_MaxSize = Int(vSize)
End Property
Public Sub GetDate()
'定义变量
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName,sFormName,RequestSize
Dim iFindStart,iFindEnd,iFormStart,iFormEnd,FileBlag
'代码开始
RequestSize = Int(Request.TotalBytes)
If RequestSize < 1 Then
Err = 1
Exit Sub
End If
Set tStream = Server.CreateObject ("Adodb.Stream")
oUpFileStream.Write Request.BinaryRead (RequestSize)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每个项目之间的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB (sSpace)
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,sSpace)-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_Class
'取得文件属性
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = Mid(sFileName,InStrRev(sFileName, "\")+1)
oFileInfo.FilePath = Left(sFileName,InStrRev(sFileName, "\"))
oFileInfo.FileExt = Lcase(Mid(sFileName,InStrRev(sFileName, ".")+1))
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileType = Ucase(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
If Instr(oFileInfo.FileType,"IMAGE/") Or Instr(oFileInfo.FileType,"FLASH") Then
FileBlag = GetImageSize
oFileInfo.FileExt = FileBlag(0)
oFileInfo.FileWidth = FileBlag(1)
oFileInfo.FileHeight = FileBlag(2)
FileBlag = Empty
End If
If CHK_MaxSize > 0 Then
If oFileInfo.FileSize > CHK_MaxSize Then
Err = 2
Exit Sub
End If
End If
If CheckErr(oFileInfo.FileExt) = False Then Exit Sub
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
If Form.Exists (sFormName) Then _
Form (sFormName) = Form (sFormName) & ", " & sFormValue _
Else _
Form.Add sFormName,sFormValue
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) = iFormEnd
RequestBinDate = ""
Set tStream = Nothing
End Sub
'====================================================================
'验证上传类型
'====================================================================
Private Function CheckErr(Byval ChkExt)
CheckErr=False
If CHK_FileType = "" Then CheckErr=True : Exit Function
Dim ChkStr
ChkStr = ","&Lcase(CHK_FileType)&","
If Instr(ChkStr,","&ChkExt&",")>0 Then _
CheckErr=True _
Else _
Err = 3
End Function
'====================================================================
'图像宽高类型读取
'====================================================================
Private Function Bin2Str(Byval Bin)
Dim i, Str, Sclow
For i = 1 To LenB(Bin)
Sclow = MidB(Bin,i,1)
If ASCB(Sclow)<128 Then
Str = Str & Chr(ASCB(Sclow))
Else
i = i+1
If i <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,i,1)&Sclow))
End If
Next
Bin2Str = Str
End Function
Private Function Num2Str(Byval num,Byval Base,Byval Lens)
Dim ImageSize
ImageSize = ""
While(num>=Base)
ImageSize = (num mod Base) & ImageSize
num = (num - num mod Base)/Base
Wend
Num2Str = Right(String(Lens,"0") & num & ImageSize,Lens)
End Function
Private Function Str2Num(Byval str,Byval Base)
Dim ImageSize,i
ImageSize = 0
For i=1 To Len(str)
ImageSize = ImageSize *Base + Cint(Mid(str,i,1))
Next
Str2Num = ImageSize
End Function
Private Function BinVal(Byval bin)
Dim ImageSize,i
ImageSize = 0
For i = lenb(bin) To 1 Step -1
ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
Next
BinVal = ImageSize
End Function
Private Function BinVal2(Byval bin)
Dim ImageSize,i
ImageSize = 0
For i = 1 To Lenb(bin)
ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
Next
BinVal2 = ImageSize
End Function
Private Function GetImageSize()
Dim ImageSize(2),bFlag
bFlag = oUpFileStream.Read(3)
Select Case Hex(BinVal(bFlag))
Case "4E5089":
oUpFileStream.Read(15)
ImageSize(0) = "png"
ImageSize(1) = BinVal2(oUpFileStream.Read(2))
oUpFileStream.Read(2)
ImageSize(2) = BinVal2(oUpFileStream.Read(2))
Case "464947":
oUpFileStream.Read(3)
ImageSize(0) = "gif"
ImageSize(1) = BinVal(oUpFileStream.Read(2))
ImageSize(2) = BinVal(oUpFileStream.Read(2))
Case "535746":
Dim BinData,sConv,nBits
oUpFileStream.Read(5)
BinData = oUpFileStream.Read(1)
sConv = Num2Str(ASCB(BinData),2 ,8)
nBits = Str2Num(Left(sConv,5),2)
sConv = Mid(sConv,6)
While(Len(sConv)<nBits*4)
BinData = oUpFileStream.Read(1)
sConv = sConv&Num2Str(ASCB(BinData),2 ,8)
Wend
ImageSize(0) = "swf"
ImageSize(1) = Int(ABS(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)
ImageSize(2) = Int(ABS(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)
Case "535743":'flashmx
ImageSize(0) = "swf"
ImageSize(1) = 0
ImageSize(2) = 0
Case "FFD8FF":
Dim p1
Do
Do: p1 = BinVal(oUpFileStream.Read(1)): Loop While p1 = 255 And Not oUpFileStream.EOS
If p1>191 and p1<196 Then Exit Do Else oUpFileStream.Read(BinVal2(oUpFileStream.Read(2))-2)
Do:p1 = BinVal(oUpFileStream.Read(1)):Loop While p1<255 And Not oUpFileStream.EOS
Loop While True
oUpFileStream.Read(3)
ImageSize(0) = "jpg"
ImageSize(2) = BinVal2(oUpFileStream.Read(2))
ImageSize(1) = BinVal2(oUpFileStream.Read(2))
Case Else:
If Left(Bin2Str(bFlag),2) = "BM" Then
oUpFileStream.Read(15)
ImageSize(0) = "bmp"
ImageSize(1) = BinVal(oUpFileStream.Read(4))
ImageSize(2) = BinVal(oUpFileStream.Read(4))
Else
ImageSize(0) = "(UNKNOWN)"
End If
End Select
GetImagesize = ImageSize
End Function
End Class
'文件属性类
Class FileInfo_Class
Public FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt,FileWidth,FileHeight
Private Sub Class_Initialize
FileWidth=0
FileHeight=0
End Sub
'保存文件方法
Public Sub SaveToFile (Byval Path)
Dim Ext,oFileStream
Ext = LCase(Mid(Path, InStrRev(Path, ".") + 1))
If Ext <> FileExt Then Exit Sub
On Error Resume Next
Set oFileStream = CreateObject ("Adodb.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = FileStart
oUpFileStream.CopyTo oFileStream,FileSize
oFileStream.SaveToFile Path,2
oFileStream.Close
Set oFileStream = Nothing
End Sub
'取得文件数据
Public Function FileData
oUpFileStream.Position = FileStart
FileData = oUpFileStream.Read (FileSize)
End Function
End Class
%>
upflie.asp内容如下
<!--#include file="con.asp"-->
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="../css.css" rel="stylesheet" type="text/css">
<!--#include file="up.inc"-->
<%
Set Upload = New UpFile_Class
Upload.InceptFileType = "gif,jpg,bmp,jpeg,png"
Upload.MaxSize = 10240000
Upload.GetDate()
If Upload.Err > 0 Then
Select Case Upload.Err
Case 1 : Response.Write "请先选择你要上传的文件 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
Case 2 : Response.Write "图片大小超过了限制 "&Dvbbs.Forum_Setting(56)&"K [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
Case 3 : Response.Write "所上传类型不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
End Select
Else
FormPath=Upload.Form("filepath")
For Each FormName in Upload.file
Set File = Upload.File(FormName)
If File.Filesize<10 Then
Response.Write "请先选择你要上传的图片 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
End If
FileExt = FixName(File.FileExt)
If Not ( CheckFileExt(FileExt) and CheckFileType(File.FileType) ) Then
Response.Write "文件格式不正确 [ <a href=# onclick=history.go(-1)>重新上传</a> ]"
End If
FileName=FormPath&UserFaceName(FileExt)
If File.FileSize>0 Then
File.SaveToFile Server.mappath(FileName)
response.write "<script>window.opener.document."&upload.form("FormName")&"."&upload.form("EditName")&".value='"&FileName&"'</script>"
Response.Write "<script language=""javascript"">window.alert(""文件上传成功!请不要修改生成的链接地址！"");window.close();</script>"
End If
Set File=Nothing
Next
End If
Set Upload=Nothing
Private Function CheckFileExt(FileExt)
Dim ForumUpload,i
ForumUpload="gif,jpg,bmp,jpeg,png"
ForumUpload=Split(ForumUpload,",")
CheckFileExt=False
For i=0 to UBound(ForumUpload)
If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
CheckFileExt=True
Exit Function
End If
Next
End Function
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Lcase(UpFileExt)
FixName = Replace(FixName,Chr(0),"")
FixName = Replace(FixName,".","")
FixName = Replace(FixName,"asp","")
FixName = Replace(FixName,"asa","")
FixName = Replace(FixName,"aspx","")
FixName = Replace(FixName,"cer","")
FixName = Replace(FixName,"cdx","")
FixName = Replace(FixName,"htr","")
End Function
Private Function UserFaceName(FileExt)
Randomize
RanNum = Int(90000*rnd)+10000
UserFaceName = UserID&Year(now)&Month(now)&Day(now)&Hour(now)&Minute(now)&Second(now)&RanNum&"."&FileExt
End Function
Private Function CheckFileType(FileType)
CheckFileType = False
If Left(Cstr(Lcase(Trim(FileType))),6)="image/" Then CheckFileType = True
End Function
%>
up.inc文件内容
Dim oUpFileStream
Class UpFile_Class
Public Form,File,Version,Err
Private CHK_FileType,CHK_MaxSize
Private Sub Class_Initialize
Version = "无惧上传类 Version V1.0"
Err = -1
CHK_FileType = ""
CHK_MaxSize = -1
Set Form = Server.CreateObject ("Scripting.Dictionary")
Set File = Server.CreateObject ("Scripting.Dictionary")
Set oUpFileStream = Server.CreateObject ("Adodb.Stream")
Form.CompareMode = 1
File.CompareMode = 1
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
End Sub
Private Sub Class_Terminate
'清除变量及对像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
End Sub
Public Property Get InceptFileType
InceptFileType = CHK_FileType
End Property
Public Property Let InceptFileType(Byval vType)
CHK_FileType = vType
End Property
Public Property Get MaxSize
MaxSize = CHK_MaxSize
End Property
Public Property Let MaxSize(vSize)
If IsNumeric(vSize) Then CHK_MaxSize = Int(vSize)
End Property
Public Sub GetDate()
'定义变量
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName,sFormName,RequestSize
Dim iFindStart,iFindEnd,iFormStart,iFormEnd,FileBlag
'代码开始
RequestSize = Int(Request.TotalBytes)
If RequestSize < 1 Then
Err = 1
Exit Sub
End If
Set tStream = Server.CreateObject ("Adodb.Stream")
oUpFileStream.Write Request.BinaryRead (RequestSize)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每个项目之间的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB (sSpace)
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,sSpace)-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_Class
'取得文件属性
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileName = Mid(sFileName,InStrRev(sFileName, "\")+1)
oFileInfo.FilePath = Left(sFileName,InStrRev(sFileName, "\"))
oFileInfo.FileExt = Lcase(Mid(sFileName,InStrRev(sFileName, ".")+1))
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileType = Ucase(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
If Instr(oFileInfo.FileType,"IMAGE/") Or Instr(oFileInfo.FileType,"FLASH") Then
FileBlag = GetImageSize
oFileInfo.FileExt = FileBlag(0)
oFileInfo.FileWidth = FileBlag(1)
oFileInfo.FileHeight = FileBlag(2)
FileBlag = Empty
End If
If CHK_MaxSize > 0 Then
If oFileInfo.FileSize > CHK_MaxSize Then
Err = 2
Exit Sub
End If
End If
If CheckErr(oFileInfo.FileExt) = False Then Exit Sub
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
If Form.Exists (sFormName) Then _
Form (sFormName) = Form (sFormName) & ", " & sFormValue _
Else _
Form.Add sFormName,sFormValue
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) = iFormEnd
RequestBinDate = ""
Set tStream = Nothing
End Sub
'====================================================================
'验证上传类型
'====================================================================
Private Function CheckErr(Byval ChkExt)
CheckErr=False
If CHK_FileType = "" Then CheckErr=True : Exit Function
Dim ChkStr
ChkStr = ","&Lcase(CHK_FileType)&","
If Instr(ChkStr,","&ChkExt&",")>0 Then _
CheckErr=True _
Else _
Err = 3
End Function
'====================================================================
'图像宽高类型读取
'====================================================================
Private Function Bin2Str(Byval Bin)
Dim i, Str, Sclow
For i = 1 To LenB(Bin)
Sclow = MidB(Bin,i,1)
If ASCB(Sclow)<128 Then
Str = Str & Chr(ASCB(Sclow))
Else
i = i+1
If i <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,i,1)&Sclow))
End If
Next
Bin2Str = Str
End Function
Private Function Num2Str(Byval num,Byval Base,Byval Lens)
Dim ImageSize
ImageSize = ""
While(num>=Base)
ImageSize = (num mod Base) & ImageSize
num = (num - num mod Base)/Base
Wend
Num2Str = Right(String(Lens,"0") & num & ImageSize,Lens)
End Function
Private Function Str2Num(Byval str,Byval Base)
Dim ImageSize,i
ImageSize = 0
For i=1 To Len(str)
ImageSize = ImageSize *Base + Cint(Mid(str,i,1))
Next
Str2Num = ImageSize
End Function
Private Function BinVal(Byval bin)
Dim ImageSize,i
ImageSize = 0
For i = lenb(bin) To 1 Step -1
ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
Next
BinVal = ImageSize
End Function
Private Function BinVal2(Byval bin)
Dim ImageSize,i
ImageSize = 0
For i = 1 To Lenb(bin)
ImageSize = ImageSize *256 + ASCB(Midb(bin,i,1))
Next
BinVal2 = ImageSize
End Function
Private Function GetImageSize()
Dim ImageSize(2),bFlag
bFlag = oUpFileStream.Read(3)
Select Case Hex(BinVal(bFlag))
Case "4E5089":
oUpFileStream.Read(15)
ImageSize(0) = "png"
ImageSize(1) = BinVal2(oUpFileStream.Read(2))
oUpFileStream.Read(2)
ImageSize(2) = BinVal2(oUpFileStream.Read(2))
Case "464947":
oUpFileStream.Read(3)
ImageSize(0) = "gif"
ImageSize(1) = BinVal(oUpFileStream.Read(2))
ImageSize(2) = BinVal(oUpFileStream.Read(2))
Case "535746":
Dim BinData,sConv,nBits
oUpFileStream.Read(5)
BinData = oUpFileStream.Read(1)
sConv = Num2Str(ASCB(BinData),2 ,8)
nBits = Str2Num(Left(sConv,5),2)
sConv = Mid(sConv,6)
While(Len(sConv)<nBits*4)
BinData = oUpFileStream.Read(1)
sConv = sConv&Num2Str(ASCB(BinData),2 ,8)
Wend
ImageSize(0) = "swf"
ImageSize(1) = Int(ABS(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20)
ImageSize(2) = Int(ABS(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20)
Case "535743":'flashmx
ImageSize(0) = "swf"
ImageSize(1) = 0
ImageSize(2) = 0
Case "FFD8FF":
Dim p1
Do
Do: p1 = BinVal(oUpFileStream.Read(1)): Loop While p1 = 255 And Not oUpFileStream.EOS
If p1>191 and p1<196 Then Exit Do Else oUpFileStream.Read(BinVal2(oUpFileStream.Read(2))-2)
Do:p1 = BinVal(oUpFileStream.Read(1)):Loop While p1<255 And Not oUpFileStream.EOS
Loop While True
oUpFileStream.Read(3)
ImageSize(0) = "jpg"
ImageSize(2) = BinVal2(oUpFileStream.Read(2))
ImageSize(1) = BinVal2(oUpFileStream.Read(2))
Case Else:
If Left(Bin2Str(bFlag),2) = "BM" Then
oUpFileStream.Read(15)
ImageSize(0) = "bmp"
ImageSize(1) = BinVal(oUpFileStream.Read(4))
ImageSize(2) = BinVal(oUpFileStream.Read(4))
Else
ImageSize(0) = "(UNKNOWN)"
End If
End Select
GetImagesize = ImageSize
End Function
End Class
'文件属性类
Class FileInfo_Class
Public FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt,FileWidth,FileHeight
Private Sub Class_Initialize
FileWidth=0
FileHeight=0
End Sub
'保存文件方法
Public Sub SaveToFile (Byval Path)
Dim Ext,oFileStream
Ext = LCase(Mid(Path, InStrRev(Path, ".") + 1))
If Ext <> FileExt Then Exit Sub
On Error Resume Next
Set oFileStream = CreateObject ("Adodb.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = FileStart
oUpFileStream.CopyTo oFileStream,FileSize
oFileStream.SaveToFile Path,2
oFileStream.Close
Set oFileStream = Nothing
End Sub
'取得文件数据
Public Function FileData
oUpFileStream.Position = FileStart
FileData = oUpFileStream.Read (FileSize)
End Function
End Class
%>
已赞过
已踩过<
评论
收起
你对这个回答的评价是？
更多回答（7）
推荐律师服务：
若未解决您的问题，请您详细描述您的问题，通过百度律临进行免费专业咨询
