<!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<!-- #include File=inc/Upload_Class.asp-->
<%
 '=========================================================
' File: reg_upload.asp
' Version:3.0
' Date: 2005-10-29
' Script Written by xmrxw
'=========================================================
' Copyright (C) 2004,2005 Xmrxw.Com All rights reserved.
' Web: http://www.xmrxw.com,http://www.xmzxw.com
' Email: info@mssky.com,super@mssky.com
' QQ：10689579　Msn：zdlmicr@hotmail.com
'=========================================================
stats="头像上传"
response.buffer=true
if not founduser then
	Errmsg=Errmsg+"<br>"+"<li>您还没有<a href=login.asp target=_blank>登陆</a>！"
	response.Write(Errmsg)
response.end
end if
if Cint(GroupSetting(10))=0 then
	Errmsg=Errmsg+"<br>"+"<li>您没有上传头像的权限，不能上传头像！"
	response.Write(Errmsg)
response.end
end if
If Request("t")="1" Then
	Upfile_Main()
Else
	Main()
End If

call activeonline()

sub Main()%>
<body leftmargin="0" topmargin="0">
<%if cint(split(OpenFace,"|")(1))=0 then
Errmsg=Errmsg+"<br>"+"<li>本站已经暂停上传头像！"
	response.Write(Errmsg)
response.end
else
	Dim PostRanNum
	Randomize
	PostRanNum = Int(900*rnd)+1000
	Session("UploadCode") = Cstr(PostRanNum)
	%>
<table border="0"  width=100% cellpadding=0 cellspacing=0 class=tableborder1>
    <tr>
      <td class=tablebody1>
	<form name="form" method="post" action="reg_upload.asp?t=1" enctype="multipart/form-data" >
<INPUT TYPE="hidden" NAME="UploadCode" value="<%=PostRanNum%>">
<Input type="hidden" name="act" value="upload">
<input type="hidden" name="upnum" value="upload">
	<input type="file" name="file1">
	<input type="submit" name="Submit" value="上传" onClick="fname.value=file1.value,parent.document.theForm.Submit.disabled=true,parent.document.theForm.Submit2.disabled=true;">
	</form>
</td></tr>
</table>
<%end if%>
</body>
</html>
<%end sub

Sub Upfile_Main()
Server.ScriptTimeOut=999999'要是你的空间支持上传的文件比较大，就必须设置。
'提交验证
If Not ChkPost Then
	Response.End
End If
if not founduser then
	Response.write "您还没有<a href=login.asp>登陆</a>，不能上传头像。请先<a href=login.asp>登录</a>，或者<a href=reg.asp>注册</a>"
	Response.End
End If
if Cint(GroupSetting(10))=0 then
	Response.write "您没有上传的权限。"
	Response.End
end if
dim OpenFaces
OpenFaces=split(OpenFace,"|")
If OpenFaces(1)=0 Then
	Response.Write "本系统未开放上传了头像功能"
	Response.End
End If

if mymoney<Cint(GroupSetting(12)) then
	Response.Write "您的金币不够，上传头像需要金币："&GroupSetting(12)&"元"
	Response.End
End If
%>
<body leftmargin="0" topmargin="0">
<table height="37%" border=0 cellpadding=0 cellspacing=0 style="width:100%;height:100%" valign=top>
	<tr><td class=tablebody2 valign=top>
	<%
call UploadFile
	%>
	</td></tr>
	</table>
</body>
</html>
<%
End Sub

