一个asp无组件上传的实例

原创 2004年02月25日 10:27:00

<%
'判断是否添加了文件
Dim ulFileName, ulResult

ulSaveToPath="/upload" '保存文件路径
ulMaxFileSize = 1000000 '文件大小限制 1000,000

ulResult = DoUploadFile(ulMaxFileSize, ulFileName)

Function DoUploadFile(MaxUpLoadSize, FileName)
Dim Upload, File, formName, formPath, FileExt
FileName = ""
Set Upload = New upload_yfly '建立上传对象

IF IsNull(Upload.File) THEN
DoUploadFile= 6
EXIT Function
END IF

IF Upload.File.Count = 0 Then
DoUploadFile= 5 'No File uploaded
Else
Set File = Upload.File("ulFileToUpload")
If File.FileName = "" Then
DoUploadFile= 4 'No File uploaded
Else
'上传文件不是空的时候处理上传
'在目录后加(/)
formPath=upload.Form("ulSaveFilePath")

If Right(formPath, 1) <> "/" Then
formPath = formPath & "/"
End If

If File.FileSize < 100 Then
DoUploadFile= 1 '文件大小太小
Exit Function
End If

If File.FileSize > MaxUpLoadSize Then
DoUploadFile= 2 '文件大小超过了限制
Exit Function
End If

FileExt = LCase(Right(File.FileName, 4))
uploadsuc = False

If Not (FileExt = ".gif" Or FileExt = ".jpg") Then
DoUploadFile= 3 '文件格式不正确
Exit Function
End If

Randomize
ranNum = Int(90000 * Rnd) + 10000
'文件名
FileName = formPath & Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & ranNum & FileExt

If File.FileSize > 0 Then ''如果 FileSize > 0 说明有文件数据
File.SaveAs server.mappath(FileName) ''保存文件
End If
DoUploadFile= 0
End If
Set File = Nothing
End If
Set Upload = Nothing '删除此对象
End Function

%>


<SCRIPT RUNAT="SERVER" LANGUAGE="VBSCRIPT">

dim upfile_yfly_Stream

Class upload_yfly

dim Form,File,Version

Private Sub Class_Initialize
dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
Version=""
File = NULL
Form = Null
upfile_yfly_Stream=NULL
if Request.TotalBytes<1 then Exit Sub
set Form=CreateObject("Scripting.Dictionary")
set File=CreateObject("Scripting.Dictionary")
set upfile_yfly_Stream=CreateObject("Adodb.Stream")
upfile_yfly_Stream.mode=3
upfile_yfly_Stream.type=1
upfile_yfly_Stream.open
upfile_yfly_Stream.write Request.BinaryRead(Request.TotalBytes)

