<!-- #include file=../../inc/BBSsetup.asp -->
<!-- #include file=../../inc/Upload_Setup.asp -->
<!-- #include file=../../inc/Board_Popfun.asp -->
<!-- #include file=../inc/bbsmanage_Fun.asp -->
<%
server.scriptTimeOut = 9999
DEF_BBS_HomeUrl = "../../"
InitDatabase
Dim GBL_ID,Form_ID

Dim DelUserID
DelUserID = Left(Request("DelUserID"),14)
If isNumeric(DelUserID) = 0 or DelUserID = "" or InStr(DelUserID,",") > 0 Then DelUserID = 0
DelUserID = Fix(cCur(DelUserID))

If DelUserID < 0 Then DelUserID = 0

GBL_CHK_TempStr=""
GBL_ID = checkSupervisorPass
Form_ID = GBL_ID
Form_ID = cCur(Form_ID)
If Form_ID < 0 Then Form_ID = 0
If Form_ID = 0 or GBL_CHK_Flag = 0 Then
	GBL_CHK_TempStr = GBL_CHK_TempStr & "你没有登录<br>" & VbCrLf
End If

Dim UserName

siteHead("   删除用户相关资料")%>
<script language=javascript>
	window.moveTo(window.screen.width/2-225,window.screen.height/2-18);
</script>
	<%
	Dim Rs,SQL,SQLendString,ClearFlag
	If GBL_CHK_TempStr = "" Then
		Set Rs = Server.CreateObject("ADODB.RecordSet")
		If GBL_UserID<1 or CheckSupervisorUserName = 0 Then
			SQL = "Select top 1 ID,UserName from LeadBBS_User where ID=-111"
		Else
			SQL = "Select top 1 ID,UserName from LeadBBS_User where id=" & DelUserID
		End If
		Rs.Open SQL,con,1,1
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			Response.Write "找不到记录！<br>" & VbCrLf
			Rs.Close
			Set Rs = Nothing
		Else
			Dim dflag
			dflag = Left(Request("dflag"),10)
			If Request.Form("DeleteSureFlag")="dk9@dl9s92lw_SWxl" Then
				UserName = Rs(1)
				Rs.Close
				Set Rs = Nothing
				DeleteUserInfo DelUserID,UserName
			Else
				UserName = Rs(1)
				Rs.Close
				Set Rs = Nothing
				%>
				<form name=DellClientForm action=DelUserAllAnnounce.asp method=post>
				<input type=hidden name=DeleteSureFlag value="dk9@dl9s92lw_SWxl">
				<input type=hidden name=DelUserID value="<%=htmlencode(DelUserID)%>">
				<input type=hidden name=dflag value="<%=htmlencode(dflag)%>">
				<%If dflag <> "onlyupload" Then%>
				<b>此操作不可逆，确认要删除用户<font color=ff0000 class=RedFont><%=htmlencode(UserName)%></font>的所有相关资料吗？
				注意，操作后请<font color=ff0000 class=RedFont>重做论坛列表及修复</font>的工作，以保证帖子数量统计准确．</b>
				<%Else%>
				<b>此操作不可逆，确认要删除用户<font color=ff0000 class=RedFont><%=htmlencode(UserName)%></font>的所有上传附件么？</b>
				<%End If%>
				<p><input type=submit value=确定 class=fmbtn>
				<input type=button value=不删 onclick="javascript:window.close();" class=fmbtn>
				</form>
				<%
			End If
		End If
	Else%>
		<table width=96%>
		<tr>
		<td>
		<%Response.Write "<p align=left><font color=ff0000 class=RedFont><b>" & GBL_CHK_TempStr & "</b>"
		Response.Write "</p>"%>
		</td>
		</tr>
		</table>
	<%End If

closeDataBase

