ASP无组件上传图片

来源：互联网发布：女生逆袭成女神知乎编辑：程序博客网时间：2024/05/01 05:09

Dim oUpFileStream

Class UpFile_Class

Dim Form,File,Version,Err

Private Sub Class_Initialize

Version = "Version V1.0"

Err = -1

End Sub

Private Sub Class_Terminate

'清除变量及对像

If Err < 0 Then

Form.RemoveAll

Set Form = Nothing

File.RemoveAll

Set File = Nothing

oUpFileStream.Close

Set oUpFileStream = Nothing

End If

End Sub

Public Sub GetDate (RetSize)

'定义变量

Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo

Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName

Dim iFindStart,iFindEnd

Dim iFormStart,iFormEnd,sFormName

'代码开始

If Request.TotalBytes < 1 Then

Err = 1

Exit Sub

End If

If RetSize > 0 Then

If Request.TotalBytes > RetSize Then

Err = 2

Exit Sub

End If

Set Form = Server.CreateObject ("Scripting.Dictionary")

Form.CompareMode = 1

Set File = Server.CreateObject ("Scripting.Dictionary")

File.CompareMode = 1

Set tStream = Server.CreateObject ("ADODB.Stream")

Set oUpFileStream = Server.CreateObject ("ADODB.Stream")

oUpFileStream.Type = 1

oUpFileStream.Mode = 3

oUpFileStream.Open

oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)

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

'分解项目

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, "")+1)

oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)

iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14

iFindEnd = InStr (iFindStart,sInfo,vbCr)

oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart)

oFileInfo.FileStart = iInfoEnd

oFileInfo.FileSize = iFormStart -iInfoEnd -2

oFileInfo.FormName = sFormName

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

End Class

'文件属性类

Class FileInfo_Class

Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt

'保存文件方法

Public Function SaveToFile (Path)

On Error Resume Next

Dim oFileStream

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 Function

'取得文件数据

Public Function FileDate

oUpFileStream.Position = FileStart

FileDate = oUpFileStream.Read (FileSize)

End Function

End Class

<html>

<head>

Server.ScriptTimeOut=999999'要是你的上传的文件比较大，就必须设置。

'定义变量

dim Forumupload,ranNum

dim formName,formPath,filename,file_name,fileExt,Filesize,F_Type

dim dateupnum

dim rename

dim previewpath,F_Viewname

F_Viewname=""

previewpath="PreviewImage/"

'===========================无组件上传============================

if request("up")=123 then

Server.ScriptTimeOut=10000

dim upload,file

set upload=new UpFile_Class ''建立上传对象

upload.GetDate (10000000*1024) '取得上传数据,不限大小

formPath=upload.form("filepath")

'在目录后加(/)

if right(formPath,1)<>"/" then formPath=formPath&"/"

for each formName in upload.file ''列出所有上传了的文件

set file=upload.file(formName) ''生成一个文件对象

fileExt=lcase(file.FileExt) ''文件类型

'付值变量

randomize

ranNum=int(90000*rnd)+10000

'file_name=lcase(file.filename)

'filename=file_name&"."&fileExt

filename=lcase(file.filename)

rename=filename&"│"

filename=formPath&filename

Filesize=file.FileSize

'记录文件

if Filesize>0 then '如果 FileSize > 0 说明有文件数据

file.SaveToFile Server.mappath(FileName) ''执行上传文件

end if

set file=nothing

'===========================无组件上传完============================

end if

</head>

<body>

<form name="form" method="post" action="<%=url%>?up=123" enctype="multipart/form-data">

传至服务器已有虚拟目录:

本地文件：

</td></tr>

</table>

</form>

</body>

</html>