vbEnter=Chr(13)&Chr(10)
iDivLen=inString(1,vbEnter)+1
strDiv=subString(1,iDivLen)
iFormStart=iDivLen
iFormEnd=inString(iformStart,strDiv)-1
while iFormStart < iFormEnd
iStart=inString(iFormStart,"name=""")
iEnd=inString(iStart+6,"""")
mFormName=subString(iStart+6,iEnd-iStart-6)
iFileNameStart=inString(iEnd+1,"filename=""")
if iFileNameStart>0 and iFileNameStart<iFormEnd then
iFileNameEnd=inString(iFileNameStart+10,"""")
mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)
if iEnd>iStart then
mFileSize=iEnd-iStart-4
else
mFileSize=0
end if
set theFile=new FileInfo
theFile.FileName=getFileName(mFileName)
theFile.FilePath=getFilePath(mFileName)
theFile.FileSize=mFileSize
theFile.FileStart=iStart+4
theFile.FormName=FormName
file.add mFormName,theFile
else
iStart=inString(iEnd+1,vbEnter&vbEnter)
iEnd=inString(iStart+4,vbEnter&strDiv)

if iEnd>iStart then
mFormValue=subString(iStart+4,iEnd-iStart-4)
else
mFormValue=""
end if
form.Add mFormName,mFormValue
end if

iFormStart=iformEnd+iDivLen
iFormEnd=inString(iformStart,strDiv)-1
wend
End Sub

Private Function subString(theStart,theLen)
dim i,c,stemp
upfile_yfly_Stream.Position=theStart-1
stemp=""
for i=1 to theLen
if upfile_yfly_Stream.EOS then Exit for
c=ascB(upfile_yfly_Stream.Read(1))
If c > 127 Then
if upfile_yfly_Stream.EOS then Exit for
stemp=stemp&Chr(AscW(ChrB(AscB(upfile_yfly_Stream.Read(1)))&ChrB(c)))
i=i+1
else
stemp=stemp&Chr(c)
End If
Next
subString=stemp
End function

Private Function inString(theStart,varStr)
dim i,j,bt,theLen,str
InString=0
Str=toByte(varStr)
theLen=LenB(Str)
for i=theStart to upfile_yfly_Stream.Size-theLen
if i>upfile_yfly_Stream.size then exit Function
upfile_yfly_Stream.Position=i-1
if AscB(upfile_yfly_Stream.Read(1))=AscB(midB(Str,1)) then
InString=i
for j=2 to theLen
if upfile_yfly_Stream.EOS then
inString=0
Exit for
end if
if AscB(upfile_yfly_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
InString=0
Exit For
end if
next
if InString<>0 then Exit Function
end if
next
End Function

Private Sub Class_Terminate
if not isNull(Form) then
form.RemoveAll
set form=nothing
end if
if not isNull(File) then
file.RemoveAll
set file=nothing
end if
if not isNull(upfile_yfly_Stream) then
upfile_yfly_Stream.close
set upfile_yfly_Stream=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

Private function toByte(Str)
dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode<0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function
End Class


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

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

采用艾恩asp上传的角本

最近因一个小开发的需求,进行了Asp的文件上,在网上也看了不少的文章,多数都是将文件写入与文件上分开,另一方面就是写的不是很明确。而最终,我采用了艾恩asp上传的角本。这一点非常感谢艾恩的大力贡献,有...
  • qiushuisen
  • qiushuisen
  • 2015年10月25日 19:46
  • 1071

ASP无组件上传的原理

无组件上传一直是困扰大家的一个问题。其实原理非常简单,核心就是分析字符串。不过,实际操作时,却困难重重。其中的关键问题还是大家往往对原理的剖析不够深入,或是因为过程过于繁琐。   客户端HTML使用...
  • u013450434
  • u013450434
  • 2014年01月12日 08:49
  • 298

ASP无组件上传进度条解决方案

一、无组件上传的原理 我还是一点一点用一个实例来说明的吧,客户端HTML如下。要浏览上传附件,我们通过<input type="file">元素,但是一定要注意必须设置form的enctype属...
  • u012971242
  • u012971242
  • 2013年11月27日 11:47
  • 582

ASP上传图片代码例子

index.asp
  • tomora
  • tomora
  • 2013年09月15日 10:25
  • 2972

asp实现无组件上传文件原理

一、上传网页       上传页面代码:       action="upload.asp"   method="post"   enctype="multipart/form-...
  • wkj001
  • wkj001
  • 2016年11月25日 13:05
  • 1131

ASP_一般处理程序_图片上传

首先创建一个文件,用于存放图片:Upload UploadImg.htm:                 window.onload = function() {             ...
  • u010909858
  • u010909858
  • 2013年11月27日 17:00
  • 1337

【ASP】文件上传

由于VBScript这门古老的编程语言并没有像ASP.NET,Servlet、Struts2,PHP等封装好文件上传的方法,绝对不可能一个request.form["file"]就能够拿到文件,因此处...
  • yongh701
  • yongh701
  • 2016年01月20日 17:09
  • 4363

asp 批量同时上传文字和图片的实现。

先上代码: 表单部分: [vb] view plaincopy "-//W3C//DTD XHTML 1.0 Transitional//EN...
  • SJian123
  • SJian123
  • 2014年07月03日 10:19
  • 3272

ASP文件上传方式大比拼

无组件方式   1.化境ASP无组件上传 V2.0;     一直以来,由于FileSystemObject的局限,所以ASP最大的难题就是文件上传,大多解决法就是安装第三方上传组件。可第三方...
  • Chinamming
  • Chinamming
  • 2013年05月21日 23:06
  • 1127

ASP使用ASPupload组件上传多个文件

ASP使用ASPupload组件上传多个文件的示例,ASPupload是一款专门在ASP环境下上传文件的一个组件,支持多文件上传,本教程主要是演示如何使用aspupload上传文件。测试前,请确保你已...
  • SJian123
  • SJian123
  • 2014年07月03日 10:03
  • 2185
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:一个asp无组件上传的实例
举报原因:
原因补充:

(最多只允许输入30个字)