<%

'////////////////////////////////////
'分页类
'////////////////////////////////////
Class Cls_vbsPage
	Private oConn
	Private iPagesize
	Private sPageName
	Private sDbType
	Private iRecType
	Private sJsUrl
	Private sField
	Private sTable
	Private sCondition
	Private sOrderBy
	Private sPkey
	Private iRecCount

	Private Sub Class_Initialize
		iPageSize=10
		sPageName="Page"
		sDbType="AC"
		iRecType=0
		sJsUrl=""
		sField=" * "
	End Sub

	Public Property Set Conn(ByRef Value)
		Set oConn=Value
	End Property

	Public Property Let PageSize(ByVal intPageSize)
		iPageSize=CheckNum(intPageSize,0,0,iPageSize,0) 
	End Property

	Public Property Let PageName(ByVal strPageName)
		sPageName=IIf(Len(strPageName)<1,sPageName,strPageName)
	End Property

	Public Property Let DbType(ByVal strDbType)
		sDbType=UCase(IIf(Len(strDbType)<1,sDbType,strDbType))
	End Property

	Public Property Let RecType(ByVal intRecType)
		iRecType=CheckNum(intRecType,0,0,iRecType,0) 
	End Property

	Public Property Let JsUrl(ByVal strJsUrl)
		sJsUrl=strJsUrl
	End Property

	Public Property Let Pkey(ByVal strPkey)
		sPkey=strPkey
	End Property

	Public Property Let Field(ByVal strField)
		sField=IIf(Len(strField)<1,sField,strField)
	End Property

	Public Property Let Table(ByVal strTable)
		sTable=strTable
	End Property

	Public Property Let Condition(ByVal strCondition)
		Dim s
		s=strCondition
		sCondition=IIf(Len(s)>2," WHERE "&s,"")
	End Property

	Public Property Let OrderBy(ByVal strOrderBy)
		Dim s
		s=strOrderBy
		sOrderBy=IIf(Len(s)>4," ORDER BY "&s,"")
	End Property

	Public Property Get RecCount()
	    dim i
		If iRecType>0 Then
			i=iRecType
		Elseif iRecType=0 Then
			i=CheckNum(Request.Cookies("ShowoPage")(sPageName),1,0,0,0)
			Dim s
			s=Trim(Request.Cookies("ShowoPage")("sCond"))
			IF i=0 OR sCondition<>s Then
				i=oConn.Execute("SELECT COUNT("&sPkey&") FROM "&sTable&" "&sCondition,0,1)(0)
				Response.Cookies("ShowoPage")(sPageName)=i
				Response.Cookies("ShowoPage")("sCond")=sCondition
			End If
		Else
			i=oConn.Execute("SELECT COUNT("&sPkey&") FROM "&sTable&" "&sCondition,0,1)(0)
		End If
		iRecCount=i
		RecCount=i
	End Property

	Public Property Get ResultSet()
		Dim s,i
		s=Null
		i=iRecCount
		If i>0 Then
			Dim iPageCount,iPageCurr
			iPageCount=Abs(Int(-Abs(i/iPageSize)))
			iPageCurr=CheckNum(Request.QueryString(sPageName),1,1,1,iPageCount)
			Select Case sDbType
				Case "MSSQL"
					Set Rs=server.CreateObject("Adodb.RecordSet")
					Set Cm=Server.CreateObject("Adodb.Command")
					Cm.CommandType=4
					Cm.ActiveConnection=oConn
					Cm.CommandText="sp_Util_Page"
					Cm.parameters(1)=i
					Cm.parameters(2)=iPageCurr
					Cm.parameters(3)=iPageSize
					Cm.parameters(4)=sPkey
					Cm.parameters(5)=sField
					Cm.parameters(6)=sTable
					Cm.parameters(7)=Replace(sCondition," WHERE ","")
					Cm.parameters(8)=Replace(sOrderBy," ORDER BY ","")
					Rs.CursorLocation=3
					Rs.LockType=1
					Rs.Open Cm
				Case "MYSQL"
					ResultSet_Sql="SELECT "&sField&" FROM "&sTable&" "&sCondition&" "&sOrderBy&" LIMIT "&(iPageCurr-1)*iPageSize&","&iPageSize
					Set Rs=oConn.Execute(ResultSet_Sql)
				Case Else
					Dim Rs,ResultSet_Sql
					Set Rs = Server.CreateObject ("Adodb.RecordSet")
					ResultSet_Sql="SELECT "&sField&" FROM "&sTable&" "&sCondition&" "&sOrderBy
					Rs.Open ResultSet_Sql,oConn,1,1,&H0001
					Rs.AbsolutePosition=(iPageCurr-1)*iPageSize+1
			End Select
			s=Rs.GetRows(iPageSize)
			Rs.close
			Set Rs=Nothing
		End If
		ResultSet=s
	End Property

	Private Sub Class_Terminate()
		If IsObject(oConn) Then oConn.Close:Set oConn=Nothing
	End Sub

	Private Function CheckNum(ByVal strStr,ByVal blnMin,ByVal blnMax,ByVal intMin,ByVal intMax)
		Dim i,s,iMi,iMa
		s=Left(Trim(""&strStr),32):iMi=intMin:iMa=intMax
		If IsNumeric(s) Then
			i=CDbl(s)
			i=IIf(blnMin=1 And i<iMi,iMi,i)
			i=IIf(blnMax=1 And i>iMa,iMa,i)
		Else
			i=iMi
		End If
		CheckNum=i
	End Function

	Private Function IIf(ByVal blnBool,ByVal strStr1,ByVal strStr2)
		Dim s
		If blnBool Then
			s=strStr1
		Else
			s=strStr2
		End If
		IIf=s
	End Function

	Public Sub ShowPage()
	%>
		<script language="javascript" type="text/javascript" src="<%=sJsUrl%>/page.js"></script>
		<script language="javascript" type="text/javascript">
			var s = new Cls_jsPage(<%=iRecCount%>,<%=iPageSize%>,3,"s");
			s.setPageSE("<%=sPageName%>=","");
			s.setPageInput("<%=sPageName%>");
			s.setUrl("");
			s.setPageFrist("首页","<<");
			s.setPagePrev("上页","<");
			s.setPageNext("下页",">");
			s.setPageLast("尾页",">>");
			s.setPageText("[{$PageNum}]","第{$PageNum}页");
			s.setPageTextF(" {$PageTextF} "," {$PageTextF} ");
			s.setPageSelect("{$PageNum}","第{$PageNum}页");
			s.setPageCss("","","");
			s.setHtml("共{$RecCount}记录 页次{$Page}/{$PageCount} 每页{$PageSize}条 {$PageFrist} {$PagePrev} {$PageText} {$PageNext} {$PageLast} {$PageInput} {$PageSelect}");
			s.Write();
		</script>
	<%
	End Sub
