post_upfile.asp

功能强大的bbs

				Response.write "文件格式不正确,或不能为空　[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
				Exit Sub
			End If
			'文件变量付值
			File_name	=	CreateName()
			Filename	=	File_name&"."&FileExt
			rename		=	CreatePath()&Filename & "|"
			Filename	=	FormPath&CreatePath()&Filename
			F_Type		=	CheckFiletype(FileExt)
			
			'保存文件
			oFileUp.Form(FormName).Saveas Server.MapPath(Filename)
			'创建生成预览图片
			If upload_ViewType<>999 and F_Type=1 then
				F_Viewname=previewpath&"pre"&File_name&".jpg"
				Call CreateView(FileName,F_Viewname)
			End If
			'记录文件
			Call checksave()			'记录文件
			UpCount	= UpCount+1
		Else
			Response.write "请先选择你要上传的文件　[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
			EXIT SUB
		End If
	End If
Next
Set oFileUp = Nothing
Call Suc_upload(UpCount,upNum)
End sub

'保存上传数据并返回附件ID
Private sub checksave()
Dim Rs,DownloadID,UpFileID,shwofilename
shwofilename=Replace(Filename,FormPath,"UploadFile/")
If upload_ViewType<>999 and F_Type=1 then
	Dvbbs.execute("insert into dv_upFile (F_BoardID,F_UserID,F_Username,F_Filename,F_Viewname,F_FileType,F_Type,F_FileSize,F_Flag) values ("&Dvbbs.BoardID&","&Dvbbs.UserID&",'"&Dvbbs.membername&"','"&replace(rename,"|","")&"','"&F_Viewname&"','"&replace(FileExt,".","")&"',"&F_Type&","&Filesize&",4)")
Else
	Dvbbs.execute("insert into dv_upFile (F_BoardID,F_UserID,F_Username,F_Filename,F_FileType,F_Type,F_FileSize,F_Flag) values ("&Dvbbs.BoardID&","&Dvbbs.UserID&",'"&Dvbbs.membername&"','"&replace(rename,"|","")&"','"&replace(FileExt,".","")&"',"&F_Type&","&Filesize&",4)")
End If
Set Rs=Dvbbs.execute("Select top 1 F_ID from dv_upFile order by F_ID desc")
	DownloadID=rs(0)
	UpFileID=DownloadID & ","
Set Rs=nothing

If F_Type=1 or F_Type=2 then
 	Response.write "<script>parent.Dvbbs_Composition.document.body.innerHTML+='[upload="&FileExt&"]"&shwofilename&"[/upload]<br>'</script>"
Else
 	Response.write "<script>parent.Dvbbs_Composition.document.body.innerHTML+='[upload="&FileExt&"]viewFile.asp?ID="&DownloadID&"[/upload]<br>'</script>"
End If
Response.write "<script>parent.Dvform.upfilerename.value+='"&UpFileID&"'</script>"
upNum	=	upNum+1
Response.cookies("upNum")=upNum
End sub

Private Sub Suc_upload(UpCount,upNum)
	If upNum < Clng(Dvbbs.GroupSetting(40)) and dateupnum+upNum < Clng(Dvbbs.GroupSetting(50)) then
		Response.write UpCount&"个文件上传成功,目前今天总共上传了"&Dvbbs.UserToday(2)+upNum&"个附件 [ <a href=post_upload.asp?boardid="&Dvbbs.BoardID&">继续上传</a> ]"
	Else
		Response.write UpCount&"个文件上传成功!本次已达到上传数上限。"
	End If
	Dvbbs.Execute("update [Dv_user] set UserToday='"&Dvbbs.UserToday(0)&"|"&Dvbbs.UserToday(1)&"|"&Dvbbs.UserToday(2)+1&"' Where UserID="&Dvbbs.userID&"")
	Dim iUserInfo
	iUserInfo = Session(Dvbbs.CacheName & "UserID")
	iUserInfo(36)=Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) & "|" & Dvbbs.UserToday(2)+1
	Session(Dvbbs.CacheName & "UserID") = iUserInfo
End Sub

'判断文件类型是否合格
Private Function CheckFileExt(FileExt)
Dim Forumupload,i
	If FileExt="" or IsEmpty(FileExt) Then
		CheckFileExt=false
		Exit Function
	End If
	If Lcase(FileExt)="asp" or Lcase(FileExt)="asa" or Lcase(FileExt)="aspx" then
		CheckFileExt=false
		Exit Function
	End If
	Forumupload=split(Dvbbs.Board_Setting(19),"|")
	For i=0 To ubound(Forumupload)
		If Lcase(FileExt)=Lcase(trim(Forumupload(i))) then
			CheckFileExt=true
			exit Function
		Else
			CheckFileExt=false
		End If
	Next