Sub UploadFile()
Dim Forumupload
Dim FormName,FormPath,Filename,File_name,FileExt,Filesize,F_Type,rename
Dim upNum,dateupnum,OnceUPCount,FilePath,ChildFilePath
Dim Upload,File,F_FileName,F_ViewName,F_Filesize,F_FileExt,Previewpath,DrawInfo,InceptMaxFile
dim Uploadseting
Uploadseting=split(Uploadset,"|")
'定义变量
	OnceUPCount = Request.Cookies("upNum")
	If OnceUPCount = "" or Not Isnumeric(OnceUPCount) Then
		OnceUPCount = 0
	Else
		OnceUPCount = Clng(OnceUPCount)
	End If
	If OnceUPCount >= Clng(GroupSetting(59)) then
 		Response.write "一次只能上传"&GroupSetting(59)&"个文件！"
		Exit Sub
	Else
		InceptMaxFile = Clng(GroupSetting(59)) - OnceUPCount
	End If
	If Not IsNumeric(MyToday(0)) Then MyToday(0) = 0
	If Clng(MyToday(0))>Clng(GroupSetting(61)) Then
 		Response.write "已超出了你每天上传的文件个数"&GroupSetting(61)&"个！"
		Exit Sub
	Else
		If Clng(GroupSetting(61))-Clng(MyToday(0))<InceptMaxFile Then
			InceptMaxFile = Clng(GroupSetting(61))-Clng(MyToday(0))
		End If
	End If
	FilePath = CreatePath(CheckFolder)	'上传目录路径
	ChildFilePath = Replace(FilePath,CheckFolder,"")'不带系统上传目录的下级目录路径
	Previewpath = UpfilePreview '预览图片目录路径
	Previewpath = CreatePath(Previewpath)
	If Uploadseting(4)="1" Then
		DrawInfo = Uploadseting(5)
	ElseIf Uploadseting(4)="2" Then
		DrawInfo = Uploadseting(10)
	Else
		DrawInfo = ""
	End If
	If DrawInfo = "0" Then
		DrawInfo = ""
		Uploadseting(4) = 0
	End If
	Set Upload = New UpFile_Cls						''建立上传对象
	Upload.UploadType=Cint(Uploadtype)
	Upload.UploadPath=FilePath
	Upload.InceptFileType = Replace(UpFaceset,"|",",")'上传文件类别
	Upload.MaxSize= Int(GroupSetting(11))
	Upload.InceptMaxFile		= InceptMaxFile		'每次上传文件个数上限
	Upload.ChkSessionName		= "UploadCode"	'防止重复提交,SESSION名与提交的表单要一致。
	'预览图片设置
	Upload.PreviewType= Cint(Uploadseting(0))	'设置预览图片组件类型
	Upload.PreviewImageWidth= Uploadseting(1)			'设置预览图片宽度
	Upload.PreviewImageHeight= Uploadseting(2)			'设置预览图片高度?
	Upload.DrawImageWidth=Uploadseting(13)			'设置水印图片或文字区域宽度
	Upload.DrawImageHeight=Uploadseting(14)			'设置水印图片或文字区域高度
	Upload.DrawGraph=Uploadseting(11)			'设置水印透明度				
	Upload.DrawFontColor=Uploadseting(7)			'设置水印文字颜色	
	Upload.DrawFontFamily=Uploadseting(8)			'设置水印文字字体格式
	Upload.DrawFontSize= Uploadseting(6)			'设置水印文字字体大小
	Upload.DrawFontBold= Uploadseting(9)			'设置水印文字是否粗体
	Upload.DrawInfo= DrawInfo			'设置水印文字信息或图片信息
	Upload.DrawType= Uploadseting(4)'0=不加载水印 ，1=加载水印文字，2=加载水印图片
	Upload.DrawXYType= Uploadseting(15)'"0" =左上，"1"=左下,"2"=居中,"3"=右上,"4"=右下
	Upload.DrawSizeType= Uploadseting(3)		'"0"=固定缩小，"1"=等比例缩小
	If Uploadseting(12)<>"" or Uploadseting(12)<>"0" Then
		Upload.TransitionColor	= Uploadseting(12)'透明度颜色设置
	End If
	'执行上传
	Call checkuserp()		''检查数据库是否超过限制
	Upload.SaveUpFile
	If Upload.ErrCodes<>0 Then
		Response.write "错误："& Upload.Description & "[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
		Exit Sub
	End If
	If Upload.Count > 0 Then
		For Each FormName In Upload.UploadFiles
			Set File = Upload.UploadFiles(FormName)
				F_FileName = FilePath & File.FileName
				'创建预览及水印图片
				If Upload.PreviewType<>999 and File.FileType=1 then
						F_Viewname = Previewpath & "pre" & Replace(File.FileName,File.FileExt,"") & "jpg"
						'创建预览图片:Call CreateView(原始文件的路径,预览文件名及路径,原文件后缀)
						Upload.CreateView F_FileName,F_Viewname,File.FileExt
				End If
				UploadSave F_FileName,ChildFilePath&File.FileName,File.FileExt,F_Viewname,File.FileSize,File.FileType
			Set File = Nothing
		Next
	Else
		Response.write "请正确选择要上传的文件。[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
		Exit Sub
	End If
	Call Suc_upload(Upload.Count,OnceUPCount)
Set Upload = Nothing
end sub