End Class
	REM 当你在千方百计去掉版权信息时
	REM 是否曾想过自己在失去什么？
'////////////////////////////////////
'ASP探针类
'////////////////////////////////////
class cls_ActiveXCheck
	Public FileName,WebName,WebUrl,SysName,SysNameE,SysVersion
	Public Function IsObjInstalled(strClassString)
		On Error Resume Next
		Dim xTestObj
		Set xTestObj = Server.CreateObject(strClassString)
		If Err Then
			IsObjInstalled = False
		else	
			IsObjInstalled = True
		end if
		Set xTestObj = Nothing
	End Function
	
	Public Function getver(Classstr)
		On Error Resume Next
		Dim xTestObj
		Set xTestObj = Server.CreateObject(Classstr)
		If Err Then
			getver=""
		else	
			getver=xTestObj.version
		end if
		Set xTestObj = Nothing
	End Function
	
	Public Function GetObjInfo(startnum,endnum)
		dim i,Outstr
		for i=startnum to endnum
			Outstr = Outstr & "<tr  align=center height=18 class=""hback""><TD align=left>&nbsp;" & theObj(i,0) & ""
			Outstr = Outstr & "&nbsp;"&theObj(i,1)&"</font>"
			Outstr = Outstr & "</td>"
			If Not IsObjInstalled(theObj(i,0)) Then 
			Outstr = Outstr & "<td align=left>&nbsp;<span class=""tx""><b>×</b></span></td>"
			Else
			Outstr = Outstr & "<td align=left>&nbsp;<b>√</b>" & getver(theObj(i,0)) & "</td>"
			End If
			Outstr = Outstr & "</tr>" & vbCrLf
		next
		Response.Write(Outstr)
	End Function
	
	Public Function cdrivetype(tnum)
		Select Case tnum
			Case 0: cdrivetype = "未知"
			Case 1: cdrivetype = "可移动磁盘"
			Case 2: cdrivetype = "本地硬盘"
			Case 3: cdrivetype = "网络磁盘"
			Case 4: cdrivetype = "CD-ROM"
			Case 5: cdrivetype = "RAM 磁盘"
		End Select
	end function
	
	Private Sub Class_Initialize()
		WebName="IT猫扑上网导航"
		WebUrl="http://site.itmop.com"
		SysName="探针"		
		SysNameE="ActiveXCheck"
		SysVersion=" "
		FileName=Request.ServerVariables("SCRIPT_NAME")
	End Sub
	
	Public Function dtype(num)
		Select Case num
			Case 0: dtype = "未知"
			Case 1: dtype = "可移动磁盘"
			Case 2: dtype = "本地硬盘"
			Case 3: dtype = "网络磁盘"
			Case 4: dtype = "CD-ROM"
			Case 5: dtype = "RAM 磁盘"
		End Select
	End Function
	
	Public Function formatdsize(dsize)
		if dsize>=1073741824 then
			formatdsize=Formatnumber(dsize/1073741824,2) & " GB"
		elseif dsize>=1048576 then
			formatdsize=Formatnumber(dsize/1048576,2) & " MB"
		elseif dsize>=1024 then
			formatdsize=Formatnumber(dsize/1024,2) & " KB"
		else
			formatdsize=dsize & "B"
		end if
	End Function
	
	Public Function formatvariables(str)
	on error resume next
	str = cstr(server.htmlencode(str))
	formatvariables=replace(str,chr(10),"<br>")
	End Function
	
	Public Sub ShowFooter()
		dim Endtime,Runtime,OutStr
		Endtime=timer()
		OutStr = ""
		Runtime=FormatNumber((endtime-startime)*1000,2) 
		if Runtime>0 then
			if Runtime>1000 then
				OutStr = OutStr & "<div align=center>页面执行时间：约"& FormatNumber(runtime/1000,2) & "秒</div>"
			else
				OutStr = OutStr & "<div align=center>页面执行时间：约"& Runtime & "毫秒</div>"
			end if	
		end if
		Response.Write(OutStr)
	End Sub
