<!-- #include file=../inc/BBSsetup.asp -->
<!-- #include file=../inc/Board_Popfun.asp -->
<%DEF_BBS_HomeUrl = "../"%>
<!-- #include file=../inc/Upload_Fun.asp -->
<!-- #include file=../announce/inc/upload1_fun.asp -->
<%
UploadPhotoUrl = UploadPhotoUrl & "face/"
PhotoDirectory = PhotoDirectory & "face/"
Dim TempStr%>
<script language=javascript>
<!--

	function addcontent(tmpstr,GBL_Width,GBL_Height)
	{
		parent.document.LeadBBSFm.Form_FaceUrl.value = tmpstr;
		parent.document.LeadBBSFm.Form_FaceWidth.value = GBL_Width;
		parent.document.LeadBBSFm.Form_FaceHeight.value = GBL_Height;
		parent.document.faceimg.src=tmpstr;
		parent.document.faceimg.width=GBL_Width;
		parent.document.faceimg.height=GBL_Height;
	}

//-->
</script>
<%
Rem 缩小图像模式,0-缩小到预定宽或高,1,如果大于预定宽或高则成倍缩小
Const DEF_ResizeMode = 0

initDatabase
If DEF_FaceMaxBytes < 1 or (GBL_CHK_OnlineTime < DEF_NeedOnlineTime and DEF_NeedOnlineTime > 0) Then
	CloseDatabase
	Response.End
End If

If DEF_UploadFaceNeedPoints > 0 and DEF_UploadFaceNeedPoints > GBL_CHK_Points Then
	CloseDatabase
	Response.End
End If

SiteHead("   ")%>
<body bgcolor=<%=DEF_BBS_LightestColor%> leftmargin="0" topmargin="0">
<%
If Request.QueryString("submitflag") = "" Then
	photoUpformFunction
Else
	If GBL_CHK_LastWriteTime < DEF_WriteEventSpace Then
		Response.Write "<b><font color=Red Class=RedFont>您的操作太频，请稍候再上传!</font></b> <br>" & VbCrLf
		CloseDatabase
		Response.End
	End If
	SaveUploadFile
End If%>
</body>
</html>
<%
CloseDatabase

Function photoUpformFunction

%>
	<script language=JavaScript>
	<!--
	ValidationPassed = true;
	function visagePhotoForm_onsubmit(obj)
	{
		ValidationPassed = true;
		if(obj.photo.value =="")
		{
			alert("请点击浏览按钮选择要上传的文件!\n");
			ValidationPassed = false;
			obj.photo.focus();
			return;
		}
		ValidationPassed = true;
		return true;
	}

	function submitonce(theform)
	{
		if(ValidationPassed == false)return;
		if (document.all||document.getElementById)
		{
			for (i=0;i<theform.length;i++)
			{
				var tempobj=theform.elements[i];
				if(tempobj.type.toLowerCase()=="submit"||tempobj.type.toLowerCase()=="reset")
				tempobj.disabled=true;
			}
		}
	}
	-->
	</script>
	<table cellspacing=1 cellpadding=0 width="100%" border=0 valign=absmiddle height=100%>
	<tbody>
	<form method=POST action=uploadFile.asp?submitflag=yes&dontRequestFormFlag=<%="Guest" & Second(time) & hour(time) & minute(time)%> name=visagePhotoForm enctype=multipart/form-data onSubmit="submitonce(this);return ValidationPassed;">
	<tr>
		<td valign=absmiddle align=absmiddle>
			<input type=file size=11 name=photo class=fminpt>
			<input type=submit value=上传 name=send onclick="visagePhotoForm_onsubmit(this.form)" class=fmbtn> [限<%=Left((DEF_FaceMaxBytes/1024),3)%>K]
			<br>
	</td>
	</tr>
	</form>
	</table>

<%End Function

