信阳毛尖南阳茶叶店网站后台文件上传图片保存页面源代码.docx
《信阳毛尖南阳茶叶店网站后台文件上传图片保存页面源代码.docx》由会员分享，可在线阅读，更多相关《信阳毛尖南阳茶叶店网站后台文件上传图片保存页面源代码.docx（18页珍藏版）》请在冰点文库上搜索。
信阳毛尖南阳茶叶店网站后台文件上传图片保存页面源代码
--信阳毛尖南阳茶叶店网站后台文件上传图片保存页面源代码-->
--#includevirtual="Common.asp"-->
--#includevirtual="
'此类在初始化时完成扫描
'此类不能处理有重名项的表单
Response.Expires=0
Response.Expiresabsolute=Now（）-1
Response.AddHeader"pragma","no-cache"
Response.AddHeader"cache-control","private"
Response.CacheControl="no-cache"
Server.ScriptTimeOut=120
ClassQuickUpload
PrivateFForm,FFile,Upload_Stream
propertygetForm
setForm=FForm
endproperty
propertygetFile
setFile=FFile
endproperty
PrivateSubClass_Initialize
dimiStart,iEnd,boundary,FieldName,FileName,ContentType,ItemValue,theFile
setFForm=CreateObject（"Scripting.Dictionary"）
setFFile=CreateObject（""）
setUpload_Stream=CreateObject（"Adodb.Stream"）
Upload_Stream.mode=3
Upload_Stream.type=1
Upload_Stream.open
ifRequest.TotalBytes<1thenExitSub
dStart=CDbl（Time）
'dimnByte
'nByte=65536
'dowhilenByte=65536
'Upload_Stream.writeRequest.BinaryRead（nByte）
'loop
'Response.Write"readtime:
"&（CDbl（Time）-dStart）*24*60*60&"
"
'dStart=CDbl（Time）
'查找第一个边界
'iStart=1
'boundary=GetALine（iStart）
iStart=GetAChunk（1,ChrB（13）&ChrB（10）,false,null）
boundary=subString（1,iStart-2-1）
'不是结束边界,则循环
dowhileStrComp（subString（iStart-2,2）,ChrB（45）&ChrB（45））<>0
'取表单项信息头
iStart=ParseHeader（iStart,FieldName,FileName,ContentType）
'取表单项内容
ifFileName<>""then
settheFile=newFileInfo
theFile.InitFileName,ContentType
setdest=theFile.Stream
iNewStart=GetAChunk（iStart,boundary,true,dest,www.zhongguopingan.org）
FFile.addFieldName,theFile
else
iNewStart=GetAChunk（iStart,boundary,false,null）
FForm.AddFieldName,ByteToStr（subString（iStart,iNewStart-iStart-LenB（boundary）-2））
endif
iStart=iNewStart+2
loop
'Response.Write"parsetime:
"&（CDbl（Time）-dStart）*24*60*60&"
"
EndSub
privatefunctionParseHeader（theStart,byrefFieldName,byrefFileName,byrefContentType）
iStart=theStart
dowhiletrue
'取一行
iNewStart=GetAChunk（iStart,ChrB（13）&ChrB（10）,false,null）
Line=ByteToStr（subString（iStart,iNewStart-2-iStart））
iStart=iNewStart
'空行，则跳出循环
ifLine=nullorLine=""thenExitdo
pos=instr（Line,":
"）
ifpos>0then
ifStrComp（left（Line,pos-1）,"Content-Disposition",1）=0then
'取表单项名称
FieldName=ExtractValue（Line,pos+1,"name"）
'取文件名称
FileName=ExtractValue（Line,pos+1,""）
'删除文件路径
FileName=Mid（FileName,InStrRev（FileName,"\"）+1）
elseifStrComp（left（Line,pos-1）,"Content-Type",1）=0then
'取文件类型
ContentType=trim（mid（Line,pos+1））
endif
endif
loop
ParseHeader=iStart
endfunction
PrivateFunctionGetAChunk（theStart,delimiter,isFile,dest）
iStart=theStart
pos=0
dowhilepos=0
'长度不够，读一块
ifUpload_Stream.Size+1-iStartUpload_Stream.writeRequest.BinaryRead（）
endif
'取一段数据
Upload_Stream.Position=iStart-1
buf=Upload_Stream.Read（-1）
'检测边界
pos=InStrB（buf,delimiter）
'如果未找到,向后移动
ifpos=0then
l=LenB（buf）-LenB（delimiter）+1
else
l=pos-1
endif
ifisFilethen
Upload_Stream.Position=iStart-1
buf=Upload_Stream.Read（l）
dest.Writebuf
buf=Upload_Stream.Read（-1）
Upload_Stream.Position=iStart-1
Upload_Stream.SetEOS
Upload_Stream.Writebuf
else
iStart=iStart+l
endif
loop
ifisFilethen
dest.Position=dest.Size-2
dest.SetEOS
endif
GetAChunk=iStart+LenB（）
Endfunction
privatefunctionExtractValue（line,pos,name）
dimt,p
ExtractValue=""
t=name+"="""
p=instr（pos,line,t）
ifp>0then
n1=p+len（t）
n2=instr（n1,line,""""）
ifn2>n1thenExtractValue=mid（line,n1,n2-n1）
endif
endfunction
PrivateFunctionsubString（,theLen）
iftheLen>0then
Upload_Stream.Position=theStart-1
subString=midb（Upload_Stream.Read（theLen）,1）
else
subString=""
endif
Endfunction
PrivatefunctionByteToStr（vIn）
dimi,c
ByteToStr=""
fori=1toLenB（vIn）
c=ascB（midB（vIn,i,1））
Ifc>127Then
ifi=LenB（vIn）thenExitFor
ByteToStr=ByteToStr&Chr（AscW（ChrB（AscB（www.bj-（vIn,i+1,1）））&ChrB（c）））
i=i+1
else
ByteToStr=ByteToStr&Chr（c）
EndIf
Next
endfunction
PrivateSubClass_Terminate
form.RemoveAll
file.RemoveAll
setform=nothing
setfile=nothing
Upload_Stream.close
setUpload_Stream=nothing
EndSub
EndClass
ClassFileInfo
PrivateFFileName,,FFileStart,FFileSize,FStream
propertygetFileName
FileName=FFileName
endproperty
propertygetContentType
ContentType=FContentType
endproperty
propertygetFileSize
FileSize=FFileSize
endproperty
propertygetStream
setStream=FStream
endproperty
PublicSubInit（,AContentType）
FFileName=AFileName
FContentType=AContentType
EndSub
PublicfunctionSaveAs（FullPath）
dimdr,ErrorChar,i
dStart=CDbl（Time）
SaveAs=1
iftrim（fullpath）=""orright（fullpath,1）=""thenexitfunction
OnErrorResumeNext
FStream.SaveToFileFullPath,2
ifErr.Number>0thenResponse.Write"保存数据出错：
"&Err.Description&"
"
SaveAs=0
'Response.Write"savetime:
"&（CDbl（Time）-dStart）*24*60*60&"
"
endfunction
PrivateSubClass_Initialize
setFStream=CreateObject（"Adodb.Stream"）
FStream.mode=3
FStream.type=1
FStream.open
endsub
PrivateSubClass_Terminate
FStream.Close
setFStream=nothing
endsub
EndClass
上传LOGO
body{
font-size:
12px;
margin-left:
0px;
margin-top:
0px;
margin-right:
0px;
margin-bottom:
0px;
}
td{
font-size:
12px;
}
<%
setupload=newQuickUpload
setForms=upload.Form
f=Forms（"f"）
UpPath=Forms（"UpPath"）
hiddenStr=Forms（"hiddenStr"）
obj=Forms（"obj"）
fileType=Forms（"fileType"）
autoZip=Forms（"autoZip"）
%>
//双击选择文件
functionselImgSrc（src）
{
top.dialogArguments.document.all（"<%=obj%>"）.value="<%=UpPath%>"+src;
window.close（）;
}
<%
IsTitleImage=Forms（"IsTitleImage"）
TitleImageSize=Forms（"TitleImageSize"）
IfTitleImageSize="0"Then
TitleImageWidth=Forms（"TitleImageWidth"）
TitleImageHeight=Forms（"TitleImageHeight"）
Else
TitleImageWidth=Split（TitleImageSize,","）（0）
TitleImageHeight=Split（TitleImageSize,","）
（1）
EndIf
IsAddWater=Forms（"IsAddWater"）
isBack=Forms（"isBack"）
Files=upload.File.Items
fori=0toupload.File.Count-1
setfile=Files（i）
FileTypes=Split（file.FileName,"."）
fileExt=lcase（FileTypes（UBound（FileTypes）））
'限制上传的文件类型
IffileExt="asp"orfileExt="aspx"orfileExt="asa"orfileExt="php"orfileExt="exe"orfileExt="dll"orfileExt="bat"Then
Response.Write（"禁止上传的文件格式,"&hiddenStr&""">重新上传"）:
Response.End（）
EndIf
'只允许上传的文件
IfInstr（fileType,fileExt）<=0ANDfileType<>""Then
Response.Write（"只允许上传|"&fileType&"类型的文件,"&hiddenStr&""">重新上传"）:
Response.End（）
EndIf
IfForms（"SaveNameType"）="YES"Then
FileName=Common_Class_new.CreatStrId&"."&fileExt
Else
FileName=file.FileName
EndIf
FileName=Replace（FileName,";",""）
SelectCasef
Case"SelSiteMod"'上传模板
FilePath=Server.mappath（""&UpPath&"/mod.gif"）
rContent="上传成功,parent.closeWinPop（parent.new_i）'>关闭"
CaseElse
FilePath=Server.mappath（UpPath&FileName）
rContent="selImgSrc（'"&FileName&"'）;"
EndSelect
file.SaveAs（FilePath）
setfile=nothing
If（fileExt="jpg"orfileExt="jpeg"orfileExt="gif"orfileExt="png"）Then
IfIsTitleImage="on"Then
SetJpeg=Server.CreateObject（"Persits.Jpeg"）'创建实例
Jpeg.OpenFilePath'打开图片
'调整宽度和高度为原来的50%
Jpeg.Width=TitleImageWidth
Jpeg.Height=TitleImageHeight
Jpeg.SaveFilePath'保存图片到磁盘
Jpeg.Close:
SetJpeg=Nothing
EndIf
'加水印
IfIsAddWater="on"Then
SourceFile=Server.MapPath（"configurationWaterMark.xml"）
SetobjXML=Server.CreateObject（""）
objXML.LoadSourceFile
setobjnode=objXML.documentElement.SelectSingleNode（"//data//WaterMark"）
WaterMarkPosition=objnode.Attributes.item（0）.Text
WaterMarkTransparency=objnode.Attributes.item
（1）.Text
IsImageWaterMark=objnode.Attributes.item
（2）.Text
WaterMarkFormatString=objnode.Attributes.item（3）.Text
WaterMarkFormatString=Replace（WaterMarkFormatString,"{1}",Date（））
WaterMarkFormatString=Replace（WaterMarkFormatString,"{2}",Time（））
WaterMarkFontName=objnode.Attributes.item（4）.Text
WaterMarkFontSize=objnode.Attributes.item（5）.Text
WaterMarkImagePath=objnode.Attributes.item（6）.Text
SelectCaseIsImageWaterMark
Case"True"'图片
'建立图片对象
SetPhoto=Server.createObject（"Persits.Jpeg"）
'打开图片
Photo.OpenFilePath
'建立LOGO对象
SetLogo=Server.createObject（""）
'LOGO位置
LogoPath=Server.MapPath（WaterMarkImagePath）
'打开LOGO
Logo.OpenLogoPath
'设置LOGO大小
'Logo.Width=90
'Logo.Height=Logo.Width*Logo.OriginalHeight/Logo.OriginalWidth
'设置图片水印位置，LOGO透明度，抽取LOGO背景颜色（白色），并删除
SelectCaseWaterMarkPosition
Case"1"
Draw_Left=0:
Draw_Top=0
Case"2"
Draw_Left=（Photo.Width-Logo.Width）/2:
Draw_Top=0
Case"3"
Draw_Left=（Photo.Width-Logo.Width）:
Draw_Top=0
Case"4"
Draw_Left=0:
Draw_Top=（Photo.Height-Logo.Height
升级会员 