<%
Dvbbs.LoadTemplates("plus")
'ConnectionDatabase()
dim LocalPic,PicPath,CartLength,hasVipPlus,DefaultVisualBoy,DefaultVisualGirl
dim hasVisualPlus,VisualLocalPic,VisualPicPath,HomePath,ForumName
dim mymoney
hasVipPlus=1	'如果你没有安装VIP插件，请设置为0
hasVisualPlus=1		'如果你没有虚拟形象插件，请设置为0
CartLength=100		'购物车的大小
LocalPic=0		'0-使用腾讯图片 1-使用本地图片
VisualLocalPic=0	'0-虚拟形象插件使用腾讯图片 1-虚拟形象插件使用本地图片(hasVisualPlus=0时无效)
if LocalPic=1 then
	PicPath="Images/Img_home/Home/"
else
	PicPath="http://home-item.qq.com/"
end if
if hasVisualPlus=1 then
	if VisualLocalPic=1 then
		VisualPicPath="Images/Img_Visual/Show/"
	else
		VisualPicPath="http://qqshow-item.tencent.com/"
	end if
	DefaultVisualBoy="||||||14.7|13.8|12.9||11.11||10.13|9.14||||8.18|||||||"
	DefaultVisualGirl="||||||7.7|6.8|5.9||4.11||3.13|2.14||||1.18|||||||"
end if
HomePath="UserHome" '保存家园照片的目录
ForumName=Split(Split(dvbbs.CacheData(1,0),"|||")(0),",")(0)
Dim v_myvip,v_myvisual
v_myvip=0
v_myvisual=""

if Dvbbs.Userid<>"0" then
	set rs=server.createobject("adodb.recordset")
	if hasVipPlus=1 then
		sql="select Javip from JaUser where JaUid="&Dvbbs.Userid
		rs.open sql,conn,1,1
		if not rs.eof or not rs.bof then
			v_myvip=rs("JAvip")
			if isnull(v_myvip) then
				v_myvip=0
			end if
		end if
		rs.close
	end if

	SQL="select * from JaUser where JaUid="&Dvbbs.Userid

	rs.open sql,conn,1,1
	if not (rs.eof or rs.bof) then
	mymoney=rs("JaMonery")
		if hasVisualPlus=1 then
			if isnull(rs("visual")) or rs("visual")="" then
				if rs("Jasex")="男" then
					v_myvisual=DefaultVisualBoy
				else
					v_myvisual=DefaultVisualGirl
				end if
			else
				v_myvisual=rs("visual")
			end if
		end if
	end if
	rs.close
	set rs=nothing
	
	if session("HomeUpdate"&Dvbbs.Userid)="" or not isdate(session("HomeUpdate"&Dvbbs.Userid)) then
  call FlushMyItems(dvbbs.MemberName)
elseif datediff("d",session("HomeUpdate"&Dvbbs.Userid),now())>0 then
  call FlushMyItems(dvbbs.MemberName)
end if
	
	
	'if session("HomeUpdate"&dvbbs.userid)="" or not isdate(session("HomeUpdate"&dvbbs.userid)) then
	'	home_conn.execute("update Home_myitems set type=0 where type<>0 and type<>5 and datediff('d',fixdate,now())>period and period>0 and username='"&dvbbs.MemberName&"'")
	'	session("HomeUpdate"&dvbbs.userid)=now()
	'elseif datediff("d",session("HomeUpdate"&dvbbs.userid),now())>0 then
	'	home_conn.execute("update Home_myitems set type=0 where type<>0 and type<>5 and datediff('d',fixdate,now())>period and period>0 and username='"&dvbbs.MemberName&"'")
	'	session("HomeUpdate"&dvbbs.userid)=now()
	'end if
	
	
	
	
	
end if
function checkStr(str)
	if isnull(str) then
		checkStr = ""
		exit function 
	end if
	checkStr=replace(str,"'","''")
end function
function isInteger(para)
       on error resume next
       dim str
       dim l,i
       if isNUll(para) then 
          isInteger=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isInteger=false
          exit function
       end if
       l=len(str)
       for i=1 to l
           if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
              isInteger=false 
              exit function
           end if
       next
       isInteger=true
       if err.number<>0 then err.clear
end function