Function SaveUploadFile

	uploadfilenow
	
	If CheckSupervisorUserName = 0 Then
		Con.ExeCute("Update LeadBBS_User Set LastWriteTime=" & GetTimeValue(DEF_Now) & " where ID=" & GBL_UserID)
		GBL_DBNum = GBL_DBNum + 1
		UpdateSessionValue 13,GetTimeValue(DEF_Now),0
	End If
	Response.Write "<img sc=" & DEF_BBS_HomeUrl & "images/blank.gif height=6 width=1><br><a href=uploadFile.asp>" & TempStr & "</a>"

End Function

Function GetSaveFileName(name)

	Dim ExtendFileName,TempNum,Temp
	name = Lcase(name)
	name = "1" & Mid(name,inStrRev(name,"."))
	ExtendFileName = Mid(name,inStrRev(name,"."))
	TempNum = Right(GetTimeValue(DEF_Now),6)

	GetSaveFileName = TempNum & ExtendFileName
	Pic_Name2 = TempNum & "s" & ExtendFileName
	
	On Error Resume Next
	Dim FSFlag
	FSFlag = 1
	If DEF_FSOString <> "" Then
		Set fs = Server.CreateObject(DEF_FSOString)
		If Err Then
			FSFlag = 0
			Err.Clear
			Set fs = Nothing
		End If
	Else
		FSFlag = 0
	End If

	If FSFlag = 0 Then
		Err.Clear
		GetSaveFileName = Left(GetTimeValue(DEF_Now),8) & GetSaveFileName
		Pic_Name2 = Left(GetTimeValue(DEF_Now),8) & Pic_Name2
		PhotoDir = Server.MapPath(PhotoDirectory) & "\"
		Set Fs = Nothing
		Dim Rs
		Set Rs = Con.ExeCute("Select top 1 * from LeadBBS_UserFace Where UserID=" & GBL_UserID)
		If Not Rs.Eof Then
			Pic_Name2 = Replace(Rs("PhotoDir") & "","\","/")
			Rs.Close
			Set Rs = Nothing
			If Pic_Name2 <> "" Then
				If inStrRev(Pic_Name2,"/") Then Pic_Name2 = Mid(Pic_Name2,inStrRev(Pic_Name2,"/") + 1)
				If inStrRev(Pic_Name2,".") Then Pic_Name2 = Left(Pic_Name2,inStrRev(Pic_Name2,".") - 1)
				Pic_Name2 = Pic_Name2 & ExtendFileName
				GetSaveFileName = Pic_Name2
			End If
		Else
			Rs.Close
			Set Rs = Nothing
		End If
		Exit Function
	End If

	Dim TDir,FS
	TDir = Server.MapPath(PhotoDirectory) & "\"
	If Not FS.FolderExists(TDir) then
		GetSaveFileName = 0
		TempStr = TempStr & "<img src=../images/null.gif width=2 height=5><br>&nbsp;错误，存放图标的目录不存在，请联系网站中心！<br>" & VbCrLf
	End If
	
	TDir = TDir & year(date) & "\"
	UploadPhotoUrl = UploadPhotoUrl & year(date) & "/"
	If Not FS.FolderExists(TDir) then
		FS.CreateFolder(TDir)
	End If

	TDir = TDir & Right("0" & month(date),2) & "\"
	UploadPhotoUrl = UploadPhotoUrl & Right("0" & month(date),2) & "/"
	If Not FS.FolderExists(TDir) then
		FS.CreateFolder(TDir)
	End If
	
	TDir = TDir & Right("0" & day(date),2) & "\"
	UploadPhotoUrl = UploadPhotoUrl & Right("0" & day(date),2) & "/"
	If Not FS.FolderExists(TDir) then
		FS.CreateFolder(TDir)
	End If
	
	PhotoDir = TDir

	If FS.FileExists(TDir & GetSaveFileName) then
		For Temp = 0 To 99
			GetSaveFileName = TempNum & "_" & Temp & ExtendFileName
			Pic_Name2 = TempNum & "_" & Temp & "s" & ExtendFileName
			If FS.FileExists(TDir & GetSaveFileName) then
			Else
				Set FS = Nothing
				Exit For
			End If
		Next
		Set FS = Nothing
	Else
		Set FS = Nothing
	End If

End Function

Dim FileUp,Pic_Name1,Pic_Name,PhotoDir,Pic_Name2,UploadPhotoUrl2,NewFileName

Function Upload_FileUp

	On Error Resume Next
	Set FileUp = server.createobject("FileUp.upload")
	If Err Then
		TempStr = TempStr & "<img src=../images/null.gif width=2 height=5><br>&nbsp;请后退再重新提交表单一次，如果多次重试仍未成功，请联系管理员，可能未安装此组件！<br>" & VbCrLf
		Err.Clear
		Exit Function
	End If

	NewFileName = FileUp.UserFilename
	If Instr(NewFileName,"\") or inStr(NewFileName,"/") Then
		NewFileName = LCase(Mid(NewFileName,InstrRev(Replace(NewFileName & "","/","\"), "\") + 1))
	End If
	If inStr(NewFileName,".") = 0 Then
		TempStr = TempStr & "<img src=../images/null.gif width=2 height=5><br>&nbsp;没有正确地选择要上传的文件, 注意上传的文件格式!"
		Exit Function
	End If

	Pic_Name1 = GetSaveFileName(NewFileName)
	UploadPhotoUrl2 = UploadPhotoUrl & Pic_Name2
	UploadPhotoUrl = UploadPhotoUrl & Pic_Name1
	If FileUp.FileFound(server.mappath(NewFileName)) = False Then
		If inStr(":.jpg:.gif:.jpeg:.jpe:.png:.bmp:.psd:.tif:.sgi:.tga:.iff:.pcx:.dcx:.pbm:.pgm:.ppm:.pnm:.miff:.xbm:.xpm:.ico:.icl:.emf:.hru:.jif:.prc:.wrl:.wbmp:",":" & Mid(NewFileName,InstrRev(NewFileName, ".")) & ":") Then
				Pic_Name = Pic_Name1
				FileUp.SaveAs PhotoDir & Pic_Name
				If err Then
					Set FileUp = Nothing
					TempStr = TempStr & "<img src=../images/null.gif width=2 height=5><br>&nbsp;上传错误,请正确选择上传文件.<br>" & VbCrLf
					err.clear
					Exit Function
				End If

				If FileUp.TotalBytes <> 0 then
				Else
						TempStr =  TempStr &  "<img src=../images/null.gif width=2 height=5><br>&nbsp;提示：文件内容为空，可能是此文件不存在! 上传失败！请重新上传。<br>" & VbCrLf
						Exit Function
				End If
				
				If FileUp.TotalBytes > DEF_FaceMaxBytes then	
					TempStr =  TempStr & "<img src=../images/null.gif width=2 height=5><br>&nbsp;上传文件太大，超过了" & CLng(DEF_FaceMaxBytes/1024) & "K!<br>" & VbCrLf
					Exit Function
				End If
		Else
			TempStr =  TempStr &  "<img src=../images/null.gif width=2 height=5><br>&nbsp;提示：文件类型错误，请选择正确类型的文件上传！<br>" & VbCrLf
			Exit Function
		End If
	Else
		TempStr =  TempStr &  "<img src=../images/null.gif width=2 height=5><br>&nbsp;提示：该文件已经存在，不能覆盖！<br>" & VbCrLf
		Exit Function
	End If
	Set FileUp = Nothing

End Function

Function Upload_NoComponent

	On Error Resume Next
	Dim formName,file

	set FileUp = new UpFile_Class
	If CheckSupervisorUserName = 1 and DEF_FaceMaxBytes < 1024000 Then
		FileUp.GetData (1024*1000)
	Else
		FileUp.GetData (DEF_FaceMaxBytes)
	End If

	If FileUp.err > 0 then
	    Select Case FileUp.err
			Case 1
					Response.Write "<img src=../images/null.gif width=2 height=5><br>&nbsp;请先选择你要上传的文件　[ <a href=#3234 onclick=history.go(-1)>重新上传</a> ]"
			Case 2
					Response.Write "<img src=../images/null.gif width=2 height=5><br>&nbsp;图片大小超过了限制 " & DEF_FaceMaxBytes & "K　[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
		End Select
		Exit Function
	Else
		For Each formName in FileUp.file ''列出所有上传了的文件
			Set file = FileUp.file(formName)  ''生成一个文件对象
			If file.filesize<1 then
				Response.write "<img src=../images/null.gif width=2 height=5><br>&nbsp;请先选择你要上传的文件　[ <a href=#s334 onclick=history.go(-1)>重新上传</a> ]"
				Response.End
	 		End if
	
	 		NewFileName="." & LCase(file.FileExt)
			If inStr(":.jpg:.gif:.jpeg:.jpe:.png:.bmp:.wav:.psd:.tif:.mid:.sgi:.tga:.iff:.pcx:.dcx:.pbm:.pgm:.ppm:.pnm:.miff:.xbm:.xpm:.ico:.icl:.emf:.hru:.jif:.prc:.wrl:.wbmp:",":" & NewFileName & ":") = 0 then
	 			Response.Write "<img src=../images/null.gif width=2 height=5><br>&nbsp;文件格式不正确　[ <a href=#3333 onclick=history.go(-1)>重新上传</a> ]"
				Response.End
			End If

			Pic_Name1 = GetSaveFileName(NewFileName)
			UploadPhotoUrl2 = UploadPhotoUrl & Pic_Name2
			UploadPhotoUrl = UploadPhotoUrl & Pic_Name1
			Pic_Name = Pic_Name1

			If file.FileSize>0 then
				file.SaveToFile PhotoDir & Pic_Name
			End If
			Set File = Nothing
		Next
		Set FileUp = Nothing
	End If

End Function

Function UploadFileNow

	If DEF_EnableDotNetUpload = 2 Then
		Upload_NoComponent
	Else
		Upload_FileUp
	End If
	If TempStr <> "" Then Exit Function
	%>
	<script language=javascript>
	<!--
	<%
	Dim HeadStr,Temp,Old_pic_name
	Old_pic_name = pic_name
	If inStrRev(pic_name,".")>0 Then pic_name = Mid(pic_name,inStrRev(pic_name,".")+1)
	
	HeadStr = "\n[img]" & DEF_BBS_HomeUrl & "images/fileType/"  & Replace(pic_name,".","") & ".gif[/img]"
	
	If DEF_EnableGFL = 1 Then
		If inStr(":jpg:gif:jpeg:jpe:png:bmp:psd:tif:sgi:tga:iff:pcx:dcx:pbm:pgm:ppm:pnm:miff:xbm:xpm:ico:icl:emf:hru:jif:prc:wrl:wbmp:",pic_name) > 0 Then
			Temp = SaveSmallPic(PhotoDir & Old_pic_name,PhotoDir & pic_name2,DEF_AllFaceMaxWidth,DEF_AllFaceMaxWidth)
			If Temp = 4 Then
				If inStrRev(UploadPhotoUrl2,".")>0 Then
					UploadPhotoUrl2 = Left(UploadPhotoUrl2,inStrRev(UploadPhotoUrl2,".")) & "jpg"
				Else
					UploadPhotoUrl2 = UploadPhotoUrl2 & "jpg"
				End if
				If inStrRev(pic_name2,".")>0 Then
					pic_name2 = Left(pic_name2,inStrRev(pic_name2,".")) & "jpg"
				Else
					pic_name2 = pic_name2 & "jpg"
				End if
			ElseIf Temp = 3 Then
				If inStrRev(UploadPhotoUrl2,".")>0 Then
					UploadPhotoUrl2 = Left(UploadPhotoUrl2,inStrRev(UploadPhotoUrl2,".")) & "gif"
				Else
					UploadPhotoUrl2 = UploadPhotoUrl2 & "gif"
				End if
				If inStrRev(pic_name2,".")>0 Then
					pic_name2 = Left(pic_name2,inStrRev(pic_name2,".")) & "gif"
				Else
					pic_name2 = pic_name2 & "gif"
				End if
			Else
				If Temp = 1 Then
					If inStrRev(UploadPhotoUrl2,".")>0 Then
						UploadPhotoUrl2 = Left(UploadPhotoUrl2,inStrRev(UploadPhotoUrl2,".")) & "jpg"
					Else
						UploadPhotoUrl2 = UploadPhotoUrl2 & "jpg"
					End if
					If inStrRev(pic_name2,".")>0 Then
						pic_name2 = Left(pic_name2,inStrRev(pic_name2,".")) & "jpg"
					Else
						pic_name2 = pic_name2 & "jpg"
					End if
				End If
			End If
			If Temp = 1 or Temp = 3 or Temp = 4 Then
				If GBL_Width < 20 or GBL_Height < 20 Then
					Response.Write "alert(""图像宽度或高度太小或比例不相称,最小要求20像素!"");"
					DeleteFiles PhotoDir & pic_name2
				Else
					CheckUploadDatabase PhotoDir & pic_name2,""
					Response.Write "addcontent(""" & UploadPhotoUrl2 & """," & GBL_Width & "," & GBL_Height & ");"
				End If
				DeleteFiles(PhotoDir & Old_pic_name)
			Else
				If Temp = 2 Then
					If GBL_Width < 20 or GBL_Height < 20 Then
						Response.Write "alert(""图像宽度或高度太小或比例不相称,最小要求20像素!"");"
						DeleteFiles PhotoDir & pic_name2
						DeleteFiles(PhotoDir & Old_pic_name)
					Else
						CheckUploadDatabase PhotoDir & Old_pic_name,""
						Response.Write "addcontent(""" & UploadPhotoUrl & """," & GBL_Width & "," & GBL_Height & ");"
					End If
				Else
					Response.Write "alert(""非图像文件,上传错误!"");"
					DeleteFiles(PhotoDir & Old_pic_name)
				End If
			End If
		Else
			Response.Write "alert(""非图像文件,上传错误!"");"
			DeleteFiles(PhotoDir & Old_pic_name)
		End If
	Else
		If pic_name = "gif" or pic_name = "jpg" or pic_name = "jpeg" or pic_name = "jpe" or pic_name = "bmp" or pic_name = "png" Then
			CheckUploadDatabase PhotoDir & Old_pic_name,""
			Response.Write "addcontent(""" & UploadPhotoUrl & """," & DEF_AllFaceMaxWidth & "," & DEF_AllFaceMaxWidth & ");"
		Else
			Response.Write "alert(""非图像文件,上传错误!"");"
			DeleteFiles(PhotoDir & Old_pic_name)
		End If
	End If
	%>

	//-->
	</script>
	<img src=../images/null.gif width=2 height=5><br>&nbsp;文件上传成功,要<a href=uploadFile.asp>继续上传请点这里</a>
	<%

End Function

Function DeleteFiles(path)

	If DEF_FSOString = "" Then Exit Function
    on error resume next
    Dim fs
    Set fs = Server.CreateObject(DEF_FSOString)
	If err <> 0 Then
		Err.Clear
		'Response.Write "<br>服务器不支持FSO，硬盘文件未删除．"
		Exit Function
	End If
    If fs.FileExists(path) Then
      fs.DeleteFile path,True
      DeleteFiles = 1
    Else
      DeleteFiles = 0
    End If
    Set fs = Nothing
         
End Function

%>