End class


'////////////////////////////////////
'列表类
'////////////////////////////////////
class classlist
	private class_id
	private class_table
	private class_parentid
	private class_name

	public property let id(str)
		class_id = str
	end property

	public property let table(str)
		class_table = str
	end property

	public property let parentid(str)
		class_parentid = str
	end property

	public property let name(str)
		class_name = str
	end property

	dim list()
	dim i,n
	private sub class_initialize()
		i = 0:n = 0
	end sub

	public function classarry(thisid,id)
		dim rsclass,classsql
		if id > 0 then
			classsql = "select * from " & class_table & " where " & class_parentid & "=" & thisid &" order by orders,id asc"
		else
			classsql = "select * from " & class_table & " where " & class_id & "=" & thisid &" order by orders,id asc"
		end if
		set rsclass = conn.execute(classsql)
		n = n + 1
		do while not rsclass.eof
			list(0,i) = rsclass(class_id)
			list(1,i) = rsclass(class_name)
			list(2,i) = n
			i = i + 1
			thisid = classarry(rsclass(class_id),1)
			rsclass.movenext
		loop
		n = n - 1
		rsclass.close
	end function

	public function arrylist()
		dim rsclass
		set rsclass = conn.execute("select count(" & class_id & ") from " & class_table)
		dim lenght:lenght = rsclass(0)
		    rsclass.close
		redim list(2,lenght)
		dim rspclass
		set rspclass = conn.execute("select " & class_id & " from " & class_table & " where " & class_parentid & "=0 order by orders,id asc")
		do while not rspclass.eof
			call classarry(rspclass(class_id),0)
			rspclass.movenext
		loop
		rspclass.close
		arrylist = list
	end function