sub DispPageNum(CurPage, PageCount, URLPrefix, URLPostfix)
	dim p,ii
	if PageCount=0 then
		response.write "无 "
	else
		p=(CurPage-1) \ 10
		if CurPage=1 then
			response.write "<SPAN class=pagenumstatic><font face=webdings color=red>9</font></SPAN>  "
		else
			response.write "<SPAN class=pagenum><a href="&URLPrefix&"1"&URLPostfix&" title=首页><font face=webdings>9</font></a></SPAN> "
		end if
		if p>0 then response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(p*10)&URLPostfix&" title=上十页><font face=webdings>7</font></a></SPAN> "
		response.write "<b>"
		for ii=p*10+1 to P*10+10
			if ii=CurPage then
		  	response.write "<SPAN class=pagenumstatic><B><font color=red>"+Cstr(ii)+"</font></B></SPAN> "
			else
				response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(ii)&URLPostfix&">"+Cstr(ii)+"</a></SPAN> "
			end if
			if ii=PageCount then exit for
		next
		if ii>p*10+10 then ii=ii-1
		response.write "</b>"
		if ii<PageCount then response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(ii+1)&URLPostfix&" title=下十页><font face=webdings>8</font></a></SPAN> "
		if CurPage=PageCount then
			response.write "<SPAN class=pagenumstatic><font face=webdings color=red>:</font></SPAN>"
		else
			response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(PageCount)&URLPostfix&" title=尾页><font face=webdings>:</font></a></SPAN> "
		end if
	end if
end sub


sub FlushMyItems(UserName)
dim rsHome,sqlHome
dim LastScenID,MsgBody,ScenName,ItemName
conn.execute("update Home_myitems set type=0 where type<>0 and type<>5 and datediff(d,fixdate,getdate())>period and period>0 and username='"&session("loginusername")&"'")
session("HomeUpdate"&Dvbbs.Userid)=now()
sqlHome="select a.itemid,a.scenid,a.needcnt,b.hascnt from (select scenid,itemid,count(itemid) as needcnt from home_scendetail inner join home_scen on home_scendetail.scenid=home_scen.id where home_scen.username='"&session("loginusername")&"' and home_scen.isOpen=1 and home_scendetail.itemid<>0 group by scenid,itemid) a inner join (select itemid,count(itemid) as hascnt from home_myitems where username='"&session("loginusername")&"' and type>0 and Type<5 group by itemid) b on a.itemid=b.itemid where a.needcnt>b.hascnt"
set rsHome=Server.CreateObject("ADODB.Recordset")
rsHome.open sqlHome,conn,1,1
if not rsHome.eof then
  LastScenID=0
  MsgBody="您的家园方案中存在如下过期物品："&chr(10)
  do while not rsHome.eof
   if rsHome(1)<>LastScenID then
    ScenName=conn.execute("select name from Home_Scen where id="&rsHome(1))(0)
    LastScenID=rsHome(1)
    conn.execute("update home_scen set isOpen=0,isDefault=0 where id="&LastScenID)
    MsgBody=MsgBody&chr(10)&"方案【"&ScenName&"】的物品"
   else
    MsgBody=MsgBody&"、"
   end if
   ItemName=conn.execute("select name from home_items where id="&rshome(0))(0)
   MsgBody=MsgBody&""&ItemName&" ("&(rsHome(2)-rsHome(3))&" 个)"
   rshome.movenext
  loop
  MsgBody=MsgBody&chr(10)&"请尽快翻新相关物品。"&chr(10)&"翻新前，相关方案无法公开显示！"
  dim rs2
  set rs2=server.createobject("adodb.recordset")
  sql="select * from [message]"      
  rs2.open sql,conn,1,3      
  rs2.addnew      
  rs2("sender")=ForumName
  rs2("incept")=UserName
  rs2("title")="您的家园物品过期了！"
  rs2("sendtime")=Now()
  rs2("content")=MsgBody
  rs2("flag")=0 
  rs2("issend")=1
  rs2.update
  rs2.close
  set rs2=nothing
end if
rsHome.close
set rsHome=nothing
end sub


Function hasASPPainter()
Dim pic
on error resume next
Set pic = CreateObject("ASPPainter.Pictures.1")
if err.Number=0 then
  on error goto 0
  hasASPPainter=true
else
  err.clear
  on error goto 0
  hasASPPainter=false
end if
End Function

Sub SaveScen(SaveScenID,lHasUser,lHasScenName,lHasDateTime)
Dim rsScen,rsScenDetail,UserName,ScenName,DateTime,sql,VisualFlip,VisualPosX,VisualPosY
Dim pic,HomeURL,CurPosX,CurPosY,i,CurVisual
Dim BodyStr,BodySplit

