ASP环境下无组件上传

主题: ASP环境下无组件上传

作者: refeng, 发布日期: 2007-11-15 14:04:25, 浏览数: 7921

使用了求求的代码，有几地方改了一下

upload.asp文件：


<%

set upload=new upload_5xsoft
set file=upload.file("fileData")

'得到POST参数
Dim FileName, FileWidth, FileHeight, FileBorder, FileTitle, FileAlign, FileHspace, FileVspace
FileName = upload.form("fileName")
FileWidth = upload.form("imgWidth")
FileHeight = upload.form("imgHeight")
FileBorder = upload.form("imgBorder")
FileTitle = upload.form("imgTitle")
FileAlign = upload.form("imgAlign")
FileHspace = upload.form("imgHspace")
FileVspace = upload.form("imgVspace")

IDstring=file.filename
IDstring=Replace(IDstring,"-","")
IDstring=Replace(IDstring,":","")
IDstring=lcase(right(IDstring,3))
randomize
ranNum=int(9000000*rnd)+10000
fileadd=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum
IDstring=fileadd&"."&IDstring
'文件保存目录路径
pthString="../attached/"
Dim SavePath
SavePath = pthString

'文件保存目录URL
Dim SaveUrl
SaveUrl = "attached/"

Dim FilePath, FileUrl
FilePath = SavePath & IDstring
FileUrl = SaveUrl & IDstring

'控制文件大小
IF cint(file.FileSize/1024)>=150 THEN
response.write("<script>alert('上传图片大小不得大于150K。请返回');history.go(-1);</script>")
response.end
end if

'检查文件名后缀是否合法
FileTpe=Mid(file.filename,Len(file.filename)-2)
FileTpe=trim(lcase(FileTpe))

strallow=lcase("bmp,jpg,gif,png,doc,xls")
if FileTpe<>"" and instr(strallow,FileTpe)<1 then
response.write("<script>alert('上传的图片只能是"&strallow&"中的一种！，系统拒绝你的请求。请返回');history.go(-1);</script>")
response.end
end if

file.saveAs Server.mappath(pthString & IDstring )
set file=nothing

Response.Write "<html>"
Response.Write "<head>"
Response.Write "<title>error</title>"
Response.Write "<meta http-equiv=""content-type"" content=""text/html; charset=gb2312"">"
Response.Write "</head>"
Response.Write "<body>"
Response.Write "<script type=""text/javascript"">parent.KindInsertImage(""" & FileUrl & """,""" & FileWidth & """,""" & FileHeight & """,""" & FileBorder & """,""" & FileTitle & """,""" & FileAlign & """,""" & FileHspace & """,""" & FileVspace & """);</script>"
Response.Write "</body>"
Response.Write "</html>"

%>

upload_5xsoft.inc文件：

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft

Class upload_5xsoft

dim objForm,objFile,Version

Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function

Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function

Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version="化境HTTP上传程序 Version 2.0"
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_5xsoft = Server.CreateObject("adodb.stream")
Data_5xsoft.Type = 1
Data_5xsoft.Mode =3
Data_5xsoft.Open
Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)
Data_5xsoft.Position=0
RequestData =Data_5xsoft.Read

iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iInfoEnd
Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub

Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
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
End Class

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

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

作者: ben3, 发布日期: 2007-12-02 23:24:59

感谢.:)

作者: fangjun, 发布日期: 2008-01-15 10:48:27

提示:
=================================================
Microsoft VBScript 运行时错误错误 '800a0005'

无效的过程调用或参数: 'Mid'

/shopv2/fangjun/kindeditor/upload_cgi/upload.ASP，行 52

---------------------------------------------------
52)FileTpe=Mid(file.filename,Len(file.filename)-2)
53)FileTpe=trim(lcase(FileTpe))
---------------------------------------------------
怎么办？？？MSN:fangjun8888@hotmail.com
谢谢。

作者: 小竣, 发布日期: 2008-06-17 07:26:11

感谢为作者的劳动成果喝彩~

论坛 Forum