ASP上传图片代码,最简单的

ASP上传图片代码,最简单的,第1张

无惧无组件上传

这是放到前面让选择图片的代码和上传按钮 <form action="Upfile_ProductPic.asp?Act=index" method="post" name="form2" onSubmit="return check()" enctype="multipart/form-data">

<input name="FileName" type="FILE" class="tx1" size="22">

<input type="submit" name="Submit1" value="上传" style="border:1px double rgb(88,88,88)font:9pt">

</form>

这是Upfile_ProductPic.asp文件,修改下存储路径和数据表

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"><%@language=vbscript codepage=936 %>

<!--#include file="config.asp"-->

<!--#include file="upfile_class.asp"-->

<!--#include virtual="/config/config.asp"-->

<%

picname=Requesta("Act")

const upload_type=0 '上传方法:0=无惧无组件上传类,1=FSO上传 2=lyfupload,3=aspupload,4=chinaaspupload

'const SaveUpProductPicPath="UploadProductPic"

'const UpProductPicType="jpg|gif|png|bmp"

'const MaxProductPicSize=20480000

dim upload,oFile,formName,SavePath,FileName,fileExt,oFileSize

dim EnableUpload

dim arrUpFileType

dim ranNum

dim msg,FoundErr

msg=""

FoundErr=false

EnableUpload=false

SavePath = "upfiles/" '存放上传文件的目录

%>

<html>

<head>

<meta http-equiv="Content-Type" content="text/htmlcharset=gb2312">

</head>

<body leftmargin="2" topmargin="5" marginwidth="0" marginheight="0">

<%

if EnableUploadFile="No" then

response.write "系统未开放文件上传功能"

else

select case upload_type

case 0

call upload_0() '使用化境无组件上传类

case else

'response.write "本系统未开放插件功能"

'response.end

end select

end if

%>

</body>

</html>

<%

sub upload_0()'使用化境无组件上传类

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

upload.GetData(20480000) '取得上传数据,限制最大上传500K

if upload.err >0 then '如果出错

select case upload.err

case 1

response.write "请先选择你要上传的文件!"

case 2

response.write "你上传的文件总大小超出了最大限制(20M)"

end select

response.end

end if

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

EnableUpload=False

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

oFileSize=ofile.filesize

if oFileSize<10 then

msg="请先选择你要上传的文件!!"

FoundErr=True

elseif ofilesize>(MaxProductPicSize*1024) then

msg="文件大小超过了限制,最大只能上传" &CStr(MaxProductPicSize) &"K的文件!"

FoundErr=true

end if

fileExt=lcase(ofile.FileExt)

arrUpFileType=split(UpProductPicType,"|")

for i=0 to ubound(arrUpFileType)

if fileEXT=trim(arrUpFileType(i)) then

EnableUpload=true

exit for

end if

next

if fileEXT="asp" or fileEXT="asa" or fileEXT="aspx" or fileEXT="cer" or fileEXT="cdx" then

EnableUpload=false

end if

if EnableUpload=false then

msg="这种文件类型不允许上传!\n\n只允许上传这几种文件类型:" &UpProductPicType

FoundErr=true

end if

strJS="<SCRIPT language=javascript>" &vbcrlf

if FoundErr<>true then

randomize

ranNum=int(900*rnd)+100

FileName="../../"&SavePath&picname&"."&fileExt

ofile.SaveToFile Server.mappath(FileName) '保存文件

conn.open constr

sql="update indexPic set p_picture='"&picname&"."&fileExt&"' where p_name='"&picname&"'"

conn.execute(sql)

conn.close

Alert_reDirect "上传成功!","indexPic.asp"

end if

next

set upload=nothing

end sub

%>

这是upfile_class.asp文件,不用更改。

<%

Dim oUpFileStream

'----------------------------------------------------------------------

'文件上传类

Class UpFile_Class

Dim Form,File,Version,Err

Private Sub Class_Initialize

Version = "无惧上传类 Version V1.2"

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 GetData (MaxSize)

'定义变量

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 MaxSize >0 Then '如果限制大小

If Request.TotalBytes >MaxSize Then

Err = 2 '如果上传的数据超出限制

Exit Sub

End If

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

'分解项目

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 = Trim(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 = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))

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

oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\"))

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

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)

if lcase((right(Path,3))<>lcase(FileExt)) then '经典的上传漏洞^_^

response.Write ("<script language=javascript>alert('警告:不允许上传这种文件!')</script>")

response.end

end if

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 FileData

oUpFileStream.Position = FileStart

FileData = oUpFileStream.Read (FileSize)

End Function

End Class

'**************************************************

'函数名:IsObjInstalled

'作 用:检查组件是否已经安装

'参 数:strClassString ----组件名

'返回值:True ----已经安装

' False ----没有安装

'**************************************************

Function IsObjInstalled(strClassString)

On Error Resume Next

IsObjInstalled = False

Err = 0

Dim xTestObj

Set xTestObj = Server.CreateObject(strClassString)

If 0 = Err Then IsObjInstalled = True

Set xTestObj = Nothing

Err = 0

End Function

'-------------根据指定名称生成目录---------

Function MakeNewsDir(foldername)

dim fso,f

Set fso = Server.CreateObject("Scripting.FileSystemObject")

Set f = fso.CreateFolder(foldername)

MakeNewsDir = True

Set fso = nothing

End Function

%>

保存文件名“upload.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>

文件二 upload.asp

<form name="form1" method="post" action="upfile.asp" enctype="multipart/form-data" >

照片上传

<input type="file" name="file1" >

<input type="submit" value="提 交">

</form>

文件三 upfile.asp

<!--#include FILE="upload_5xsoft.inc"-->

<link href="MAIN1024.css" rel="stylesheet" type="text/css">

<%

Set upload = New upload_5xsoft

f= Server.MapPath("pic")&"/"

Set file = upload.file("file1")

n = right(file.FileName,4)

s=replace(now(),":","")

s=replace(now(),"-","")

s=replace(now()," ","")

file.SaveAs f&s&n

session("image")=s&n

Response.Write "上传成功"

%>


欢迎分享,转载请注明来源:夏雨云

原文地址:https://www.xiayuyun.com/zonghe/624305.html

(0)
打赏 微信扫一扫微信扫一扫 支付宝扫一扫支付宝扫一扫
上一篇 2023-07-16
下一篇2023-07-16

发表评论

登录后才能评论

评论列表(0条)

    保存