photo_upload.asp

WAP网上购物系统源程序,,有兴趣的朋友,一起研究一下..交流经眼

<!--#include file=INC/skin.asp-->

<%
Dim const_txl_HomeUrl,errstr,sql
Dim intro,filename,maxPhotoSize,upflag,newphotoid,PhotoSize,PhotoFormat
intro=""
filename=""
maxPhotoSize=const_PhotoMaxSize
upflag=False
const_txl_HomeUrl=""
Call OpenDatabase
Call txl_SiteHead(const_txlname&"-手机相册-上传照片")
Call online
Response.Flush
Call main
Response.Flush
Call CloseDatabase
Call web_end

Sub main
	Dim tmpstr
	if outsitesubmit Then
		Call printerror ("上传照片出错","<li>请不要外部提交数据！</li>",779)
		exit sub
	End If
	If session("username")="" Then
		errstr=errstr&"<li>你现在还没有登录或者会话超时,点<a href='user_login.asp'>这里登录</a>!</li>"
		errstr=errstr&"<li>如果还有疑问请与管理员联系!</li>"
		Call printerror("上传照片出错！",errstr,779)
		Exit Sub
	End If
	If 	const_upphoto_limit=1 Then
		If session("usertype")="" or session("usertype")=1 or session("usertype")=2 Then
			errstr=errstr&"<li>Wap影音当前设置<font color='red'>影音好友和准影音成员不能上传照片</font>!</li>"
			errstr=errstr&"<li>如果还有疑问请与管理员联系!</li>"
			Call printerror("上传照片出错！",errstr,779)
			Exit Sub
		End If
	End If
	Select Case	const_uploadcomponent	
	'1无组件,2为FileUp组件,3为ABCUPload
		Case 1
			Call upload_5xsoft_upload
		Case 2:
			Call FileUp_upload
		Case 3:
			Call ABC_upload
	end select 
	intro=htmlEncode(intro)
	intro=Replace(intro,"'","''")
	If upflag=False Then
		Exit Sub
	Else
		Call SaveToDataBase
	End If
	tmpstr="<li>恭喜你，上传照片成功！</li>"&Vbcrlf
	tmpstr=tmpstr&"<li>刚才你上传照片的主题是<font color='red'>"&intro&"</font></li>"
	tmpstr=tmpstr&"<li>回<a href='photo_show.asp'>手机相册</a></li>"
	tmpstr=tmpstr&"<li>文件已上传成功，你可以在1小时后查看到刚<a href='photo_view.asp?picid="&newphotoid&"'>上传的文件</a>，请不要重复上传</li>"
	tmpstr=tmpstr&"<li>同时你也可以用手机登录http://wap.81238.net下载你上传的图片</li>"
	Call printsuc("上传照片成功",tmpstr,779)
End Sub
Sub upload_5xsoft_upload
%>
<!--#include file=INC/upload_5xsoft.inc-->
<%
	on error resume next
	Dim upload,file,formName,FileExp,iCount,TotalSize
	set upload=new upload_5xsoft
	If not isobject(upload) Then
		Call printerror ("上传照片出错","<li>服务器不支持该上传对象！</li>",779)
		upflag=False
		exit sub
	End If
	intro=Trim(upload.form("intro"))
	If  intro="" Then
		Call printerror ("上传照片出错","<li>请输入简短照片说明！</li>",779)
		upflag=False
		exit sub
	End If
	iCount=0
	For each formName in upload.objFile 
		Set file=upload.file(formName)  
		If file.FileSize>0 Then         
			FileExp=Right(file.FileName,Len(file.FileName)-InstrRev(file.FileName,".")+1)
			If not CheckExp(FileExp) Then
				Call printerror ("上传照片出错","<li>Wap影音当前设置不能上传该格式的文件！</li>",779)
				upflag=False
				exit sub
			End IF
			PhotoFormat=FileExp
			TotalSize=file.FileSize/1024
			PhotoSize=TotalSize
			If TotalSize>maxPhotoSize Then
				Call printerror ("上传照片出错","<li>所传文件已经大于Wap影音设定的允许值<font color=red>"&maxPhotoSize&"K</font>，当前所传文件大小"&TotalSize&"Kb！</li>",779)
				upflag=False
				exit sub
			End If
			filename=GetRndFileName&FileExp
			File.SaveAs Server.mappath(const_txl_HomeUrl&const_photoup_path&filename)   ''保存文件
			iCount=iCount+1
		Else 
			Call printerror ("上传照片出错","<li>上传数据为空，请检查该文件是否存在！</li>",779)
			upflag=False
			exit sub
		 End If
		Set File=nothing
	next
	set upload=nothing  ''删除此对象
	upflag=True
End Sub

