<!--#include file="photoconn.jsp"-->
<%

flashuserid=Request("flashuserid")
if flashuserid="" then
	response.Write("登陆后才能上传文件")
	response.End()
end if
'response.Write(flashuserid)
'	response.End()
''
dim conn2, strnow, strSaveFileName,sql2,rs2,rs1,FilePath,sql1,saa,img_size
strnow =replace(replace(replace(now, ":", ""), "-", ""), " ", "")
strSaveFileName =strNow &".jpg"
Sub DataConnect()
	If isObject(Conn2) Then Exit Sub
	Set Conn2 = Server.CreateObject("Adodb.Connection")
	Conn2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("img.mdb")
	Conn2.Open
	If Err Then
		Set Conn2 = Nothing
		Response.Write "数据库连接错误，可能数据库路径设置错误。<br><font color=red>" & Err.description & "<br>"
		Err.Clear()
		Response.End
	End If
End Sub
Sub DataDisConnect()
	If Not isObject(Conn2) Then Exit Sub
	Conn2.Close : Set Conn2 = Nothing
End Sub


	Dim intTotalLine
	intTotalLine =Request.Form.Count
	Dim strHeadData
	strHeadData =ChrB(66) & ChrB(77) & ChrB(230) & ChrB(4) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
				 ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) &_
				 ChrB(0) & ChrB(0) & ChrB(160) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(120) & ChrB(0) &_
				 ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0) &_
				 ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(176) & ChrB(4) &_
				 ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) &_
				 ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) &_
				 ChrB(0) & ChrB(0)
	Dim strSaveData, intLoop1, intLoop2, strTempData
	For intLoop1 =intTotalLine To 0 Step -1
		strTempData =Request.Form("PX"&intLoop1)
		strTempData =Split(strTempData, ",")
		For intLoop2 =0 To ubound(strTempData)
			'strSaveData =strSaveData &toBin(strTempData(intLoop2))
			strSaveData =strSaveData &To3(strTempData(intLoop2))
		Next
	Next
	strSaveData =strHeadData & strSaveData
	
	Call DataConnect
		'on error resume next
		set rs2 =server.CreateObject("adodb.recordset")
		sql2 ="select * from [img]"
		rs2.open sql2,Conn2,1,3
		rs2.addnew
		rs2("id") =strnow
		rs2("addtime") =now
		rs2("imgdata").AppendChunk(strSaveData)
		rs2.update
		rs2.close
		set rs2 =nothing
		
		set rs2 =conn2.execute("select * from [img] where id ="& strnow)
			img_size =rs2("imgdata").ActualSize 
			saa= rs2("imgdata").GetChunk(img_size)
		set rs2 =nothing
		FilePath="up_photo/"
		FilePath=CreatePath(FilePath)
		Call SaveStream(FilePath& strSaveFileName, saa)
		'response.Write(FilePath)
		conn2.execute("delete from [img] where id ="& strnow)

		if err then response.Write err.description
	Call DataDisConnect
	
	response.Write("thisfile="& FilePath&strSaveFileName)
	''相册
	Set rs1=Server.CreateObject("ADODB.RecordSet")
		sql1="select * from T_member_photo"
		rs1.open sql1,conn1,1,3
		
		rs1.addnew
		rs1("f_photo")=FilePath&strSaveFileName
		rs1("f_userid")=flashuserid
		rs1("f_regtime")=now
		rs1("f_ischeck")=1		
		rs1.Update
		rs1.Close
		set rs1=nothing
		closedb()
	''
	
Sub SaveStream(paR_strFile, paR_streamContent)
	Dim objStream
	Set objStream =Server.CreateObject("ADODB.Stream")
		with objStream
			.Type =1
			.Open
			.Write paR_streamContent
			.SaveToFile Server.Mappath(paR_strFile), 2
			.Close()
		End with
	Set objStream =Nothing
End Sub
	
	
Function To3(nums)
	Dim myArray()
	Dim iii, tmp
	For iii=1 To 3
		tmp=Mid(nums,iii*2-1,2)
		Redim Preserve myArray(iii)
		myArray(iii) =chn10(tmp)
		'myArray(iii) =tmp
	Next
	To3 = ChrB(myArray(3))&ChrB(myArray(2))&ChrB(myArray(1))
End Function

Function toBin(str)
	Dim intTemp, binTemp, strTemp
	For intTemp =1 To 6 Step 2
		strTemp =Mid(str, intTemp, 2)
		binTemp =binTemp & ChrB(chn10(strTemp))
	Next
	toBin =binTemp
End Function

Function chn10(nums)
	Dim tmp, tmpstr, intLoop4
	nums_len=Len(nums)
	For intLoop4=1 To nums_len
		tmp=Mid(nums,intLoop4,1)
		If IsNumeric(tmp) Then
			tmp=tmp * 16 * (16^(nums_len-intLoop4-1))
		Else
			tmp=(ASC(UCase(tmp))-55) * (16^(nums_len-intLoop4))
		End If
		tmpstr=tmpstr+tmp
	Next
	chn10 = tmpstr
End Function

'检查上传目录，若无目录则自动建立
Function CreatePath(PathValue)
	Dim objFSO,Fsofolder,uploadpath
	if upload_dir<>"" then
		uploadpath = year(Date) & "-" & month(Date)
	else
		uploadpath=""
	end if
	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 and upload_dir<>"" Then
			CreatePath = PathValue & uploadpath & "/"
		Else
			CreatePath = PathValue
		End If
	Set objFSO = Nothing
End Function
%>