End Function

'判断文件类型:0=其它,1=图片,2=FLASH,3=音乐,4=电影
Private Function CheckFiletype(FileExt)
Dim upFiletype
Dim FilePic,FileVedio,FileSoft,FileFlash,FileMusic
FileExt=Lcase(replace(FileExt,".",""))
Select Case Lcase(FileExt)
		Case "gif", "jpg", "jpeg","png","bmp","tif","iff"
		CheckFiletype=1
		Case "swf", "swi"
		CheckFiletype=2
		Case "mid", "wav", "mp3","rmi","cda"
		CheckFiletype=3
		Case "avi", "mpg", "mpeg","ra","ram","wov","asf"
		CheckFiletype=4
		Case Else
		CheckFiletype=0
End Select
End Function

'创建预览图片:call CreateView(原始文件的路径,预览文件名及路径)
Sub CreateView(imagename,tempFilename)
'定义变量
Dim PreviewImageFolderName
Dim ogvbox,objFont
Dim Logobox,LogoPath
LogoPath = Server.MapPath("images") & "\logo.gif"  '//加入图片所在路径及文件名

Select case upload_ViewType
Case 0
'---------------------CreatePreviewImage---------------
	set ogvbox = Server.CreateObject("CreatePreviewImage.cGvbox")
	ogvbox.SetSavePreviewImagePath=Server.MapPath(tempFilename)			'预览图存放路径
	ogvbox.SetPreviewImageSize =SetPreviewImageSize						'预览图宽度
	ogvbox.SetImageFile = trim(Server.MapPath(imagename))				'imagename原始文件的物理路径
	'创建预览图的文件
	If ogvbox.DoImageProcess=false Then
	Response.write "生成预览图错误:"& ogvbox.GetErrString
	End If
Case 1
'---------------------AspJpegV1.2---------------
	
	'Set Logobox = Server.CreateObject("Persits.Jpeg")
	'*添加水印图片	添加时请关闭水印字体*
	'//读取添加的图片
	'Logobox.Open LogoPath
	'//重新设置图片的大小
	'Logobox.Width = 180		'// 加入图片的原宽度
	'Logobox.Height = 60		'// 加入图片的原高度
	'*添加水印图片*

	Set ogvbox = Server.CreateObject("Persits.Jpeg")
	' 读取要处理的原文件
	ogvbox.Open Trim(Server.MapPath(imagename))
	If ogvbox.OriginalWidth<Cint(ImageWidth) or ogvbox.Originalheight<Cint(ImageHeight) Then
		F_Viewname=""
		Set ogvbox = Nothing
		Exit Sub
	Else
		IF ImageMode<>"" and FileExt<>"gif" Then
			'//关于修改字体及文字颜色的
			ogvbox.Canvas.Font.Color	= &HFF0000		'// 文字的颜色
			ogvbox.Canvas.Font.Family	= "monospace"	'// 文字的字体
			'ogvbox.Canvas.Font.Bold = True
			' Draw frame: black, 2-pixel width
			ogvbox.Canvas.Print 10, 10, ImageMode		'// 加入文字的位置坐标
			ogvbox.Canvas.Pen.Color		= &H000000		'// 边框的颜色
			ogvbox.Canvas.Pen.Width		= 1				'// 边框的粗细
			ogvbox.Canvas.Brush.Solid	= False			'// 图片边框内是否填充颜色
			'ogvbox.DrawImage 0, 0, Logobox				'// 加入图片的位置价坐标（添加水印图片）
			ogvbox.Canvas.Bar 0, 0, ogvbox.Width, ogvbox.Height	'// 图片边框线的位置坐标
			ogvbox.Save Server.MapPath(imagename)		'// 生成文件
		End If
		ogvbox.Width	= ImageWidth
		ogvbox.height	= ImageHeight
		'ogvbox.height	= ogvbox.Originalheight*ImageWidth\ogvbox.OriginalWidth
		ogvbox.Sharpen 1, 120
		ogvbox.Save Server.MapPath(tempFilename)		'// 生成预览文件
	End If
	Set Logobox=Nothing