'检查数据库是否已经存在
Private sub checkuserp()
If UserID>0 Then
'******************
'删除用户旧的头像
dim filepaths,objFSO,upface,Upphoto,Uwealth
if  founduser then
on error resume next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
set rs=conn.execute("select UserFace,UserWealth from [Ms_user] where userid="&userid)
    upface=rs(0)
	Uwealth=rs(1)
	if Uwealth<Cint(GroupSetting(12)) then
		response.Write("您的金钱不够！")
		response.End
	end if
	if instr(upface,SaveUpFilesPath)>0 then
		filepaths=Server.MapPath(""&upface&"")
		if objFSO.fileExists(filepaths) then
	'response.write "删除"&filepaths
		objFSO.DeleteFile(filepaths)
		end if
	end if
set rs=nothing
end if
else
	response.Write("不要乱来哦")
	response.End
End If
	conn.execute("delete from Ms_Upfile where Filename='"&upface&"' and Userid="&Userid&"")
end sub

'保存上传数据并返回附件ID
Sub UploadSave(FileName,ChildFileName,FileExt,ViewName,FileSize,F_Type)
Dim ShwoFileName
	ShwoFileName=Checkstr(Replace(FileName,CheckFolder,"UploadFile/"))
	ChildFileName=Checkstr(ChildFileName)
		Conn.execute("insert into Ms_Upfile (Userid,Username,Typeid,Filename,Viewname,FileType,FileSize,Flag,FType,Readme) values ("&UserID&",'"&trim(membername)&"',1,'"&ChildFileName&"','"&ViewName&"','"&FileExt&"',"&Filesize&",0,"&F_Type&",'用户头像')")
if Viewname="" then
Viewname=FileName
end if
conn.execute("update Ms_user set UserWealth=UserWealth-"&Cint(GroupSetting(12))&",UserFace='"&ViewName&"',UserPhoto='"&ViewName&"' where Userid="&Userid&"")''扣除用户金币及更新头像地址
		Response.Write "<script>parent.document.images['face'].src='" &ViewName& "';parent.document.theForm.myface.value='"&ViewName&"';</script>"
		Response.Write "<script>parent.document.images['face'].Facewidth='" &File.FileWidth& "';parent.document.images['face'].Faceheight='"&File.FileHeight&"';</script>"
		Response.Write "<script>parent.document.theForm.Faceheight.value='" &File.FileHeight& "';parent.document.theForm.Facewidth.value='"&File.FileWidth&"';</script>"
		Response.Write "头像上传成功!"
End sub

Sub Suc_upload(UpCount,upNum)
	upNum = upNum + UpCount
	Response.Cookies("upNum") = upNum
	Dim iUserInfo
	MyToday(0) = MyToday(0)+UpCount
	iUserInfo= MyToday(0) & "|||" & MyToday(1) & "|||" &MyToday(2)
	If upNum < Clng(GroupSetting(59)) And MyToday(0) < Clng(GroupSetting(61)) Then
		Response.Write UpCount & "个文件上传成功,目前今天总共上传了" & MyToday(0) & "个文件 [ <a href=# onclick=history.go(-1)>继续上传</a> ]"
	Else
		Response.write UpCount & "个文件上传成功!本次已达到上传数上限。"
	End If
	Conn.Execute("UPDATE [Ms_user] SET UserToday = '" & iUserInfo &"' WHERE UserID = " & UserID)
End Sub

'读取上传目录
Function CheckFolder()
	CheckFolder = Replace(Replace(SaveUpFilesPath,Chr(0),""),".","")
	'在目录后加(/)
	If Right(CheckFolder,1)<>"/" Then CheckFolder=CheckFolder&"/"
End Function

'按月份自动明名上传文件夹,需要ＦＳＯ组件支持。
Private Function CreatePath(PathValue)
	Dim objFSO,Fsofolder,uploadpath
	'以年月创建上传文件夹，格式：2003－8
	uploadpath ="Fac_upload/"& year(now) & "-" & month(now)
	If Right(PathValue,1)<>"/" Then PathValue = PathValue&"/"
	On Error Resume Next
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
		If objFSO.FolderExists(Server.MapPath(PathValue & uploadpath))=False Then
			objFSO.CreateFolder Server.MapPath(PathValue & uploadpath)
		End If
		If Err.Number = 0 Then
			CreatePath = PathValue & uploadpath & "/"
		Else
			CreatePath = PathValue
		End If
	Set objFSO = Nothing
End Function%>