if isNull(SaveScenID) or not isnumeric(SaveScenID) then
  exit Sub
end if
if not (hasASPPainter() and LocalPic=1) then
  exit Sub
end if
sql="select * from Home_Scen where ID="&SaveScenID
set rsScen=Server.CreateObject("ADODB.Recordset")
rsScen.open sql,conn,1,1
if not rsScen.eof then
  UserName=rsScen("UserName")
  ScenName=rsScen("Name")
  DateTime=FormatDateTime(rsScen("DateAndTime"),2)
  HomeUrl=rsScen("URL")
  set rsScenDetail=Server.CreateObject("ADODB.Recordset")
  sql="select * from Home_ScenDetail where ScenID="&SaveScenID&" order by ID"
  rsScenDetail.open sql,conn,1,1
  Set pic = CreateObject("ASPPainter.Pictures.1")
  pic.SetBkColor 255,255,255,255
  pic.Create 616,394
  pic.SetColor 0,0,0,255
  pic.SetLineWidth 1
  pic.DrawRectangle 0,0,615,393
  pic.SetImageIndex 1
  pic.LoadFile Server.MapPath(PicPath&"1/0002.gif")
  call MeragePic(pic,0,1,1,1,614,392,0,0,pic.Width,pic.Height)
  pic.LoadFile Server.MapPath(PicPath&"1/0003.gif")
  call MeragePic(pic,0,1,1,1,614,392,0,0,pic.Width,pic.Height)
  do while not rsScenDetail.eof
   if rsScenDetail("ItemID")=0 then
    VisualFlip=rsScenDetail("isFlip")
    VisualPosX=rsScenDetail("PosX")
    VisualPosY=rsScenDetail("PosY")
   else
    pic.LoadFile Server.MapPath(PicPath&"1/"&right("0000"&rsScenDetail("ItemID"),4)&".gif")
    if rsScenDetail("isFlip") then
     pic.HorizontalFlip
    end if
    if rsScenDetail("Unicode")=-10 or rsScenDetail("Unicode")=-11 then
     call MeragePic(pic,0,1,1,1,614,392,rsScenDetail("PosX"),rsScenDetail("PosY"),pic.Width,pic.Height)
    else
     call MeragePic(pic,0,1,1,1,614,392,rsScenDetail("PosX")+1,rsScenDetail("PosY")+1,pic.Width,pic.Height)
    end if
   end if
   rsScenDetail.movenext
  loop
  rsScenDetail.close
  if hasVisualPlus=1 and VisualLocalPic=1 then
   sql="select * from JaUser where Jauname='"&UserName&"'"
   rsScenDetail.open sql,conn,1,1
   if not rsScenDetail.eof then
    if isnull(rsScenDetail("visual")) or rsScenDetail("visual")="" then
     if rsScenDetail("Jasex")="男" then
      curvisual=DefaultVisualBoy
     else
      curvisual=DefaultVisualGirl
     end if
    else
     curvisual=rsScenDetail("visual")
    end if
   end if
   rsScenDetail.close
   BodyStr=GetBody(CurVisual)
   BodySplit=Split(BodyStr,"|")
   for i=0 to ubound(bodysplit)
    pic.LoadFile Server.MapPath(VisualPicPath&BodySplit(i))
    call MeragePic(pic,0,1,1,1,614,392,VisualPosX+1,VisualPosY+1,pic.Width,pic.Height)
   next
  else
   pic.LoadFile Server.MapPath("Images/Img_Home/default_show.gif")
   if VisualFlip then
    pic.HorizontalFlip
   end if
   call MeragePic(pic,0,1,1,1,614,392,VisualPosX+1,VisualPosY+1,pic.Width,pic.Height)
  end if
  set rsScenDetail=nothing
  if isnull(HomeURL) or HomeURL="" then
   randomize
   HomeURL=HomePath&"/Home_"&SaveScenId&"_"&right("000000"&int(rnd*1000000),6)&".png"
   conn.execute("update home_scen set url='"&homeurl&"' where id="&SaveScenID)
  end if
  pic.SetImageIndex 0
  pic.SetFontName "宋体"
  pic.SetFontSize 9
  pic.SetFontBold 0
  
  pic.SetFontOrientation 0
  pic.setTextAlign 0
  CurPosY=372
  pic.SetFontRectangle 10,CurPosY,609,CurPosY+15
  pic.SetColor 255,255,255,255
  pic.TextOut 0,0,trim("制作："&ForumName)
  pic.ClearFontRectangle
  pic.SetFontRectangle 9,CurPosY-1,608,CurPosY+14
  pic.SetColor 0,0,0,255
  pic.TextOut 0,0,trim("制作："&ForumName)
  pic.ClearFontRectangle
  CurPosY=CurPosY-15
  if lHasDateTime then
   pic.SetFontRectangle 10,CurPosY,609,CurPosY+15
   pic.SetColor 255,255,255,255
   pic.TextOut 0,0,trim("时间："&DateTime)
   pic.ClearFontRectangle
   pic.SetFontRectangle 9,CurPosY-1,608,CurPosY+14
   pic.SetColor 0,0,0,255
   pic.TextOut 0,0,trim("时间："&DateTime)
   pic.ClearFontRectangle
   CurPosY=CurPosY-15
  end if
  if lHasUser then
   pic.SetFontRectangle 10,CurPosY,609,CurPosY+15
   pic.SetColor 255,255,255,255
   pic.TextOut 0,0,trim("作者："&UserName)
   pic.ClearFontRectangle
   pic.SetFontRectangle 9,CurPosY-1,608,CurPosY+14
   pic.SetColor 0,0,0,255
   pic.TextOut 0,0,trim("作者："&UserName)
   pic.ClearFontRectangle
   CurPosY=CurPosY-15
  end if
  if lHasScenName<>"" then
   pic.SetFontRectangle 10,CurPosY,609,CurPosY+15
   pic.SetColor 255,255,255,255
   pic.TextOut 0,0,trim("方案："&ScenName)
   pic.ClearFontRectangle
   pic.SetFontRectangle 9,CurPosY-1,608,CurPosY+14
   pic.SetColor 0,0,0,255
   pic.TextOut 0,0,trim("方案："&ScenName)
   pic.ClearFontRectangle
   CurPosY=CurPosY-15
  end if
  pic.SetFormat 0
  pic.SaveToFile Server.MapPath(HomeURL)

  
  
  pic.DestroyAll
  Set pic = Nothing