Case 2
'---------------------SoftArtisans ImgWriter V1.21---------------
	Set ogvbox = Server.CreateObject("SoftArtisans.ImageGen")
	' 读取要处理的原文件
	ogvbox.LoadImage Trim(Server.MapPath(imagename))
	If ogvbox.ErrorDescription <> "" Then
		Response.Write ogvbox.ErrorDescription
	End If
	If ogvbox.Width<Cint(ImageWidth) or ogvbox.Height<Cint(ImageHeight) Then
		F_Viewname=""
		Set ogvbox = Nothing
		Exit Sub
	Else
		IF ImageMode<>"" and FileExt<>"gif" Then
			ogvbox.Font.Italic	= True
			ogvbox.Font.height	= 15
			ogvbox.Font.name	= "monospace"
			ogvbox.Font.Color	= vbred
			ogvbox.Text			=ImageMode
			ogvbox.DrawTextOnImage 10, 10, ogvbox.TextWidth, ogvbox.TextHeight
			ogvbox.SaveImage 0, ogvbox.ImageFormat, Server.MapPath(imagename) 
			'ogvbox.AddWatermark Server.MapPath(Request.QueryString("mimg")), 0, 0.3
		End If
		'ogvbox.SharpenImage 100
		ogvbox.ColorResolution = 24	'24色保存
		ogvbox.ResizeImage ImageWidth,ImageHeight,0,0
		'0=saiFile,1=saiMemory,2=saiBrowser,4=saiDatabaseBlob
		'saiBMP=1,saiGIF=2,saiJPG=3,saiPNG=4,saiPCX=5,saiTIFF=6,saiWMF=7,saiEMF=8,saiPSD=9 
		ogvbox.SaveImage 0, 3, Server.MapPath(tempFilename)
		Response.Write Server.MapPath(tempFilename)
	End If
Case 3
'---------------------三角猫生成缩略图组件 SJCatSoft V2.6---------------
	Set ogvbox = Server.CreateObject("sjCatSoft.Thumbnail")
	ogvbox.SourceFile = Trim(Server.MapPath(imagename))
	IF ogvbox.OriginalWidth<Cint(ImageWidth) or ogvbox.OriginalHeight<Cint(ImageHeight) Then
		F_Viewname=""
		Set ogvbox = Nothing
		Exit Sub
	Else
		ogvbox.ByRatio			= False
		ogvbox.OutFileType		= 1
		ogvbox.OutPicWidth		= ImageWidth
		ogvbox.OutPicHeight		= ImageHeight
		ogvbox.DestFile			= Server.MapPath(tempFilename)
		ogvbox.Execute
		IF ImageMode<>"" and FileExt<>"gif" Then
		ogvbox.WaterMaskText	= ImageMode
		ogvbox.FontName			= "monospace"
		ogvbox.FontSize			= 12
		ogvbox.FontColor		= 13
		ogvbox.FontType			= 5
		ogvbox.ByRatio			= True
		ogvbox.Rate				= 100
		ogvbox.DestFile			= Server.MapPath(imagename)
		ogvbox.Execute
		End If
	End If
End Select
Set ogvbox = Nothing
End Sub

Private Function CreateName()
Dim ranNum
	randomize
	ranNum=int(999*rnd)
	CreateName=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum
End Function

'按月份自动明名上传文件夹,需要ＦＳＯ组件支持。
Private Function CreatePath()
Dim objFSO,Fsofolder,uploadpath
uploadpath=year(now)&"-"&month(now)	'以年月创建上传文件夹，格式：2003－8
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
	If objFSO.FolderExists(Server.MapPath(FormPath&uploadpath))=False Then
	objFSO.CreateFolder Server.MapPath(FormPath&uploadpath)
	End If
	If Err.Number = 0 Then
	CreatePath=uploadpath&"/"
	Else
	CreatePath=""
	End If
set objFSO = nothing
End Function
Function checkFolder()
	If Dvbbs.Forum_Setting(76)="" Or Dvbbs.Forum_Setting(76)="0" Then Dvbbs.Forum_Setting(76)="UploadFile/"
	checkFolder=Dvbbs.Forum_Setting(76)
End Function 
'常见文件的MIME类型
'GIF文件  "image/gif"
'BMP文件 "image/bmp"
'JPG文件 "image/jpeg"
'zip文件 "application/x-zip-compressed"
'DOC文件 "application/msword"
'文本文件 "text/plain"
'HTML文件 "text/html"
'一般文件 "application/octet-stream"

'SoftArtisans.ImageGen
'ogvbox.AddWatermark Watermark,Position,Opacity,TransitionColor,ShrinkToFit
'Position:
'saiTopMiddle 0  
'saiCenterMiddle 1  
'saiBottomMiddle 2  
'saiTopLeft 3  
'saiCenterLeft 4  
'saiBottomLeft 5  
'saiTopRight 6  
'saiCenterRight 7  
'saiBottomRight 8 
'ShrinkToFit:自动适中（默认为：TRUE）
%>
</td></tr>
</table>
</body>
</html>