Function DeleteUserInfo(DelUserID,UserName)

	Dim Rs,SQL
	Dim NowID,EndFlag
	NowID = 0
	EndFlag = 0

	Response.Write "进度(需要时间可能会很长，请等待出现完成)：□"
	Response.Flush
	Dim TempNum
	
	If DEF_FSOString = "" Then
		Response.Write " <font color=Red class=RedFont>不支持FSO，略过附件删除．</font>"
	Else
		Do while EndFlag = 0
			SQL = "Select top 100 ID,PhotoDir,SPhotoDir from LeadBBS_Upload where UserID=" & DelUserID & " and ID>" & NowID & " order by ID ASC"
			GBL_DBNum = GBL_DBNum + 1
			Set Rs = Con.ExeCute(SQL)
			If Rs.Eof Then
				EndFlag = 1
				Rs.Close
				Set Rs = Nothing
			Else
				TempNum = 0
				Do while Not Rs.Eof
					If Rs("PhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("PhotoDir"),"/","\"),"\\","\")))
					If Rs("SPhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("SPhotoDir"),"/","\"),"\\","\")))
					TempNum = TempNum + 1
					NowID = Rs(0)
					Rs.MoveNext
				Loop
				Response.Write "■"
				Rs.Close
				Set Rs = Nothing
				Response.Flush
				Con.Execute("Delete from LeadBBS_Upload where UserID=" & DelUserID & " and ID<=" & NowID)
				con.Execute("update LeadBBS_SiteInfo set UploadNum=UploadNum-" & TempNum)
				Con.ExeCute("Update LeadBBS_User Set UploadNum=UploadNum-" & TempNum & " where id=" & DelUserID)
				GBL_DBNum = GBL_DBNum + 3
			End If
		Loop
		
		SQL = "Select ID,PhotoDir,SPhotoDir from LeadBBS_UserFace where UserID=" & DelUserID & " order by ID ASC"
		GBL_DBNum = GBL_DBNum + 1
		Set Rs = Con.ExeCute(SQL)
		If Rs.Eof Then
			Rs.Close
			Set Rs = Nothing
		Else
			If Rs("PhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("PhotoDir"),"/","\"),"\\","\")))
			If Rs("SPhotoDir") <> "" Then DeleteFiles(Server.Mappath(Replace(Replace(DEF_BBS_HomeUrl & DEF_BBS_UploadPhotoUrl & Rs("SPhotoDir"),"/","\"),"\\","\")))
			Response.Write "■"
			Rs.Close
			Set Rs = Nothing
			Response.Flush
			Con.Execute("Delete from LeadBBS_UserFace where UserID=" & DelUserID)
			GBL_DBNum = GBL_DBNum + 1
		End If
	End If

	If Left(Request("dflag"),10) = "onlyupload" Then
		Response.Write " <b><font color=green class=GreenFont>完成用户附件删除!</font></b>"
		Exit Function
	End If
	
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	NowID = 0
	EndFlag = 0
	Do while EndFlag = 0
		SQL = "Select top 100 ID from LeadBBS_FriendUser where UserID=" & DelUserID & " and ID>" & NowID & " order by ID ASC"
		GBL_DBNum = GBL_DBNum + 1
		Rs.Open SQL,con,1,1
		If Rs.Eof Then
			EndFlag = 1
			Rs.Close
		Else
			Rs.MoveLast
			NowID = Rs(0)
			Response.Write "■"
			Rs.Close
			Response.Flush
			Con.Execute("Delete from LeadBBS_FriendUser where UserID=" & DelUserID & " and ID<=" & NowID)
			GBL_DBNum = GBL_DBNum + 1
		End If
	Loop

	NowID = 0
	EndFlag = 0

	Response.Write "□"
	Do while EndFlag = 0
		SQL = "Select top 100 ID from LeadBBS_FriendUser where FriendUserID=" & DelUserID & " and ID>" & NowID & " order by ID ASC"
		GBL_DBNum = GBL_DBNum + 1
		Rs.Open SQL,con,1,1
		If Rs.Eof Then
			EndFlag = 1
			Rs.Close
		Else
			Rs.MoveLast
			NowID = Rs(0)
			Response.Write "■"
			Rs.Close
			Response.Flush
			Con.Execute("Delete from LeadBBS_FriendUser where FriendUserID=" & DelUserID & " and ID<=" & NowID)
			GBL_DBNum = GBL_DBNum + 1
		End If
	Loop

	NowID = 0
	EndFlag = 0

	Response.Write "□"
	Do while EndFlag = 0
		SQL = "Select top 100 ID from LeadBBS_InfoBox where FromUser='" & Replace(UserName,"'","''") & "' and ID>" & NowID & " order by ID ASC"
		GBL_DBNum = GBL_DBNum + 1
		Rs.Open SQL,con,1,1
		If Rs.Eof Then
			EndFlag = 1
			Rs.Close
		Else
			Rs.MoveLast
			NowID = Rs(0)
			Response.Write "■"
			Rs.Close
			Response.Flush
			Con.Execute("Delete from LeadBBS_InfoBox where FromUser='" & Replace(UserName,"'","''") & "' and ID<=" & NowID)
			GBL_DBNum = GBL_DBNum + 1
		End If
	Loop

	NowID = 0
	EndFlag = 0

	Response.Write "□"
	Do while EndFlag = 0
		SQL = "Select top 100 ID from LeadBBS_InfoBox where ToUser='" & Replace(UserName,"'","''") & "' and ID>" & NowID & " order by ID ASC"
		Rs.Open SQL,con,1,1
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			EndFlag = 1
			Rs.Close
		Else
			Rs.MoveLast
			NowID = Rs(0)
			Response.Write "■"
			Rs.Close
			Response.Flush
			Con.Execute("Delete from LeadBBS_InfoBox where ToUser='" & Replace(UserName,"'","''") & "' and ID<=" & NowID)
			GBL_DBNum = GBL_DBNum + 1
		End If
	Loop

	NowID = 0
	EndFlag = 0
	Dim GetData,N

	Response.Write "□"
	Do while EndFlag = 0
		SQL = "Select top 100 ID from LeadBBS_Announce where UserID=" & DelUserID & " and ID>" & NowID & " order by ID ASC"
		Rs.Open SQL,con,1,1
		GBL_DBNum = GBL_DBNum + 1
		If Rs.Eof Then
			EndFlag = 1
			Rs.Close
		Else
			GetData = Rs.GetRows(-1)
			Rs.Close
			SQL = Ubound(GetData,2)
			For N = 0 to SQL
				NowID = cCur(GetData(0,n))
				DelAnnounce(NowID)
				Con.ExeCute("delete from LeadBBS_Announce Where ID=" & NowID)
				Con.ExeCute("delete from LeadBBS_Topic Where ID=" & NowID)
			Next
			Response.Write "■"
			Response.Flush
		End If
	Loop

	ReloadTopAnnounceInfo(0)
	ReloadOtherTopAnnounce
	ReloadStatisticData
	Response.Write " <b><font color=green class=GreenFont>完成!</font></b>"
	Set Rs = Nothing

End Function

Function DelAnnounce(DelID)

	Dim Rs,SQL
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	SQL = "Select top 1 BoardID,ParentID,UserID,RootID,Layer,TopicType,ndatetime,GoodFlag,RootIDBak from LeadBBS_Announce where id=" & DelID
	Rs.Open SQL,con,1,1
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Rs.Close
		Set Rs = Nothing
		Exit Function
	End if

	Dim BoardID,ParentID,UserID,RootID,Layer,TopicType,ndatetime,GoodFlag,RootIDBak
	BoardID = cCur(Rs("BoardID"))
	ParentID = cCur(Rs("ParentID"))
	UserID = cCur(Rs("UserID"))
	RootID = cCur(Rs("RootID"))
	Layer = cCur(Rs("Layer"))
	TopicType = Rs("TopicType")
	ndatetime = RestoreTime(Rs("ndatetime"))
	If IsNull(TopicType) Then TopicType = 0
	GoodFlag = Rs("GoodFlag")
	RootIDBak = cCur(Rs("RootIDBak"))

	Rs.Close
	
	Dim RootIDTopicType
	If ParentID > 0 Then
		SQL = "Select top 1 TopicType from LeadBBS_Topic where ID=" & RootIDBak
		Rs.Open SQL,con,1,1
		GBL_DBNum = GBL_DBNum + 1
		If Not Rs.Eof Then
			RootIDTopicType = Rs(0)
			If isNull(RootIDTopicType) Then RootIDTopicType = 0
		Else
			RootIDTopicType = 0
		End If
		Rs.Close
	Else
		RootIDTopicType = 0
	End If
	
	Dim todayAnnounce,GoodNum,GoodNum2
	todayAnnounce = 0
	
	If Day(ndatetime) = Day(DEF_Now) and Year(ndatetime) = year(DEF_Now) and Month(ndatetime) = Month(DEF_Now) Then todayAnnounce = 1
	If GoodFlag = 1 Then
		GoodNum = 1
	Else
		GoodNum = 0
	End If
	GoodNum2 = 0

		If ParentID > 0 Then
			Con.ExeCute("Delete from LeadBBS_Announce where id=" & DelID)
			GBL_DBNum = GBL_DBNum + 1

			Dim TmpMaxID,TmpMinID
			SQL = "select max(ID) from LeadBBS_Announce where RootIDBak=" & RootIDBak
			Rs.Open SQL,con,1,1
			GBL_DBNum = GBL_DBNum + 1
			If Rs.Eof Then
				TmpMaxID = 0
			Else
				TmpMaxID = Rs(0)
				If isNull(TmpMaxID) then TmpMaxID = 0
			End If
			Rs.Close
			SQL = "select min(ID) from LeadBBS_Announce where RootIDBak=" & RootIDBak
			Rs.Open SQL,con,1,1
			GBL_DBNum = GBL_DBNum + 1
			If Rs.Eof Then
				TmpMinID = 0
			Else
				TmpMinID = Rs(0)
				If isNull(TmpMinID) then TmpMinID = 0
			End If
			Rs.Close
			If ParentID = 0 Then
				Con.ExeCute("Update LeadBBS_Boards Set TopicNum=TopicNum-1,AnnounceNum=AnnounceNum-1,todayAnnounce=todayAnnounce-" & todayAnnounce & ",GoodNum=GoodNum-" & GoodNum & " where BoardID=" & BoardID)
				GBL_DBNum = GBL_DBNum + 1
			Else
				SQL = "Select top 1 ID,ndatetime,UserName,ParentID from LeadBBS_Announce where id=" & TmpMaxID
				Rs.Open SQL,con,1,1
				GBL_DBNum = GBL_DBNum + 1
				Dim LastTime,LastUser
				If Not Rs.Eof Then
					LastTime = Rs("ndatetime")
					If cCur(Rs("ParentID")) = 0 Then
						LastUser = ""
					Else
						LastUser = Rs("UserName")
					End If
				Else
					LastTime = GetTimeValue(DEF_Now)
				End If
				Rs.Close
				Con.ExeCute("Update LeadBBS_Boards Set AnnounceNum=AnnounceNum-1,todayAnnounce=todayAnnounce-" & todayAnnounce & ",GoodNum=GoodNum-" & GoodNum & " where BoardID=" & BoardID)
				GBL_DBNum = GBL_DBNum + 1
				If Layer>2 Then
					Con.ExeCute("  Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where ID=" & RootIDBak)
					Con.ExeCute("  Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where ID=" & RootIDBak)
					GBL_DBNum = GBL_DBNum + 2
					Con.ExeCute(" Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & RootIDBak)
					Con.ExeCute(" Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & RootIDBak)
					GBL_DBNum = GBL_DBNum + 2
				Else
					Con.ExeCute(" Update LeadBBS_Announce Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
					Con.ExeCute(" Update LeadBBS_Topic Set ChildNum=ChildNum-1,LastTime=" & LastTime & ",LastUser='" & Replace(LastUser,"'","''") & "' where id=" & ParentID)
					GBL_DBNum = GBL_DBNum + 2
				End If				
			End If
			Con.ExeCute(" Update LeadBBS_User set AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum & " Where ID =" & UserID)
			GBL_DBNum = GBL_DBNum + 1
			'UpdateBoardValue(BoardID)
			Rem 更新MaxRootID
			
			SQL = "Update LeadBBS_Announce set RootMaxID=" & TmpMaxID & _
					",RootMinID=" & TmpMinID &_
					" where ID=" & RootIDBak
			Con.Execute(SQL)
			SQL = "Update LeadBBS_Topic set RootMaxID=" & TmpMaxID & _
					",RootMinID=" & TmpMinID &_
					" where ID=" & RootIDBak
			Con.Execute(SQL)
			GBL_DBNum = GBL_DBNum + 1
		Else
			Dim LoopFlag,NowID,GetData,N
			LoopFlag = 1
			NowID = 0
			
			GoodNum2 = 0
			Dim TmpTopicNum,TmpAnnounceNum,GoodNum3
			TmpAnnounceNum = 0
			TmpTopicNum = 0
			todayAnnounce = 0
			Do While LoopFlag = 1
				Rem 主题帖留着最后删除，以免删除中央意外中止，导致主题损坏
				SQL = "Select top 100 ID,BoardID,ParentID,UserID,ndatetime,GoodFlag from LeadBBS_Announce where RootIDBak=" & RootIDBak & " and id>" & NowID & " order by ID"
				Rs.Open SQL,con,1,1
				GBL_DBNum = GBL_DBNum + 1
				If Not Rs.Eof Then
					GetData = Rs.GetRows(100)
					Rs.Close
					SQL = Ubound(GetData,2)
					For N = 0 to SQL
						If GetData(5,n) = 1 Then
							GoodNum2 = GoodNum2 + 1
							GoodNum3 = 1
						Else
							GoodNum3 = 0
						End If
						If cCur(GetData(2,N)) = 0 Then
							TmpAnnounceNum = TmpAnnounceNum + 1
							TmpTopicNum = TmpTopicNum + 1
						Else
							TmpAnnounceNum = TmpAnnounceNum + 1
						End If
						GetData(4,n) = RestoreTime(GetData(4,n))
						If Day(GetData(4,n)) = Day(DEF_Now) and Year(GetData(4,n)) = year(DEF_Now) and Month(GetData(4,n)) = Month(DEF_Now) Then todayAnnounce = todayAnnounce + 1
						If cCur(GetData(2,N)) = 0 Then
							Con.ExeCute(" Update LeadBBS_User set AnnounceNum=AnnounceNum-1,AnnounceTopic=AnnounceTopic-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
							GBL_DBNum = GBL_DBNum + 1
						Else
							Con.ExeCute(" Update LeadBBS_User set AnnounceNum=AnnounceNum-1,AnnounceGood=AnnounceGood-" & GoodNum3 & " Where ID =" & GetData(3,N))
							GBL_DBNum = GBL_DBNum + 1
						End If
						NowID = cCur(GetData(0,N))
					Next
					Con.ExeCute("Delete from LeadBBS_Announce where RootIDBak=" & RootIDBak & " and id<=" & NowID)
				Else
					LoopFlag = 0
					Rs.Close
				End If
			Loop
			Con.ExeCute("Delete from LeadBBS_Topic where ID=" & RootIDBak)

			If TopicType = 80 or TopicType = 54 Then
				Con.ExeCute("Delete from LeadBBS_VoteUser Where AnnounceID=" & DelID)
				GBL_DBNum = GBL_DBNum + 1
				If TopicType = 80 Then
					Con.ExeCute("Delete from LeadBBS_VoteItem Where AnnounceID=" & DelID)
					GBL_DBNum = GBL_DBNum + 1
				End If
			End If
			GBL_DBNum = GBL_DBNum + 1
			Con.ExeCute("Update LeadBBS_Boards Set TopicNum=TopicNum-" & TmpTopicNum & ",AnnounceNum=AnnounceNum-" & TmpAnnounceNum & ",todayAnnounce=todayAnnounce-" & todayAnnounce & ",GoodNum=GoodNum-" & GoodNum2 & " where BoardID=" & BoardID)
			GBL_DBNum = GBL_DBNum + 1

			'UpdateBoardValue(BoardID)
		End If
	Set Rs = Nothing

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

Sub ReloadOtherTopAnnounce

	Dim Rs,SQL,GetData,N
	Set Rs = Con.ExeCute("Select AssortID from LeadBBS_Assort")
	If Not Rs.Eof Then
		GetData = Rs.GetRows(-1)
		Rs.Close
		Set Rs = Nothing
		SQL = Ubound(GetData,2)
		For N = 0 to SQL
			ReloadTopAnnounceInfo(cCur(GetData(0,n)))
		Next
	Else
		Rs.Close
		Set Rs = Nothing
	End If

End Sub

Sub ReloadTopAnnounceInfo(TID)

	If isNumeric(TID) = 0 Then Exit Sub
	TID = Fix(cCur(TID))
	Dim Rs,GetDataTop,TIDStr
	If TID = 0 Then
		TIDStr = ""
	Else
		TIDStr = TID
	End If
	Set Rs = Con.ExeCute("Select RootID,BoardID from LeadBBS_TopAnnounce where TopType=" & TID)
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		Application.Lock
		application(DEF_MasterCookies & "TopAnc" & TIDStr) = "yes"
		application(DEF_MasterCookies & "TopAncList" & TIDStr) = ""
		Application.UnLock
		Rs.Close
		Set Rs = Nothing
		Exit Sub
	Else
		GetDataTop = Rs.GetRows(-1)
		Rs.close
		Set Rs = Nothing
	End If
	
	Dim Temp,N
	Temp = ""
	If cCur(GetDataTop(0,0)) > 0 Then Temp = GetDataTop(0,0)
	For N = 1 to Ubound(GetDataTop,2)
		If cCur(GetDataTop(0,N)) > 0 Then Temp = Temp & "," & GetDataTop(0,N)
	Next
	If Left(Temp,1) = "," Then Temp = Mid(Temp,2)
	If cStr(Temp) <> "" Then
		Set Rs = Con.ExeCute("select top " & Ubound(GetDataTop,2)+1 & " id,ChildNum,Title,FaceIcon,LastTime,Hits,Length,UserName,UserID,RootID,LastUser,NotReplay,GoodFlag,BoardID,TopicType,PollNum,TitleStyle,LastInfo,ndatetime,GoodAssort from LeadBBS_Topic where ID in(" & Temp & ")")
		GBL_DBNum = GBL_DBNum + 1
		If Not Rs.Eof Then
			GetDataTop = Rs.GetRows(-1)
			Rs.Close
			Set Rs = Nothing
			Application.Lock
			application(DEF_MasterCookies & "TopAnc" & TIDStr) = GetDataTop
			Application.UnLock
			Application.Lock
			application(DEF_MasterCookies & "TopAncList" & TIDStr) = "," & Temp & ","
			Application.UnLock
		Else
			Rs.Close
			Set Rs = Nothing
			Application.Lock
			application(DEF_MasterCookies & "TopAnc" & TIDStr) = "yes"
			Application.UnLock
		End If
	Else
		Application.Lock
		application(DEF_MasterCookies & "TopAnc" & TIDStr) = "yes"
		Application.UnLock
	End If

End Sub
%>