Sub FileUp_upload
	'说明：此组件有个很大的缺点,文件大小只能在上传完成之后才能读出来,
	'因此文件大于规定大小时,文件已经上传,但是数据库中并不会添加记录
	on error resume next
	Dim FileUp,FileExp,filehead,NewFileName,intstart,intend,TotalSize
	set FileUp=Server.CreateObject("FileUp.upload")
	If Not IsObject(FileUp) Then
		Call printerror ("上传照片出错","<li>服务器不支持该上传对象！</li>",779)
		upflag=False
		exit sub
	End If
	
	filehead=FileUp.Userfilename
	intstart=Instr(filehead,"name="&chr(34)&"intro"&chr(34))+len("name="&chr(34)&"intro"&chr(34))
	intro=mid(filehead,intstart,Len(filehead)-Instr(Right(filehead,intstart),"------"))
	intro=left(intro,Instr(intro,"---")-1)
	intro=Replace(intro,vbcrlf,"")
	intro=Trim(Intro)
	NewFileName=Mid(fileup.UserFilename,InstrRev(Replace(Fileup.UserFilename,"/","\"), "\") + 1)
	If  intro="" Then
		Call printerror ("上传照片出错","<li>请输入简短照片说明！</li>",779)
		upflag=False
		exit sub
	End If
	FileExp=Right(NewFileName,Len(NewFileName)-InstrRev(NewFileName,".")+1)
	If not CheckExp(FileExp) Then
			Call printerror ("上传照片出错","<li>Wap影音当前设置不能上传该格式的文件！</li>",779)
			upflag=False
			exit sub
	End IF
	filename=GetRndFileName&FileExp
	FileUp.SaveAs Server.mappath(const_txl_HomeUrl&const_photoup_path&filename)   ''保存文件
	If FileUp.TotalBytes <> 0 then
		TotalSize=FileUp.TotalBytes/1024
		PhotoSize=TotalSize
		If TotalSize>maxPhotoSize Then
			Call printerror ("上传照片出错","<li>所传文件已经大于Wap影音设定的允许值<font color=red>"&maxPhotoSize&"K</font>，当前所传文件大小"&TotalSize&"Kb！</li>",779)
			upflag=False
			exit sub
		End If
		PhotoFormat=FileExp
		PhotoSize=TotalSize
		upflag=True
	Else
		Call printerror ("上传照片出错","<li>上传数据为空，请检查该文件是否存在！</li>",779)
		upflag=False
		Exit sub
	End if
End Sub



Sub ABC_upload
	Dim theForm,fileup,imagesize,extname
	Set theForm = Server.CreateObject("ABCUpload4.XForm")
	If Not IsObject(theForm) Then
		Call printerror ("上传照片出错","<li>服务器不支持该上传对象！</li>",779)
		upflag=False
		exit sub
	End If
	theForm.AbsolutePath = True
	theForm.Overwrite = True
	set fileup=theForm("filexx")(1)
	intro=Trim(theform("intro"))
	If  intro="" Then
		Call printerror ("上传照片出错","<li>请输入简短照片说明！</li>",779)
		upflag=False
		exit sub
	End If
	if  fileup.FileExists then
		extname="."&fileup.rawfiletype
	end if
	imagesize=fileup.RawLength/1024
	If imagesize=0 Then
		Call printerror ("上传照片出错","<li>上传数据为空，请检查该文件是否存在！</li>",779)
		upflag=False
		Exit sub
	End if
	If not CheckExp(extname) Then
			Call printerror ("上传照片出错","<li>Wap影音当前设置不能上传该格式的文件！</li>",779)
			upflag=False
			exit sub
	End IF
	If imagesize>maxPhotoSize Then
		Call printerror ("上传照片出错","<li>所传文件已经大于Wap影音设定的允许值<font color=red>"&maxPhotoSize&"K</font>，当前所传文件大小"&TotalSize&"Kb！</li>",779)
		upflag=False
		exit sub
	End If
	filename=GetRndFileName&extname
	fileup.Save Server.mappath(const_txl_HomeUrl&const_photoup_path&filename)   ''保存文件
	PhotoSize=imagesize
	PhotoFormat=extname
	upflag=True
End Sub


Sub SaveToDataBase
	dim Rs,id
	sql="select top 1 * from photo order by picid desc"
	set Rs=Server.CreateObject("Adodb.Recordset")
	Rs.open sql,conn,1,3
	If Rs.Eof Then
		Id=1
	Else
		Id=Rs("picid")+1
	End If
	Rs.addnew
		Rs("PicId")=id
		Rs("Isok")=0
		Rs("pic")=filename
		Rs("subject")=intro
		Rs("username")=Session("username")
		Rs("pubtime")=now()
		Rs("liuyanshu")=0
		Rs("dianji")=0
		Rs("PhotoSize")=PhotoSize
		Rs("PhotoFormat")=PhotoFormat
		Rs("LastUpdateTime")=now()
		Rs("LastUpdateUser")=Session("username")
		Rs("LastUpdateInfo")="上传时间:"&now()&"<br>目前还没有人对此照片留言!"

	Rs.Update
	Rs.close
	Set Rs=nothing
	newphotoid=id
End Sub

Rem 文件扩展名检测
Function CheckExp(TheFileExp)
	Dim defaultPhotoFormat,i
	TheFileExp=lcase(TheFileExp)
	CheckExp=False
	If TheFileExp="" Then 
		CheckExp=False
		Exit Function
	End If
	If Instr(const_PhotoFormat,",")>0 Then
		defaultPhotoFormat=Split(const_PhotoFormat,",")
	Else
		defaultPhotoFormat=const_PhotoFormat
	End If
	If IsArray(defaultPhotoFormat) Then
		For i=0 To Ubound(defaultPhotoFormat)
			If TheFileExp=defaultPhotoFormat(i) Then
				CheckExp=True
				Exit For
			End If
		Next
	Else
		If TheFileExp=defaultPhotoFormat Then
			CheckExp=True
		End If
	End If
End Function

Rem 得到随即文件名，时间加随机数，理论上不会重名
Function GetRndFileName()
	Dim tmpstr
	randomize
	tmpstr=Int(1000*rnd)
	tmpstr=""&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&tmpstr&"_81238_Net"
	GetRndFileName=tmpstr
End Function
%>