<%
class cls_main
	Public ScriptName, SqlQueryNum, savelog, system, ResLicence, ResType, ResLanguage, UserClass, strMsg, RefererPage
	Public adminName, adminPass, System_Sn, UserTrueIP
	Public Reloadtime, MaxCount, CacheName, Cache_Data, sPath
	Private LocalCacheName, CacheData, DelCount, ArrSetting
	Public MemberUserName, MemberUserID, MemberUserPassword, MemberUserClass, MemberVipType
	'类初始化
	Private Sub Class_Initialize()		
		savelog = 0 '设置为1的时候会记录攻击或错误错信息。
		SqlQueryNum = 0
		Dim Tmpstr, i
		Tmpstr = Request.ServerVariables("PATH_INFO")
		Tmpstr = Split(Tmpstr, "/")
		i = UBound(Tmpstr)
		ScriptName = LCase(Tmpstr(i))
		RefererPage = Request.ServerVariables("HTTP_REFERER")
		adminName = Session("adminName")
		adminPass = Session("adminPass")		
		
		Reloadtime = 14400
		CacheName = Replace(Replace(Replace(Server.MapPath("index.asp"), "index.asp", ""), ":", ""), "\", "")
		System_Sn = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"), Split(Request.ServerVariables("SCRIPT_NAME"), "/")(UBound(Split(Request.ServerVariables("SCRIPT_NAME"), "/"))), ""))
		UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
		UserTrueIP = checkStr(UserTrueIP)
		
		If SystemEdition = 3 Then
			sPath = "../"
		Else
			sPath = ""
		End If
		
		MemberUserName = checkStr(Request.Cookies(System_Sn)("MemberUserName"))
		MemberUserID = checkStr(Request.Cookies(System_Sn)("MemberUserID"))
		MemberUserPassword = checkStr(Request.Cookies(System_Sn)("MemberUserPassword"))
		MemberUserClass = checkStr(Request.Cookies(System_Sn)("MemberUserClass"))
		MemberVipType = checkStr(Request.Cookies(System_Sn)("MemberVipType"))
		
		
	End Sub
	
	 '类结束
	Private Sub Class_Terminate()
		If IsObject(Conn) Then 
		'Conn.Close
		Set Conn = Nothing
		End If
	End Sub
	
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName = LCase(vNewValue)
	End Property
	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName <> "" Then
			ReDim Cache_Data(2)
			Cache_Data(0) = vNewValue
			Cache_Data(1) = Now()
			Application.Lock
			Application(CacheName & "_" & LocalCacheName) = Cache_Data
			Application.UnLock
		Else
			Err.Raise vbObjectError + 1, "Ishion.Net CacheServer", " please change the CacheName."
		End If
	End Property
	Public Property Get Value()
		If LocalCacheName <> "" Then
			Cache_Data = Application(CacheName & "_" & LocalCacheName)
			If IsArray(Cache_Data) Then
				Value = Cache_Data(0)
			Else
				Err.Raise vbObjectError + 1, "Ishion.Net CacheServer", " The Cache_Data(" & LocalCacheName & ") Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "Ishion.Net CacheServer", " please change the CacheName."
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty = True
		Cache_Data = Application(CacheName & "_" & LocalCacheName)
		If Not IsArray(Cache_Data) Then Exit Function
		If Not IsDate(Cache_Data(1)) Then Exit Function
		If DateDiff("s", CDate(Cache_Data(1)), Now()) < (60 * Reloadtime) Then ObjIsEmpty = False
	End Function
	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove (CacheName & "_" & MyCaheName)
		Application.UnLock
	End Sub
	
	'加载系统配置信息
	Public Sub LoadSetting()
		Dim Rs
		'If Not IsObject(Conn) Then ConnectionDatabase
		Set Rs = Execute("Select Setting From ishion_Setting where isDefault=1")
		ArrSetting = Split(Rs("Setting"), "{$}")
		Set Rs = Nothing
		system = Split(ArrSetting(144), ",")
		ResLicence = Split(ArrSetting(141), ",")
		ResLanguage = Split(ArrSetting(142), ",")
		ResType = Split(ArrSetting(143), ",")
		UserClass = Split(ArrSetting(140), ",")
		Name = "StyleName"
		If ObjIsEmpty Then Call ReloadTemplates
	End Sub
	Public Function Setting(s)
		Setting = ArrSetting(s)
	End Function
	Public Sub ReloadTemplates()
		Dim Rs, i
		Set Rs = Execute("select top 1 * from ishion_Style where isDefault =1")
		If Not (Rs.EOF And Rs.BOF) Then
			For i = 2 To Rs.Fields.Count - 3
				Name = Rs(i).Name
				'Response.Write(Rs(i).Value)
				'response.end
				Value = Rs(i).Value
			Next
		End If
		Set Rs = Nothing
	End Sub
	
	Public Function ReadStylePage(Page)
		Name = Page
		If ObjIsEmpty Then Call ReloadTemplates
		Name = Page
		ReadStylePage = Value
	End Function
	
	'检查管理员权限
	'参数：sName(管理员用户名),sItem(权限项目)(sItem=0 只检查超管权限)
	'返回：True/False
	Public Function checkPermission(sName, sItem)
		checkPermission = False
		If sName = "" Or IsNull(sName) Then Exit Function
		Dim cRs
		Set cRs = Execute("select isAdmin,Permission,Password from ishion_SiteManager Where UserName='" & checkStr(sName) & "'")
		If Not (cRs.EOF And cRs.BOF) Then
			If adminPass = cRs(2) Then
				If cRs(0) Then checkPermission = True
				If sItem <> 0 Then
					If ItemInList(cRs(1), sItem) Then checkPermission = True
				End If
			End If
		End If
		Set cRs = Nothing
	End Function
	'
	'资源分类下载列表
	'参数：catalogID(被默认选择的分类ID)；tableName（数据库表名）
	'返回： 字符串 0=RootID;1=CatalogID;2=Depth;3=CatalogName
	Public Function GetCatalogSelect(catalogID, fromName)
		Dim tRs, s, i
		s = "    <option value="""">所有分类</option>" & vbCrLf
		Set tRs = Execute("select RootID,CatalogID,Depth,CatalogName from " & fromName & " order by rootid,orders")
		Do While Not tRs.EOF
			s = s & "   <option value=""" & tRs(0) & "," & tRs(1) & "," & tRs(2) & "," & tRs(3) & """ "
			If catalogID <> 0 Then
				If tRs(1) = catalogID Then s = s & "selected"
			End If
			s = s & ">"
			If tRs(2) = 1 Then s = s & "　├ "
			If tRs(2) > 1 Then
				For i = 2 To tRs(2)
					s = s & "　│"
				Next
				s = s & "　├ "
			End If
			s = s & tRs(3) & "</option>" & vbCrLf
		tRs.MoveNext
		Loop
		Set tRs = Nothing
		GetCatalogSelect = s
		s = Null
	End Function
	
	'相关下载资源
	'参数：Keys,cutNum
	'for 标准版 and 高级版
	Public Function MutualityDownRes(Keys, topNum, ID)
		Dim tRs, s
		If topNum = 0 Then
			Set tRs = Execute("Select ID,ResName,ResVer From ishion_Down_Resource where (ResName like '%" & Keys & "%') And ID<>" & ID & " and isAuditing=1 order by ID Desc")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer From ishion_Down_Resource where (ResName like '%" & Keys & "%') And ID<>" & ID & " and isAuditing=1 order by ID Desc")
		End If
		If tRs.EOF And tRs.BOF Then
			s = ""
		Else
			dim arrA,arrB,i
			i = 1
			Do While Not tRs.EOF
			If i = 1 then
				arrA = tRs(0)
				arrB = tRs(1) & " " & tRs(2)
			Else
				arrA = arrA & "###" & tRs(0)
				arrB = arrB & "$$$" & tRs(1) & " " & tRs(2)
			End If 
			i = i + 1
			tRs.MoveNext
			Loop
			s = arrA & "|||" & arrB
		End If
		Set tRs = Nothing
		MutualityDownRes = s
		s = Null
	End Function
	
	'相关文章资源
	'参数：Keys,cutNum
	'for 标准版 and 高级版
	Public Function MutualityCmsRes(Keys, topNum, ID)
		Dim tRs, s
		If topNum = 0 Then
			Set tRs = Execute("Select ID,Title From ishion_Cms_Resource where Title like '%" & Keys & "%' And ID<>" & ID & " and isAuditing=1 order by ID Desc")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,Title From ishion_Cms_Resource where Title like '%" & Keys & "%' And ID<>" & ID & " and isAuditing=1 order by ID Desc")
		End If
		If tRs.EOF And tRs.BOF Then
			s = ""
		Else
			dim arrA,arrB,i
			i = 1
			Do While Not tRs.EOF
			If i = 1 then
				arrA = tRs(0)
				arrB = tRs(1)
			Else
				arrA = arrA & "###" & tRs(0)
				arrB = arrB & "$$$" & tRs(1)
			End If 
			i = i + 1
			tRs.MoveNext
			Loop
			s = arrA & "|||" & arrB
		End If
		Set tRs = Nothing
		MutualityCmsRes = s
		s = Null
	End Function
	
	
	'相关下载资源
	'参数：Keys,cutNum
	'for 标准版 and 高级版
	Public Function showMutualityDownRes(strRes,cutNum)
		If IsNull(strRes) or strRes="" then
			showMutualityDownRes = ""
			Exit Function
		End If
		Dim i, s, arrA, arrB
		arrA = split(strRes,"|||")(0)
		arrB = split(strRes,"|||")(1)
		arrA = split(arrA,"###")
		arrB = split(arrB,"$$$")
		s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">"
		For i = 0 to Ubound(arrA)
			s = s & "<tr><td>·<a href=""" & sPath & Replace(Setting(77), "{$id}", arrA(i)) & """>" & cutStr(arrB(i), Int(cutNum)) & "</a></td></tr>"
		Next
		s = s & "</table>"
		showMutualityDownRes = s
		s = Null
	End Function
	
	'相关文章资源
	'参数：Keys,cutNum
	'for 标准版 and 高级版
	Public Function showMutualityCmsRes(strRes,cutNum)
		If IsNull(strRes) or strRes="" then
			showMutualityCmsRes = ""
			Exit Function
		End If
		Dim i, s, arrA, arrB
		arrA = split(strRes,"|||")(0)
		arrB = split(strRes,"|||")(1)
		arrA = split(arrA,"###")
		arrB = split(arrB,"$$$")
		s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">"
		For i = 0 to Ubound(arrA)
			s = s & "<tr><td>·<a href=""" & sPath & Replace(Setting(101), "{$id}", arrA(i)&"_1") & """>" & cutStr(arrB(i), Int(cutNum)) & "</a></td></tr>"
		Next
		s = s & "</table>"
		showMutualityCmsRes = s
		s = Null
	End Function
	
	Public Function showNews(topNum,cutNum1,cutNum2,isType)
		dim tRs,s,i
		if Int(isType) = 1 then
			Set tRs = Execute("select top "&topNum&" * from ishion_News where isType = 1 order By ID Desc")
		ElseIf Int(isType) = 2 then
			Set tRs = Execute("select top "&topNum&" * from ishion_News where isType = 2 order By ID Desc")
		Else
			Set tRs = Execute("select top "&topNum&" * from ishion_News order By ID Desc")
		End if
		If tRs.Eof and tRs.Bof then
			showNews = ""
		Else
			i = 1
			Do While Not tRs.EOF
				If i > 1 then s = s & "<br>"
				s = s & "·<a href=""ViewNews.asp?ID="&tRs("ID")&"&isType="&isType&""" target=""_blank"">"&cutStr(tRs("Title"),Int(cutNum1))&"</a>"
				if Int(cutNum2) > 0 then
					s = s & "<br>" & cutStr(tRs("Content"),Int(cutNum2))
				End If
				s = s &" "& FormatDateTime(tRs("DateAndTime"),2)				
				i = i + 1
			tRs.MoveNext
			Loop
		End If
		showNews = s
		s = Null
		Set tRs = Nothing
	End Function
	
	
	'资源列表分类导航
	'for 标准版 And 高级版
	Public Function catalog_nav(rootID, catalogID, depth, fromName)
		Dim s, tRs, i, FileName
		If rootID = 0 And catalogID = 0 Then
			Set tRs = Execute("select catalogID,catalogName,rootID,depth,Child,ResNum from " & fromName & " where depth=0 order by rootID")
		Else    '根分类 rootID>0
			Set tRs = Execute("select catalogID,catalogName,rootID,depth,Child,ResNum from " & fromName & " where rootID=" & rootID & " and depth>0 order by orders")
		End If
		If tRs.EOF And tRs.BOF Then
			s = "Sorry！没有找到相关的分类数据。"
		Else
			s = "<table width=""80%"" border=""0"" align=""center"">" & vbCrLf
			Do While Not tRs.EOF
			s = s & "<tr><td>"
			If tRs(3) > 1 Then
				For i = 2 To tRs(3)
					s = s & "　"
				Next
			End If
			If rootID = 0 Then
				s = s & "<img src=""" & sPath & "images/+.gif"" border=""0"" align=""absmiddle""> "
			ElseIf tRs(4) > 0 And rootID > 0 And catalogID > 0 Then
				s = s & "<img src=""" & sPath & "images/+.gif"" border=""0"" align=""absmiddle""> "
			Else
				s = s & "<img src=""" & sPath & "images/-.gif"" border=""0"" align=""absmiddle""> "
			End If
			If rootID = 0 Then
				If LCase(fromName) = "ishion_down_catalog" Then
					FileName = Setting(72)
				Else
					FileName = Setting(97)
				End If
				s = s & "<a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(2)), "{$pages}", "1") & """>" & tRs(1) & "</a> (<font color=red>" & tRs(5) & "</font>)"
			Else
				If LCase(fromName) = "ishion_down_catalog" Then
					FileName = Setting(73)
				Else
					FileName = Setting(98)
				End If
				s = s & "<a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(0)), "{$pages}", "1") & """>" & tRs(1) & "</a> (<font color=red>" & tRs(5) & "</font>)"
				If tRs(0) = catalogID Then s = s & "←"
			End If
			s = s & "</td></tr>"
			tRs.MoveNext
			Loop
			s = s & "</table>"
		End If
		Set tRs = Nothing
		catalog_nav = s
		s = Null
	End Function
	
	'当前位置 导航
	'for 标准版
	Public Function site_nav(catalogID, fromName, GetTitle, GetURL)
		Dim s, tRs, catalogName, ParentID, ParentStr, depth, rootID, FileName
	
		If LCase(fromName) = "ishion_down_catalog" Then
			s = s & "<a href=""" & sPath & Setting(70) & """>下载首页</a> "
		Else
			s = s & "<a href=""" & sPath & Setting(95) & """>首页</a> "
		End If
		If catalogID > 0 Then
			Set tRs = Execute("select catalogName,ParentID,ParentStr,depth,rootID from " & fromName & " where catalogID=" & catalogID)
			If Not (tRs.EOF And tRs.BOF) Then
				catalogName = tRs(0)
				ParentID = tRs(1)
				ParentStr = tRs(2)
				depth = tRs(3)
				rootID = tRs(4)
			End If
			Set tRs = Nothing
			If ParentID <> 0 Then
				Set tRs = Execute("select catalogID,catalogName,depth,rootID from " & fromName & " where catalogID in(" & ParentStr & ")")
				If Not (tRs.EOF And tRs.BOF) Then
					Do While Not tRs.EOF
						If tRs(2) > 0 Then
							If LCase(fromName) = "ishion_down_catalog" Then
								FileName = Setting(73)
							Else
								FileName = Setting(98)
							End If
							s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(0)), "{$pages}", "1") & """>" & tRs(1) & "</a>"
						Else
							If LCase(fromName) = "ishion_down_catalog" Then
								FileName = Setting(72)
							Else
								FileName = Setting(97)
							End If
							s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", tRs(3)), "{$pages}", "1") & """>" & tRs(1) & "</a>"
						End If
					tRs.MoveNext
					Loop
				End If
				Set tRs = Nothing
			End If
			If depth > 0 Then
				If LCase(fromName) = "ishion_down_catalog" Then
					FileName = Setting(73)
				Else
					FileName = Setting(98)
				End If
				s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", catalogID), "{$pages}", "1") & """>" & catalogName & "</a>"
			Else
				If LCase(fromName) = "ishion_down_catalog" Then
					FileName = Setting(72)
				Else
					FileName = Setting(97)
				End If
				s = s & " → <a href=""" & sPath & Replace(Replace(FileName, "{$id}", rootID), "{$pages}", "1") & """>" & catalogName & "</a>"
			End If
		End If
		
		If GetURL <> "" Then
			s = s & " → <a href=""" & GetURL & """>" & GetTitle & "</a>"
		Else
			s = s & " → " & GetTitle
		End If
		site_nav = s
		s = Null
	End Function
	
	'资源分类页
	'for 标准版 and 高级版
	Public Function showDownResCatalog()
		Dim s, Rs, sRs, i, x, y, brNum
		brNum = 6
		s = s & "<table width=""770""  border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">" & vbCrLf
		Set Rs = Execute("select catalogID,catalogName,rootID,depth from ishion_Down_catalog where Depth=0 order by rootID")
		i = 1
		If Not (Rs.EOF And Rs.BOF) Then
			Do While Not Rs.EOF
			s = s & "  <tr class=""tdbg" & i Mod 2 + 1 & """>" & vbCrLf
			s = s & "    <td width=""100"" align=""center""><a href=""" & sPath & Replace(Replace(Setting(72), "{$id}", Rs(2)), "{$pages}", "1") & """>" & Rs(1) & "</a> <a href=""xml/rss_Down_r" & Rs(2) & ".xml""><img src=""" & sPath & "images/rss.gif"" border=""0"" align=""absmiddle""></a></td>" & vbCrLf
			s = s & "    <td><table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""3"">" & vbCrLf
			s = s & "      <tr>" & vbCrLf
			Set sRs = Execute("select catalogID,catalogName,rootID,depth from ishion_Down_catalog where ParentID=" & Rs(0) & " order by orders")
			If Not (sRs.EOF And sRs.BOF) Then
				x = 1
				Do While Not sRs.EOF
				s = s & "        <td align=""center"" width=""12.5%""><a href=""" & sPath & Replace(Replace(Setting(73), "{$id}", sRs(0)), "{$pages}", "1") & """>" & sRs(1) & "</a> <a href=""xml/rss_Down_s" & sRs(0) & ".xml"" class=""f11"">(RSS)</a></td>" & vbCrLf
				If (x Mod brNum) = 0 Then s = s & "</tr><tr>" & vbCrLf
				x = x + 1
				sRs.MoveNext
				Loop
				If (x Mod brNum) > 0 Then
					For y = 0 To (brNum - (x Mod brNum))
					s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
					Next
				End If
				If x = brNum Then
					For y = 0 To (brNum - x)
					s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
					Next
				End If
			End If
			Set sRs = Nothing
			s = s & "      </tr>" & vbCrLf
			s = s & "    </table></td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
			i = i + 1
			Rs.MoveNext
			Loop
		End If
		Set Rs = Nothing
		s = s & "</table>"
		showDownResCatalog = s
		s = Null
	End Function
	
	'资源分类页
	'for 标准版 高级版
	Public Function showCmsResCatalog()
		Dim s, Rs, sRs, i, x, y, brNum
		brNum = 5
		s = s & "<table width=""770""  border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">" & vbCrLf
		Set Rs = Execute("select catalogID,catalogName,rootID,depth from ishion_Cms_catalog where Depth=0 order by rootID")
		i = 1
		If Not (Rs.EOF And Rs.BOF) Then
			Do While Not Rs.EOF
			s = s & "  <tr class=""tdbg" & i Mod 2 + 1 & """>" & vbCrLf
			s = s & "    <td width=""100"" align=""center""><a href=""" & sPath & Replace(Replace(Setting(97), "{$id}", Rs(2)),"{$pages}","1") & """>" & Rs(1) & "</a> <a href=""xml/rss_Cms_r" & Rs(2) & ".xml""><img src=""" & sPath & "images/rss.gif"" border=""0"" align=""absmiddle""></a></td>" & vbCrLf
			s = s & "    <td><table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""3"">" & vbCrLf
			s = s & "      <tr>" & vbCrLf
			Set sRs = Execute("select catalogID,catalogName,rootID,depth from ishion_Cms_catalog where ParentID=" & Rs(0) & " order by orders")
			If Not (sRs.EOF And sRs.BOF) Then
				x = 1
				Do While Not sRs.EOF
				s = s & "        <td align=""center"" width=""12.5%""><a href=""" & sPath & Replace(Replace(Setting(98), "{$id}", sRs(0)),"{$pages}","1") & """>" & sRs(1) & "</a> <a href=""xml/rss_Cms_s" & sRs(0) & ".xml"" class=""f11"">(RSS)</a></td>" & vbCrLf
				If (x Mod brNum) = 0 Then s = s & "</tr><tr>"
				x = x + 1
				sRs.MoveNext
				Loop
				If (x Mod brNum) > 0 Then
					For y = 0 To (brNum - (x Mod brNum))
					s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
					Next
				End If
				If x = brNum Then
					For y = 0 To (brNum - x)
					s = s & "<td align=""center"" width=""12.5%"">.</td>" & vbCrLf
					Next
				End If
			End If
			Set sRs = Nothing
			s = s & "      </tr>" & vbCrLf
			s = s & "    </table></td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
			i = i + 1
			Rs.MoveNext
			Loop
		End If
		Set Rs = Nothing
		s = s & "</table>"
		showCmsResCatalog = s
		s = Null
	End Function
	
	'for 标准版 and 高级版 首页
	Public Function showDownResAdv(strWhere, strOrder, topNum, cutNum, showDate, showDot, showHrline, showCatalogName)
		Dim tRs, s, i, strDot, strHits
		If InStr(LCase(strOrder), "hits") > 0 Then
			strHits = Replace(Replace(Replace(LCase(strOrder), "desc", ""), "asc", ""), " ", "")
		Else
			strHits = "HitsTotal"
		End If
		If (showDot = "" Or showDot = "0") Then
			strDot = "·"
		Else
			strDot = showDot
		End If
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,catalogID,catalogName," & strHits & ",UpdateTime From ishion_Down_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,catalogID,catalogName," & strHits & ",UpdateTime From ishion_Down_Resource where isAuditing=1 order by " & strOrder & ",ID ")
		End If
		s = "<table width=""99%"" border=""0"" cellspacing=""0"" cellpadding=""2"" align=""center"">" & vbCrLf
		If tRs.EOF And tRs.BOF Then
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>Sorry！没有查询到任何记录。</td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
		Else
			Do While Not tRs.EOF
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>" & strDot
			If showCatalogName Then '显示分类
				s = s & "[<a href=""" & Replace(Replace(Setting(73), "{$id}", tRs(3)), "{$pages}", "1") & """ target=""_blank"">" & tRs(4) & "</a>]"
			End If
			
			s = s & " <a href=""" & Replace(Setting(77), "{$id}", tRs(0)) & """ target=""_blank"" Title=""" & tRs(1) & " " & tRs(2) & """>" & cutStr(tRs(1) & " " & tRs(2), Int(cutNum)) & "</a> </td>"
			If showDate = "Hits" Then '显示时间还是人气
				s = s & "<td width=""30"">" & tRs(5) & "</td>" & vbCrLf
			Else
				s = s & "<td width=""30"">" & FormatMyDate(tRs(6), showDate) & "</td>" & vbCrLf
			End If
			s = s & "  </tr>" & vbCrLf
			
			If showHrline Then s = s & "<tr><td height=""1"" colspan=""2"" background=""images/bg_dot.gif""></td></tr>" & vbCrLf
			tRs.MoveNext
			Loop
		End If
		Set tRs = Nothing
		s = s & "</table>" & vbCrLf
		showDownResAdv = s
		s = Null
	End Function
	
	'for 标准版 and 高级版
	Public Function showDownRes(strWhere, strOrder, topNum, cutNum, showDot, showHrline)
		Dim tRs, s, i, strDot
		i = 1
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer From ishion_Down_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer From ishion_Down_Resource where isAuditing=1 order by " & strOrder & ",ID ")
		End If
		If tRs.EOF And tRs.BOF Then
			s = ""
		Else
			s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbCrLf
			Do While Not tRs.EOF
			'If (i>=19) Then	Exit Do
			If (showDot = "" Or showDot = "0") Then
				strDot = "" & Right("0" & i, 2) & "."
			Else
				strDot = showDot
			End If
			s = s & "  <tr><td><font color=red>" & strDot & "</font><a href=""" & sPath & Replace(Setting(77), "{$id}", tRs(0)) & """>" & cutStr(tRs(1) & " " & tRs(2), Int(cutNum)) & "</a></td></tr>" & vbCrLf
			If showHrline Then s = s & "<tr><td height=""1"" background=""" & sPath & "images/bg_dot.gif""></td></tr>" & vbCrLf
			i = i + 1
		    'response.write  i&"<br>"
			tRs.MoveNext
			Loop
			s = s & "</table>"
		End If
		Set tRs = Nothing
		showDownRes = s
		s = Null
	End Function
		
	'for 标准版 and 高级版  首页
	Public Function showCmsResAdv(strWhere, strOrder, topNum, cutNum, showDate, showDot, showHrline, showCatalogName)
		Dim tRs, s, i, strDot
	
		If (showDot = "" Or showDot = "0") Then
			strDot = "·"
		Else
			strDot = showDot
		End If
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,Title,catalogID,catalogName,Hits,DateAndTime From ishion_Cms_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,Title,catalogID,catalogName,Hits,DateAndTime From ishion_Cms_Resource where isAuditing=1 order by " & strOrder & ",ID ")
		End If
		s = "<table width=""99%"" border=""0"" cellspacing=""0"" cellpadding=""2"" align=""center"">" & vbCrLf
		If tRs.EOF And tRs.BOF Then
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>Sorry！没有查询到任何记录。</td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
		Else
			Do While Not tRs.EOF
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>" & strDot
			If showCatalogName Then '显示分类
				s = s & "[<a href=""" & Replace(Replace(Setting(98), "{$id}", tRs(2)),"{$pages}","1") & """ target=""_blank"">" & tRs(3) & "</a>]"
			End If
			
			s = s & " <a href=""" & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """ target=""_blank"" Title=""" & tRs(1) & """>" & cutStr(tRs(1), Int(cutNum)) & "</a> </td>"
			If showDate = "Hits" Then '显示时间还是人气
				s = s & "<td width=""30"">" & tRs(4) & "</td>" & vbCrLf
			Else
				s = s & "<td width=""30"">" & FormatMyDate(tRs(5), showDate) & "</td>" & vbCrLf
			End If
			s = s & "  </tr>" & vbCrLf
			
			If showHrline Then s = s & "<tr><td height=""1"" colspan=""2"" background=""images/bg_dot.gif""></td></tr>" & vbCrLf
			tRs.MoveNext
			Loop
		End If
		Set tRs = Nothing
		s = s & "</table>" & vbCrLf
		showCmsResAdv = s
		s = Null
	End Function
	'for 标准版 and 高级版
	Public Function showCmsRes(strWhere, strOrder, topNum, cutNum, showDot, showHrline)
		Dim tRs, s, i, strDot
		i = 1
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,Title From ishion_Cms_Resource where " & strWhere & " and isAuditing=1 order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,Title From ishion_Cms_Resource where isAuditing=1 order by " & strOrder & ",ID ")
		End If
		If tRs.EOF And tRs.BOF Then
			s = ""
		Else
			s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""1"">" & vbCrLf
			Do While Not tRs.EOF
			If (showDot = "" Or showDot = "0") Then
				strDot = "" & Right("0" & i, 2) & "."
			Else
				strDot = showDot
			End If
			s = s & "  <tr><td><font color=red> " & strDot & "</font><a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """>" & cutStr(tRs(1), Int(cutNum)) & "</a></td></tr>" & vbCrLf
			If showHrline Then s = s & "<tr><td height=""1"" background=""" & sPath & "images/bg_dot.gif""></td></tr>" & vbCrLf
			i = i + 1
			tRs.MoveNext
			Loop
			s = s & "</table>"
		End If
		Set tRs = Nothing
		showCmsRes = s
		s = Null
	End Function
	Public Function showDownResImages(strWhere, strOrder, topNum, cutNum, intWidth, intHeight, isWH)
		Dim tRs, s, i
		i = 1
		s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbCrLf
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,SmallImg From ishion_Down_Resource where " & strWhere & " and isAuditing=1 and SmallImg<>'' order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,ResName,ResVer,SmallImg From ishion_Down_Resource where isAuditing=1 and SmallImg<>'' order by " & strOrder & ",ID ")
		End If
		If tRs.EOF And tRs.BOF Then
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>Sorry！没有查询到任何记录。</td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
		Else
			If isWH = 1 Then s = s & "  </tr>" & vbCrLf
			Do While Not tRs.EOF
			If isWH = 2 Then s = s & "  <tr>" & vbCrLf
			s = s & "    <td  align=""center""><a href=""" & sPath & Replace(Setting(77), "{$id}", tRs(0)) & """ target=""_blank"" Title=""" & tRs(1) & " " & tRs(2) & """><img src=""" & sPath & tRs(3) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """></a>"
			s = s & "<br><a href=""" & sPath & Replace(Setting(77), "{$id}", tRs(0)) & """ target=""_blank"">" & cutStr(tRs(1) & " " & tRs(2), Int(cutNum)) & "</a></td>" & vbCrLf
			If isWH = 2 Then s = s & "  </tr>" & vbCrLf
			tRs.MoveNext
			Loop
		End If
		Set tRs = Nothing
		If isWH = 1 Then s = s & "  </tr>" & vbCrLf
		s = s & "</table>" & vbCrLf
		showDownResImages = s
		s = Null
	End Function
	Public Function showCmsResImages(strWhere, strOrder, topNum, cutNum, intWidth, intHeight, isWH)
		Dim tRs, s, i
		i = 1
		s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbCrLf
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg From ishion_Cms_Resource where " & strWhere & " and isAuditing=1 and SmallImg<>'' order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg From ishion_Cms_Resource where isAuditing=1 and SmallImg<>'' order by " & strOrder & ",ID ")
		End If
		If tRs.EOF And tRs.BOF Then
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>Sorry！没有查询到任何记录。</td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
		Else
			If isWH = 1 Then s = s & "  </tr>" & vbCrLf
			Do While Not tRs.EOF
			If isWH = 2 Then s = s & "  <tr>" & vbCrLf
			s = s & "    <td  align=""center""><a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """ target=""_blank"" Title=""" & tRs(1) & """><img src=""" & sPath & tRs(2) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """></a>"
			s = s & "<br><a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """>" & cutStr(tRs(1), Int(cutNum)) & "</a></td>" & vbCrLf
			If isWH = 2 Then s = s & "  </tr>" & vbCrLf
			tRs.MoveNext
			Loop
		End If
		Set tRs = Nothing
		If isWH = 1 Then s = s & "  </tr>" & vbCrLf
		s = s & "</table>" & vbCrLf
		showCmsResImages = s
		s = Null
	End Function
	
	Public Function showCmsResExcerptImages(strWhere, strOrder, topNum, cutNum1, cutNum2, intWidth, intHeight, isWH)
		Dim tRs, s, i
		i = 1
		s = "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""3"">" & vbCrLf
		If strWhere <> "" Then
			Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg,Excerpt From ishion_Cms_Resource where " & strWhere & " and isAuditing=1 and SmallImg<>'' order by " & strOrder & ",ID ")
		Else
			Set tRs = Execute("Select top " & topNum & " ID,Title,SmallImg,Excerpt From ishion_Cms_Resource where isAuditing=1 and SmallImg<>'' order by " & strOrder & ",ID ")
		End If
		If tRs.EOF And tRs.BOF Then
			s = s & "  <tr>" & vbCrLf
			s = s & "    <td>Sorry！没有查询到任何记录。</td>" & vbCrLf
			s = s & "  </tr>" & vbCrLf
		Else
			If isWH = 1 Then s = s & "  </tr>" & vbCrLf
			Do While Not tRs.EOF
			If isWH = 2 Then s = s & "  <tr>" & vbCrLf
			s = s & "    <td><img src=""" & sPath & tRs(2) & """ border=0 width=""" & intWidth & """ height=""" & intHeight & """ align=""left"">"
			s = s & "<a href=""" & sPath & Replace(Setting(101), "{$id}", tRs(0)& "_1") & """>" & cutStr(tRs(1), Int(cutNum1)) & "</a>"
			If Int(cutNum2) > 0 then s = s & "<br>"&cutStr(tRs(3),Int(cutNum2))
			s = s & "</td>" & vbCrLf
			If isWH = 2 Then s = s & "  </tr>" & vbCrLf
			tRs.MoveNext
			Loop
		End If
		Set tRs = Nothing
		If isWH = 1 Then s = s & "  </tr>" & vbCrLf
		s = s & "</table>" & vbCrLf
		showCmsResExcerptImages = s
		s = Null
	End Function

	'//截取指定长度字符串
	'//返回类型：字符串
	Public Function cutStr(str, strlen)
		If str="" or isnull(str) then Exit Function
		Dim l, t, c, i
		l = Len(str)
		t = 0
		For i = 1 To l
		c = Abs(Asc(Mid(str, i, 1)))
		If c > 255 Then
			t = t + 2
		Else
			t = t + 1
		End If
		If t >= strlen Then
			cutStr = Left(str, i) & ".."
			Exit For
		Else
			cutStr = str
		End If
		Next
		cutStr = Replace(cutStr, Chr(10), "")
	End Function
	Public Sub SystemMsg()
		Response.Write "<TABLE width=""75%"" align=""center"">" & vbCrLf
		Response.Write "  <TR>" & vbCrLf
		Response.Write "    <TD>" & vbCrLf
		Response.Write "<DIV class=ContainerSection>" & vbCrLf
		Response.Write "    <DIV class=ContainerTopBorder>" & vbCrLf
		Response.Write "        <DIV class=ContainerTop></DIV>" & vbCrLf
		Response.Write "    </DIV>" & vbCrLf
		Response.Write "    <DIV class=ContainerContent>　System Message:</DIV>      " & vbCrLf
		Response.Write "    <DIV><br>　<B>" & strMsg & "</B><BR><BR>" & vbCrLf
		Response.Write "        <DIV class=ContainerContent align=""center""><a href=""" & RefererPage & """><<返回上一页</a>" & vbCrLf
		Response.Write "        </DIV> " & vbCrLf
		Response.Write "    </DIV>" & vbCrLf
		Response.Write "    <DIV class=BottomWrapper>" & vbCrLf
		Response.Write "        <DIV class=ContainerBottomBorder>" & vbCrLf
		Response.Write "            <DIV class=ContainerBottom></DIV>" & vbCrLf
		Response.Write "        </DIV>" & vbCrLf
		Response.Write "    </DIV>" & vbCrLf
		Response.Write "</DIV>" & vbCrLf
		Response.Write "    </TD>" & vbCrLf
		Response.Write "  </TR>" & vbCrLf
		Response.Write "</TABLE>" & vbCrLf
	End Sub
	Public Function CopyRight()	
		Dim reval
		reval = reval & "Powered By <a href=""http://www.hldown.com"" title=""Powered By hldown.com"">宏亮软件园下载系统</a>"
		CopyRight = reval
		reval = Null	
	End Function
	Public Function HtmlHead()
		Dim reval
		reval = reval & "<!--Published Date:" & Now() & "   Powered by www.hldown.com-->" & vbCrLf
		reval = reval & "<!--" & vbCrLf
		reval = reval & "┌──────────────────────────── HLdown─┐" & vbCrLf
		reval = reval & "│宏亮软件园下载系统 -- http://www.hldown.com http://www.hldown.cn │" & vbCrLf
		reval = reval & "│                                                                 │" & vbCrLf
		reval = reval & "│                                                                 │" & vbCrLf
		reval = reval & "│　　程序问题请联系 QQ：75755127  邮箱:hongliang-gd@21cn.com      │" & vbCrLf
		reval = reval & "└────────────────────────────.COM─-─┘" & vbCrLf
		reval = reval & "-->" & vbCrLf
		HtmlHead = reval
		reval = Null
	End Function
	Public Function DMSVer()
		If IsSqlDataBase = 1 Then
			DMSVer = "宏亮软件园下载系统 SQL版"
		Else
			DMSVer = "宏亮软件园下载系统 Access版"
		End If
	End Function
	Public Function F469e80d32(tr)
		If Request.ServerVariables("SERVER_NAME")="127.0.0.1" then
			F469e80d32 = "1"
			Exit Function
		End If
		F469e80d32 = "0"
		Dim tRs,tempStr, RegCode
		tempStr = Request.ServerVariables("SERVER_NAME") & "C0559f8d32"
		
		RegCode = MD5(tempStr, 16)
		Set tRs = Execute("select * from ishion_Key where RegType = " & tr)
		If Not (tRs.EOF And tRs.BOF) Then
			If tRs("RegCode") <> RegCode Then
				F469e80d32 = "1"   '2
			ElseIf tRs("RegKey") <> MD5(RegCode & tr & "F469e80d32", 32) Then
				F469e80d32 = "1"    '0
			ElseIf tRs("RegCode") = RegCode And tRs("RegKey") = MD5(RegCode & tr & "F469e80d32", 32) Then
				F469e80d32 = "1"
			End If
		End If
		Set tRs = Nothing
	End Function
	Public Function C0559f8d32(tr)
		C0559f8d32 = 0
	End Function
	Public Function F469e88d32(tr)
		F469e88d32 = 0
	End Function
	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase
		'检查权限,防止注入攻击。
		'If InStr(LCase(Command),"ishion_SiteManager")>0 And Left(ScriptName,6)<> "ishion_SiteManager" Then
			'If savelog=1 Then
				'Response.Write SaveSQLLOG(Command,"")
			'End If
			'Command=Replace(LCase(Command),"ishion_SiteManager","ishion<i>"&Chr(95)&"</i>SiteManager")
		'End If
		
		If IsDeBug = 0 Then
			On Error Resume Next
			Set Execute = Conn.Execute(Command)
			If Err Then
				Err.Clear
				Set Conn = Nothing
				If savelog = 1 Then
					Response.Write SaveSQLLOG(Command, "查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为：""Const IsDeBug = 1""")
				Else
					Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
				End If
				Response.End
			End If
		Else
			'Response.Write Command & "<br>"
			'Response.end
			Set Execute = Conn.Execute(Command)
		End If
		SqlQueryNum = SqlQueryNum + 1
	End Function
	'---------------------------------------------------------------------
	'时间格式化
	'参数：时间，格式模板
	'返回：格式化后的字符串
	'备注：格式化关键词详解：
	'   "{Y}" : 4位年
	'   "{y}" : 2位年
	'   "{M}" : 不补位的月
	'   "{m}" : 补位的月,如03,01
	'   "{D}" : 不补位的日
	'   "{d}" : 补位的日
	'   "{H}" : 不补位的小时
	'   "{h}" : 补位的小时
	'   "{MI}": 不补位的分钟
	'   "{mi}": 补位的分钟
	'   "{S}" : 不补位的秒
	'   "{s}" : 补位的秒
	'---------------------------------------------------------------------
	Public Function FormatMyDate(myDate, Template)
		If Not IsDate(myDate) Or Template = "" Then
			FormatMyDate = ""
			Exit Function
		End If
	
		Dim mYear, mMonth, mDay, mHour, mMin, mSec
			mYear = Year(myDate)
			mMonth = Month(myDate)
			mDay = Day(myDate)
			mHour = Hour(myDate)
			mMin = Minute(myDate)
			mSec = Second(myDate)
		FormatMyDate = Template
		FormatMyDate = Replace(FormatMyDate, "{Y}", Year(myDate))
		FormatMyDate = Replace(FormatMyDate, "{y}", Right(Year(myDate), 2))
		FormatMyDate = Replace(FormatMyDate, "{M}", Month(myDate))
		FormatMyDate = Replace(FormatMyDate, "{m}", Right("00" & Month(myDate), 2))
		FormatMyDate = Replace(FormatMyDate, "{D}", Day(myDate))
		FormatMyDate = Replace(FormatMyDate, "{d}", Right("00" & Day(myDate), 2))
		FormatMyDate = Replace(FormatMyDate, "{H}", Hour(myDate))
		FormatMyDate = Replace(FormatMyDate, "{h}", Right("00" & Hour(myDate), 2))
		FormatMyDate = Replace(FormatMyDate, "{MI}", Minute(myDate))
		FormatMyDate = Replace(FormatMyDate, "{mi}", Right("00" & Minute(myDate), 2))
		FormatMyDate = Replace(FormatMyDate, "{S}", Second(myDate))
		FormatMyDate = Replace(FormatMyDate, "{s}", Right("00" & Second(myDate), 2))
		If FormatDateTime(myDate, 1) = FormatDateTime(Date, 1) Then
			FormatMyDate = "<font color=red>" & FormatMyDate & "</font>"
		End If
		'Template = Null
	End Function
	Rem 判断发言是否来自外部
	Public Function ChkPost()
		Dim server_v1, server_v2
		ChkPost = False
		server_v1 = CStr(Request.ServerVariables("HTTP_REFERER"))
		server_v2 = CStr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1, 8, Len(server_v2)) <> server_v2 Then
			ChkPost = False
		Else
			ChkPost = True
		End If
	End Function
	'过滤SQL非法字符
	Public Function checkStr(str)
		If IsNull(str) Then
			checkStr = ""
			Exit Function
		End If
		str = Replace(str, Chr(0), "")
		checkStr = Replace(str, "'", "''")
	End Function
	'显示验证码
	Public Function GetCode()
		Dim test
		On Error Resume Next
		'Set test = Server.CreateObject("Adodb.Stream")
		'Set test = Nothing
		If Err Then
			Dim zNum
			Randomize Timer
			zNum = CInt(8999 * Rnd + 1000)
			Session("GetCode") = zNum
			GetCode = "<input type=""text"" name=""codestr"" maxlength=""4"" size=""4"">&nbsp;" & Session("GetCode")
		Else
			GetCode = "<input type=""text"" name=""codestr"" maxlength=""4"" size=""4"">&nbsp;<img src=""getcode.asp"">"
		End If
	End Function
	'检查验证码是否正确
	Public Function CodeIsTrue()
		Dim CodeStr
		CodeStr = Trim(Request("CodeStr"))
		If CStr(Session("GetCode")) = CStr(CodeStr) And CodeStr <> "" Then
			CodeIsTrue = True
			Session("GetCode") = Empty
		Else
			CodeIsTrue = False
			Session("GetCode") = Empty
		End If
	End Function
	'系统分配随机密码
	Public Function Createpass()
		Dim Ran, i, LengthNum
		LengthNum = 16
		Createpass = ""
		For i = 1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			If Ran = 0 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass = Createpass & UCase(Chr(Ran))
			ElseIf Ran = 1 Then
				Ran = CInt(Rnd * 9)
				Createpass = Createpass & Ran
			ElseIf Ran = 2 Then
				Ran = CInt(Rnd * 25) + 97
				Createpass = Createpass & Chr(Ran)
			End If
		Next
	End Function
	'//从Html标签中取出文本内容
	Public Function GetTextFromHtml(strHtml)
		strHtml = Replace(Replace(Replace(Replace(strHtml, "<br>", vbCrLf), "<BR>", vbCrLf), "</p>", vbCrLf & vbCrLf), "</P>", vbCrLf & vbCrLf)
		Dim strPatrn
			strPatrn = "<.*?>"
		Dim regEx
		Set regEx = New RegExp
		regEx.Pattern = strPatrn
		regEx.IgnoreCase = True
		regEx.Global = True
		GetTextFromHtml = regEx.Replace(strHtml, "")
		Set regEx = Nothing
	End Function
	
	'//检测Email
	'//返回:True/False
	Public Function CheckEmail(strng)
		CheckEmail = False
		Dim regEx, Match
		Set regEx = New RegExp
		regEx.Pattern = "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
		regEx.IgnoreCase = True
		Set Match = regEx.Execute(strng)
		If Match.Count Then CheckEmail = True
		Set Match = Nothing
		Set regEx = Nothing
	End Function
	
	'//字符串是否在[0-9]&[a-z]及下划线中（不区分大小写）
	'//返回:True/False
	Public Function IsChar26AndInt(str)
		IsChar26AndInt = True
		Dim regEx, Match
		Set regEx = New RegExp
			regEx.Pattern = "[\W]{1,}?"
			regEx.IgnoreCase = True
		Set Match = regEx.Execute(str)
		If Match.Count >= 1 Then
			IsChar26AndInt = False
		End If
		Set Match = Nothing
		Set regEx = Nothing
	End Function
	
	'//字符串是否在[a-z]中（不区分大小写）
	'//返回:True/False
	Public Function IsChar26(str)
		IsChar26 = True
		Dim regEx, Match
		Set regEx = New RegExp
			regEx.Pattern = "[^a-zA-Z]{1,}?"
			regEx.IgnoreCase = True
		Set Match = regEx.Execute(str)
		If Match.Count >= 1 Then
			IsChar26 = False
		End If
		Set Match = Nothing
		Set regEx = Nothing
	End Function
	
	'//字符串是否在[0-9]中（不区分大小写）
	Public Function IsIntChar(str)
		IsIntChar = True
		Dim regEx, Match
		Set regEx = New RegExp
			regEx.Pattern = "\D{1,}?"
			regEx.IgnoreCase = True
		Set Match = regEx.Execute(str)
		If Match.Count >= 1 Then
			IsIntChar = False
		End If
		Set Match = Nothing
		Set regEx = Nothing
	End Function
	
	'//Html字符串转Js字符串
	Public Function HTMLToJS(strHtml)
		If Trim(strHtml) = "" Then
			HTMLToJS = ""
			Exit Function
		End If
		strHtml = Replace(strHtml, "\", "\\")
		strHtml = Replace(strHtml, """", "\""")
		strHtml = Replace(strHtml, vbCrLf, "")
		HTMLToJS = strHtml
	End Function
	
	'//转换Html关键标签为Html特殊字符串
	Public Function HTMLEncode(str)
		If Not IsNull(str) Then
			str = Replace(str, Chr(13), "")
			str = Replace(str, Chr(10) & Chr(10), "<P></P>")
			str = Replace(str, Chr(10), "<BR>")
			str = Replace(str, ">", "&gt;")
			str = Replace(str, "<", "&lt;")
			str = Replace(str, "&", "&amp;")
			str = Replace(str, " ", "&nbsp;")
			str = Replace(str, """", "&quot;")
			HTMLEncode = str
			str = Null
		End If
	End Function
	Public Function HTMLEncode1(str)
		If Not IsNull(str) Then
			str = Replace(str, Chr(32) & Chr(32) & Chr(32), "　 ")
			str = Replace(str, Chr(13), "")
			str = Replace(str, Chr(10) & Chr(10), "<br>")
			str = Replace(str, Chr(10), "<br>")
			HTMLEncode1 = str
			str = Null
		End If
	End Function
	Function HTMLToData(str)
		If IsNull(str) Then
			HTMLToData = ""
			Exit Function
		End If
		str = Replace(str, "&", "&amp;")
		str = Replace(str, Chr(13), "&#013;") '回车符
		str = Replace(str, Chr(10), "&#010;") '换行符
		str = Replace(str, Chr(9), "&#009;") '制表符
		str = Replace(str, "'", "&apos;") '单引号
		str = Replace(str, """", "&quot;") '双引号
		str = Replace(str, "<", "&lt;")
		str = Replace(str, ">", "&gt;")
		HTMLToData = str
		str = Null
	End Function
	'//转换Html关键标签为Html特殊字符串(不转换硬回车及软回车符)
	Public Function HTMLEncode2(str)
		If Not IsNull(str) Then
			str = Replace(str, ">", "&gt;")
			str = Replace(str, "<", "&lt;")
			'str = replace(str, "&",    "&amp;")
			'str = replace(str, " ",    "&nbsp;")
			'str = replace(str, """", "&quot;")
			HTMLEncode2 = str
			str = Null
		End If
	End Function
	
	'//函数：字符串替换
	'//参数：正则表达式,被替换字符串,替换字符串
	Public Function ReplaceTest(patrn, mStr, replStr)
		Dim regEx
		Set regEx = New RegExp
		regEx.Pattern = patrn
		regEx.IgnoreCase = True
		regEx.Global = True
		ReplaceTest = regEx.Replace(mStr, replStr)
		Set regEx = Nothing
	End Function
	
	'//函数：字符串查找
	'//参数：正则表达式,被替换字符串,替换字符串
	'//返回：Bool(True:找到)
	Public Function FindText(patrn, mStr)
		Dim regEx
		Set regEx = New RegExp
		regEx.Pattern = patrn
		regEx.IgnoreCase = True
		regEx.Global = True
		FindText = regEx.test(mStr)
		Set regEx = Nothing
	End Function
	
	'//检测是否含有禁止字符串
	'//参数:被检测字符串,禁止字符列表(以,号隔开)
	'//返回:True(含有违禁字符)/False
	'//例：myCharClass.BadWord("你他妈的王八蛋，Fuck You","fuck you,王八蛋,you are pig")
	Public Function BadWord(str, BadWordList)
		BadWord = False
		Dim arrBadWord
			arrBadWord = Split(BadWordList, ",", -1, 1)
		Dim regEx
		Set regEx = New RegExp
		regEx.IgnoreCase = True         '不区分大小写
		regEx.Global = True
		Dim Match
		Dim i
		For i = 0 To UBound(arrBadWord)
			Response.Write arrBadWord(i) & "<br>"
			If arrBadWord(i) <> "" Then
				regEx.Pattern = arrBadWord(i)
				Set Match = regEx.Execute(str)
				If Match.Count Then
					BadWord = True
					Exit For
				End If
			End If
		Next
	End Function
	
	'关键字着色
	Public Function KeywordColor(str, Keyword)
		KeywordColor = ReplaceTest(Keyword, str, "<font color=red>" & Keyword & "</font>")
	End Function
	
	'获取字符中首字字符
	'返回：A-Z ;123 ; ###
	Public Function GetSpellChar(str)
		Dim tmp
		GetSpellChar = "@"
		tmp = 65536 + Asc(str)
		If (tmp >= 45217 And tmp <= 45252) Or (tmp = 65601) Or (tmp = 65633) Or (tmp = 37083) Then
			GetSpellChar = "A1"
		ElseIf (tmp >= 45253 And tmp <= 45760) Or (tmp = 65602) Or (tmp = 65634) Or (tmp = 39658) Then
			GetSpellChar = "B1"
		ElseIf (tmp >= 45761 And tmp <= 46317) Or (tmp = 65603) Or (tmp = 65635) Or (tmp = 33405) Then
			GetSpellChar = "C1"
		ElseIf (tmp >= 46318 And tmp <= 46930) Or (tmp = 61884) Or (tmp = 63468) Or (tmp = 65604) Or (tmp >= 36820 And tmp <= 38524) Or (tmp = 65636) Then
			GetSpellChar = "D1"
		ElseIf (tmp >= 46931 And tmp <= 47009) Or (tmp >= 46827 And tmp <= 46842) Or (tmp = 65605) Or (tmp = 65637) Or (tmp = 61513) Then '46827 46833 46842
			GetSpellChar = "E1"
		ElseIf (tmp >= 47010 And tmp <= 47296) Or (tmp = 65606) Or (tmp = 65638) Or (tmp = 61320) Or (tmp = 63568) Or (tmp = 36281) Then
			GetSpellChar = "F1"
		ElseIf (tmp >= 47297 And tmp <= 47613) Or (tmp = 65607) Or (tmp = 65639) Or (tmp = 35949) Or (tmp = 36089) Or (tmp = 36694) Or (tmp = 34808) Then
			GetSpellChar = "G1"
		ElseIf (tmp >= 47614 And tmp <= 48118) Or (tmp = 59112) Or (tmp = 40296) Or (tmp = 65608) Or (tmp = 65640) Then
			GetSpellChar = "H1"
		ElseIf (tmp = 65641) Or (tmp = 65609) Or (tmp = 65641) Then
			GetSpellChar = "I1"
		ElseIf (tmp >= 48119 And tmp <= 49061 And tmp <> 48739) Or (tmp >= 62430 And tmp <= 62430) Or (tmp = 65610) Or (tmp = 65642) Or (tmp = 39048) Then
			GetSpellChar = "J1"
		ElseIf (tmp >= 49062 And tmp <= 49323) Or (tmp = 65611) Or (tmp = 65643) Then
			GetSpellChar = "K1"
		ElseIf (tmp >= 49324 And tmp <= 49895) Or (tmp >= 58838 And tmp <= 58838) Or (tmp = 65612) Or (tmp = 65644) Or (tmp = 62418) Or (tmp = 48739) Then
			GetSpellChar = "L1"
		ElseIf (tmp >= 49896 And tmp <= 50370) Or (tmp = 63432) Or (tmp = 65613) Or (tmp = 65645) Then
			GetSpellChar = "M1"
		ElseIf (tmp >= 50371 And tmp <= 50613) Or (tmp = 65614) Or (tmp = 65646) Then
			GetSpellChar = "N1"
		ElseIf (tmp >= 50614 And tmp <= 50621) Or (tmp = 65615) Or (tmp = 65615) Or (tmp = 65647) Then
			GetSpellChar = "O1"
		ElseIf (tmp >= 50622 And tmp <= 50905) Or (tmp = 65616) Or (tmp = 65648) Then
			GetSpellChar = "P1"
		ElseIf (tmp >= 50906 And tmp <= 51386) Or (tmp >= 62659 And tmp <= 63172) Or (tmp = 63464) Or (tmp = 63226) Or (tmp = 65617) Or (tmp = 65649) Then
			GetSpellChar = "Q1"
		ElseIf (tmp >= 51387 And tmp <= 51445) Or (tmp = 65618) Or (tmp = 65650) Then
			GetSpellChar = "R1"
		ElseIf (tmp >= 51446 And tmp <= 52217) Or (tmp = 65619) Or (tmp = 65651) Or (tmp = 34009) Then
			GetSpellChar = "S1"
		ElseIf (tmp >= 52218 And tmp <= 52697) Or (tmp = 65620) Or (tmp = 65652) Then
			GetSpellChar = "T1"
		ElseIf (tmp = 65621) Or (tmp = 65653) Then
			GetSpellChar = "U1"
		ElseIf (tmp = 65622) Or (tmp = 65654) Then
			GetSpellChar = "V1"
		ElseIf (tmp >= 52698 And tmp <= 52979) Or (tmp = 65623) Or (tmp = 65655) Then
			GetSpellChar = "W1"
		ElseIf (tmp >= 52980 And tmp <= 53688) Or (tmp = 63182) Or (tmp = 65624) Or (tmp = 65656) Then
			GetSpellChar = "X1"
		ElseIf (tmp >= 53689 And tmp <= 54480) Or (tmp = 65625) Or (tmp = 65657) Then
			GetSpellChar = "Y1"
		ElseIf (tmp >= 54481 And tmp <= 62383 And tmp <> 59112 And tmp <> 58838 And tmp <> 57566) Or (tmp = 65626) Or (tmp = 65658) Or (tmp = 38395) Or (tmp = 39783) Then
			GetSpellChar = "Z1"
		End If
		If (tmp >= 65601 And tmp <= 65658) Then GetSpellChar = UCase(Left(Trim(str), 1)) '字母
		If (tmp >= 65584 And tmp <= 65593) Then GetSpellChar = "123" '数字
		'Response.Write(tmp)
	End Function
	
	'---------------------------------------------------------------------
	'函数：扫描元素mItem是否在元素列表strItemList中
	'参数：stritemList(被扫描元素列表，各元素以逗号隔开),mItem(欲匹配元素)
	'返回：True(找到)/False
	'例：ItemInList("1","1,2,3") = True
	'----------------------------------------------------------------------
	Public Function ItemInList(strItemList, mItem)
		ItemInList = False
		If IsNull(strItemList) Or IsNull(mItem = "") Then Exit Function
		strItemList = Replace(strItemList, " ", "")
		If InStr("," & strItemList & ",", "," & mItem & ",") >= 1 Then
			ItemInList = True
		End If
	End Function
	'处理逻辑表达式的转化问题
	Public Function translate(sourceStr, fieldStr)
		Dim sourceList
		Dim resultStr
		Dim i, j
		If InStr(sourceStr, " ") > 0 Then
			Dim isOperator
			isOperator = True
			sourceList = Split(sourceStr)
			'--------------------------------------------------------
			' Response.Write "num:" & cstr(ubound(sourceList)) & "<br>"
			For i = 0 To UBound(sourceList)
				' Response.Write i
				Select Case UCase(sourceList(i))
				Case "AND", "&", "和", "与"
					resultStr = resultStr & " and "
					isOperator = True
				Case "OR", "|", "或"
					resultStr = resultStr & " or "
					isOperator = True
				Case "NOT", "!", "非", "！", "！"
					resultStr = resultStr & " not "
					isOperator = True
				Case "(", "（", "（"
					resultStr = resultStr & " ( "
					isOperator = True
				Case ")", "）", "）"
					resultStr = resultStr & " ) "
					isOperator = True
				Case Else
					If sourceList(i) <> "" Then
						If Not isOperator Then resultStr = resultStr & " and "
						If InStr(sourceList(i), "%") > 0 Then
							resultStr = resultStr & " " & fieldStr & " like '" & Replace(sourceList(i), "'", "''") & "' "
						Else
							resultStr = resultStr & " " & fieldStr & " like '%" & Replace(sourceList(i), "'", "''") & "%' "
						End If
						isOperator = False
					End If
				End Select
				' Response.write resultStr+"<br>"
			Next
			translate = resultStr
		Else '单条件
			If InStr(sourceStr, "%") > 0 Then
				translate = " " & fieldStr & " like '" & Replace(sourceStr, "'", "''") & "' "
			Else
				translate = " " & fieldStr & " like '%" & Replace(sourceStr, "'", "''") & "%' "
			End If
			' 前后各加一个空格，免得连sql时忘了加，而出错。
		End If
	End Function
	
	Public Function CheckIDCard(sStr, ByVal dDate, ByVal nSex)
		CheckIDCard = False
		If IsNull(sStr) Or sStr = "" Then Exit Function
		If Not IsDate(dDate) Or dDate = "" Then Exit Function
		If Not IsNumeric(nSex) Or nSex = "" Then Exit Function
	
		Dim oRE, sDate
	
		Set oRE = New RegExp
		oRE.IgnoreCase = True
		oRE.Global = True
		nSex = CInt(nSex Mod 2)
		sDate = Year(dDate) & DblNum(Month(dDate)) & DblNum(Day(dDate))
	
		Select Case Len(sStr)
		Case 8
			If DateDiff("yyyy", dDate, Date) < 19 Then Exit Function
			oRE.Pattern = "^[\d]{8}$"
			If Not oRE.test(sStr) Then Exit Function
			If sStr <> sDate Then Exit Function
		Case 15
			oRE.Pattern = "^[\d]{15}$"
			If Not oRE.test(sStr) Then Exit Function
			If Mid(sStr, 7, 6) <> Right(sDate, 6) Then Exit Function
			If CInt(Mid(sStr, 14, 1)) Mod 2 <> nSex Then Exit Function
		Case 18
			oRE.Pattern = "^(?:[\d]{18}|[\d]{17}X)$"
			If Not oRE.test(sStr) Then Exit Function
			If Mid(sStr, 7, 8) <> sDate Then Exit Function
			If CInt(Mid(sStr, 17, 1)) Mod 2 <> nSex Then Exit Function
			Dim nN, aW, ac, nL
			nN = 0
			aW = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)
			ac = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
			For nL = 1 To 17
				nN = nN + CInt(Mid(sStr, nL, 1)) * aW(nL - 1)
			Next
			If UCase(Right(sStr, 1)) <> ac(nN Mod 11) Then Exit Function
		Case Else
			Exit Function
		End Select
	
		Set oRE = Nothing
	
		CheckIDCard = True
	End Function
	Private Function DblNum(nNum)
		DblNum = nNum
		If DblNum < 10 Then DblNum = "0" & DblNum
	End Function
	'记录查询错误事件
	Public Function SaveSQLLOG(sCommand, message)
		Dim Log_ConnStr, Log_Conn, ldb, sql, Rs
		ldb = "data/SQL_LOG.mdb"
		Log_ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
		Set Log_Conn = Server.CreateObject("ADODB.Connection")
		Log_Conn.open Log_ConnStr
		Set Rs = Server.CreateObject("adodb.recordset")
		sql = "select * from ishion_sql_log"
		Rs.open sql, Log_Conn, 1, 3
		Rs.AddNew
		Rs("ScriptName") = ScriptName
		Rs("S_Info") = Left(sCommand, 255)
		Rs("ip") = UserTrueIP
		Rs.Update
		Rs.Close
		Set Rs = Nothing
		Log_Conn.Execute (sql)
		Log_Conn.Close
		Set Log_Conn = Nothing
		SaveSQLLOG = message
	End Function
	
	'IP/来源
	Public Function address(sip)
		Dim aConnStr, aConn, adb
		Dim str1, str2, str3, str4
		Dim num
		Dim country, city
		Dim irs, sql
		If IsNumeric(Left(sip, 2)) Then
			If sip = "127.0.0.1" Then sip = "192.168.0.1"
			str1 = Left(sip, InStr(sip, ".") - 1)
			sip = Mid(sip, InStr(sip, ".") + 1)
			str2 = Left(sip, InStr(sip, ".") - 1)
			sip = Mid(sip, InStr(sip, ".") + 1)
			str3 = Left(sip, InStr(sip, ".") - 1)
			str4 = Mid(sip, InStr(sip, ".") + 1)
			If IsNumeric(str1) = 0 Or IsNumeric(str2) = 0 Or IsNumeric(str3) = 0 Or IsNumeric(str4) = 0 Then
			Else
				num = CLng(str1) * 16777216 + CLng(str2) * 65536 + CLng(str3) * 256 + CLng(str4) - 1
				adb = "data/ipaddress.mdb"
				aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
				Set aConn = Server.CreateObject("ADODB.Connection")
				aConn.open aConnStr
	
				sql = "select top 1 country,city from ishion_address where ip1 <=" & num & " and ip2 >=" & num & ""
				Set irs = aConn.Execute(sql)
				If irs.EOF And irs.BOF Then
					country = "亚洲"
					city = ""
				Else
					country = irs(0)
					city = irs(1)
				End If
				Set irs = Nothing
				Set aConn = Nothing
				SqlQueryNum = SqlQueryNum + 1
			End If
			address = country & city
		Else
			address = "未知"
		End If
	End Function
end class

Class Cls_Browser
    Public Browser, Version, platform, IsSearch
    Private Sub Class_Initialize()
        Dim Agent, Tmpstr
        IsSearch = False
        If Not IsEmpty(Session("Cls_Browser")) Then
            Tmpstr = Split(Session("Cls_Browser"), "|||")
            Browser = Tmpstr(0)
            Version = Tmpstr(1)
            platform = Tmpstr(2)
            If Tmpstr(3) = "1" Then
                IsSearch = True
            End If
            Exit Sub
        End If
        Browser = "unknown"
        Version = "unknown"
        platform = "unknown"
        Agent = Request.ServerVariables("HTTP_USER_AGENT")
        'Agent="Opera/7.23 (X11; Linux i686; U)  [en]"
        If Left(Agent, 7) = "Mozilla" Then '有此标识为浏览器
            Agent = Split(Agent, ";")
            If InStr(Agent(1), "MSIE") > 0 Then
                Browser = "Microsoft Internet Explorer "
                Version = Trim(Left(Replace(Agent(1), "MSIE", ""), 6))
            ElseIf InStr(Agent(4), "Netscape") > 0 Then
                Browser = "Netscape "
                Tmpstr = Split(Agent(4), "/")
                Version = Tmpstr(UBound(Tmpstr))
            ElseIf InStr(Agent(4), "rv:") > 0 Then
                Browser = "Mozilla "
                Tmpstr = Split(Agent(4), ":")
                Version = Tmpstr(UBound(Tmpstr))
                If InStr(Version, ")") > 0 Then
                    Tmpstr = Split(Version, ")")
                    Version = Tmpstr(0)
                End If
            End If
            If InStr(Agent(2), "NT 5.2") > 0 Then
                platform = "Windows Server 2003"
            ElseIf InStr(Agent(2), "Windows CE") > 0 Then
                platform = "Windows CE"
            ElseIf InStr(Agent(2), "NT 5.1") > 0 Then
                platform = "Windows XP"
            ElseIf InStr(Agent(2), "NT 4.0") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(2), "NT 5.0") > 0 Then
                platform = "Windows 2000"
            ElseIf InStr(Agent(2), "NT") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(2), "9x") > 0 Then
                platform = "Windows ME"
            ElseIf InStr(Agent(2), "98") > 0 Then
                platform = "Windows 98"
            ElseIf InStr(Agent(2), "95") > 0 Then
                platform = "Windows 95"
            ElseIf InStr(Agent(2), "Win32") > 0 Then
                platform = "Win32"
            ElseIf InStr(Agent(2), "Linux") > 0 Then
                platform = "Linux"
            ElseIf InStr(Agent(2), "SunOS") > 0 Then
                platform = "SunOS"
            ElseIf InStr(Agent(2), "Mac") > 0 Then
                platform = "Mac"
            ElseIf UBound(Agent) > 2 Then
                If InStr(Agent(3), "NT 5.1") > 0 Then
                    platform = "Windows XP"
                End If
                If InStr(Agent(3), "Linux") > 0 Then
                    platform = "Linux"
                End If
            End If
            If InStr(Agent(2), "Windows") > 0 And platform = "unknown" Then
                platform = "Windows"
            End If
        ElseIf Left(Agent, 5) = "Opera" Then '有此标识为浏览器
            Agent = Split(Agent, "/")
            Browser = "Mozilla "
            Tmpstr = Split(Agent(1), " ")
            Version = Tmpstr(0)
            If InStr(Agent(1), "NT 5.2") > 0 Then
                platform = "Windows 2003"
            ElseIf InStr(Agent(1), "Windows CE") > 0 Then
                platform = "Windows CE"
            ElseIf InStr(Agent(1), "NT 5.1") > 0 Then
                platform = "Windows XP"
            ElseIf InStr(Agent(1), "NT 4.0") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(1), "NT 5.0") > 0 Then
                platform = "Windows 2000"
            ElseIf InStr(Agent(1), "NT") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(1), "9x") > 0 Then
                platform = "Windows ME"
            ElseIf InStr(Agent(1), "98") > 0 Then

                platform = "Windows 98"
            ElseIf InStr(Agent(1), "95") > 0 Then
                platform = "Windows 95"
            ElseIf InStr(Agent(1), "Win32") > 0 Then
                platform = "Win32"
            ElseIf InStr(Agent(1), "Linux") > 0 Then
                platform = "Linux"
            ElseIf InStr(Agent(1), "SunOS") > 0 Then
                platform = "SunOS"
            ElseIf InStr(Agent(1), "Mac") > 0 Then
                platform = "Mac"
            ElseIf UBound(Agent) > 2 Then
                If InStr(Agent(3), "NT 5.1") > 0 Then
                    platform = "Windows XP"
                End If
                If InStr(Agent(3), "Linux") > 0 Then
                    platform = "Linux"
                End If
            End If
        Else
            '识别搜索引擎
            Dim botlist, i
            botlist = "Google,Isaac,Webdup,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
            botlist = Split(botlist, ",")
            For i = 0 To UBound(botlist)
                If InStr(Agent, botlist(i)) > 0 Then
                    platform = botlist(i) & "搜索器"
                    IsSearch = True
                    Exit For
                End If
            Next
        End If
        If Version <> "unknown" Then
            Dim Tmpstr1
            Tmpstr1 = Trim(Replace(Version, ".", ""))
            If Not IsNumeric(Tmpstr1) Then
                 Version = "unknown"
            End If
        End If
        If IsSearch Then
            Browser = ""
            Version = ""
            Session("Cls_Browser") = Browser & "|||" & Version & "|||" & platform & "|||1"
        Else
            Session("Cls_Browser") = Browser & "|||" & Version & "|||" & platform & "|||0"
        End If
        
        Exit Sub '官方站屏蔽此句 客户的去掉屏蔽
        '记录未知Agent
        If Browser = "unknown" Or Version = "unknown" Or platform = "unknown" Then
            Agent = Dvbbs.checkStr(Request.ServerVariables("HTTP_USER_AGENT"))
            Dim Log_ConnStr, Log_Conn, Log_db, Rs
            Log_db = "data/SQL_LOG.mdb"
            Log_ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(Log_db)
            Set Log_Conn = Server.CreateObject("ADODB.Connection")
            Log_Conn.open Log_ConnStr
            Set Rs = Log_Conn.Execute("select * from [Agent] where UserAgent='" & Agent & "'")
            If Rs.EOF Then
                Set Rs = Nothing
                Log_Conn.Execute ("insert into [Agent](UserAgent)Values('" & Agent & "')")
            End If
            Log_Conn.Close
            Set Log_Conn = Nothing
        End If
    End Sub
End Class %>