end class

'////////////////////////////////////
'////////////////////////////////////
class stringclass
	public function getstr(strhtml)
		dim PatrnStr
			PatrnStr="<.*?>"
		dim objRegEx
		set objRegEx = new RegExp
			objRegEx.pattern = PatrnStr
			objRegEx.ignorecase = true
			objRegEx.global = true
		getstr = objRegEx.replace(strhtml,"")
		set objRegEx = nothing
	end function
	public function replacestr(patrn,mstr,replstr)
		dim objRegEx
		set objRegEx = new RegExp
			objRegEx.pattern = patrn
			objRegEx.ignorecase = true
			objRegEx.global = true
		replacestr = objRegEx.replace(mstr,replstr)
		set objRegEx = nothing
	end function
	public function classcustomtag(byval patrn,byval mstr,byval classid,byval indexid,byval pagestr)
		dim objRegEx,match,matches
		set objRegEx = new RegExp
			objRegEx.pattern = patrn
			objRegEx.ignorecase = true
			objRegEx.global = true
		set matches = objRegEx.execute(mstr)
		for each match in matches
			mstr = replace(mstr,match.value,parseclasstag(match.value,classid,indexid,pagestr))
		next
		set matches = nothing
		set objRegEx = nothing
		classcustomtag = mstr
	end function
	public function customtag(byval patrn,byval mstr,byval classid,byval id,byval keywords)
		dim objRegEx,match,matches
		set objRegEx = new RegExp
			objRegEx.pattern = patrn
			objRegEx.ignorecase = true
			objRegEx.global = true
		set matches = objRegEx.execute(mstr)
		for each match in matches
			mstr = replace(mstr,match.value,parsetag(match.value,classid,id,keywords))
		next
		set matches = nothing
		set objRegEx = nothing
		customtag = mstr
	end function
end class

'////////////////////////////////////
'广告类
'////////////////////////////////////
class Advertisetag
	public function Advertise(AdName)
		dim TempHTM,rs,i
	    set rs = conn.execute("select top 1 AdID,AdPlace,AdLabel,Adfile,Adtype,Adwidth,Adheight,AdContent,AdClickNum,AdShowNum,AdMaxClickNum,AdMaxShowNum,AdAddDate,AdEndDate,AdLock from AD654_Info where AdLock=0 and AdLabel='"&AdName&"' order by AdID desc")
        if not rs.eof then
		   if rs("Adtype")=0 then
		      TempHTM="<iframe id=""ad654_"&AdName&""" frameborder=""0"" marginwidth=""0"" marginheight=""0"" scrolling=""no"" width="""&rs("Adwidth")&""" height="""&rs("Adheight")&""" src="""&root_html&"/ads/"&rs("Adfile")&"""></iframe>"
		   elseif rs("Adtype")=1 then
		      TempHTM=rs("AdContent")
		   elseif rs("Adtype")=2 then
		      TempHTM=""
		   else 
		      TempHTM="广告类型不对咯，代号："&AdName&""
		   end if 	          
        else
		   TempHTM="广告位招租，广告代号："&AdName&""
		end if
		rs.close:set rs = nothing
	    Advertise=TempHTM
	end function
end class

%>