else
  SaveScen=""
end if
rsScen.close
set rsScen=nothing
End Sub

Sub MeragePic(PicObject,BaseIndex,PicIndex,BaseX,BaseY,BaseWidth,BaseHeight,PicRelX,PicRelY,PicRelWidth,PicRelHeight)
Dim PicAbsX,PicAbsY,PicAbsWidth,PicAbsHeight
Dim DestX,DestY

if PicRelX<0 then
  PicAbsX=-PicRelX
  DestX=BaseX
else
  PicAbsX=0
  DestX=PicRelX+BaseX
end if
if PicRelX+PicRelWidth>BaseWidth then
  if PicRelX<0 then
   PicAbsWidth=BaseWidth
  else
   PicAbsWidth=BaseWidth-PicRelX
  end if
else
  if PicRelX<0 then
   PicAbsWidth=PicRelX+PicRelWidth-1
  else
   PicAbsWidth=PicRelWidth
  end if
end if
if PicRelY+PicRelHeight>BaseHeight then
  PicAbsY=PicRelY+PicRelHeight-BaseHeight
  DestY=BaseY
else
  PicAbsY=0
  DestY=BaseHeight-(PicRelY+PicRelHeight)+BaseY
end if
if PicRelY<0 then
  if PicRelY+PicRelHeight>BaseHeight then
   PicAbsHeight=BaseHeight
  else
   PicAbsHeight=PicRelHeight+PicRelY
  end if
else
  if PicRelY+PicRelHeight>BaseHeight then
   PicAbsHeight=PicRelHeight-PicAbsY
  else
   PicAbsHeight=PicRelHeight
  end if
end if
PicObject.Merge BaseIndex,PicIndex,DestX,DestY,PicAbsX,PicAbsY,PicAbsWidth,PicAbsHeight,100
End Sub

Function GetBody(UserVisual)
dim VisualSplit,TempSplit,i
dim Result
if UserVisual="" then
  GetBody=""
  Exit Function
end if
VisualSplit=Split(UserVisual,"|")
Result=""
for i=0 to ubound(VisualSplit)
  if i>=4 and i<=20 then
   if VisualSplit(i)<>"" then
    TempSplit=Split(VisualSplit(i),".")
    if Result<>"" then Result=Result&"|"
    Result=Result&(i+1)&"/"&right("0000"&TempSplit(0),4)&".Gif"
   end if
  end if
next
GetBody=Result
End Function



%>