functionlib.class.asp

一个很好的asp cms管理系统

            Rs.MoveNext
        Wend
        Rs.Close
        Set Rs = Nothing
    End Function

    '函数:资源特性分类ID列表
    '参数:
    '返回:ID列，如: 23,23,11,32
    Public Function Special_ChildenList(Parent)
        Dim Sql, Rs, Result
        Sql = "SELECT id FROM special_list WHERE parent = " & Parent
        Set Rs = Db.ExeCute(Sql)
        While Not Rs.Eof
            If Special_ChildenList <> "" Then
                Special_ChildenList = Special_ChildenList & "," & Rs("id")
            Else
                Special_ChildenList = Rs("id")
            End If
            Result = Special_ChildenList(Rs("id"))
            If Result <> "" Then
                Special_ChildenList = Special_ChildenList & "," & Result
            End If
            Rs.MoveNext
        Wend
        Rs.Close
        Set Rs = Nothing
    End Function

    '函数:取得当前所在权限列表的父路径
    '参数:权限Id
    Public Function Path_PopedomList(Id, Url)
        If Id = 0 Then
            Path_PopedomList = "<a href=""" & Url & "Parent=0"">根类</a>"
            Exit Function
        End If

        Dim Sql, Rs, PId, title
        Sql = "SELECT TOP 1 id, parent, title FROM popedom_list WHERE id=" & Id
        Set Rs = Db.ExeCute(Sql)

        If Rs.Eof And Rs.Bof Then
            Rs.Close
            Set Rs = Nothing
            Exit Function
        End If

        PId = Rs("parent")
        title = Rs("title")
        Rs.Close
        Set Rs = Nothing

        Path_PopedomList = Path_PopedomList(PId, Url) & " &gt; <a href=""" & Url & "Parent=" & Id & """>" & title & "</a>"
    End Function

    '函数:取得当前所在特性列表的父路径
    '参数:特性Id
    Public Function Path_SpecialList(Id, Url)
        If Id = 0 Then
            Path_SpecialList = "<a href=""" & Url & "Parent=0"">根类</a>"
            Exit Function
        End If

        Dim Sql, Rs, PId, title
        Sql = "SELECT TOP 1 id, parent, title FROM special_list WHERE id=" & Id
        Set Rs = Db.ExeCute(Sql)

        If Rs.Eof And Rs.Bof Then
            Rs.Close
            Set Rs = Nothing
            Exit Function
        End If

        PId = Rs("parent")
        title = Rs("title")
        Rs.Close
        Set Rs = Nothing

        Path_SpecialList = Path_SpecialList(PId, Url) & " &gt; <a href=""" & Url & "Parent=" & Id & """>" & title & "</a>"
    End Function

    '函数:取得当前所在频道的父路径
    '参数:分类Id
    Public Function Path_ResClassList(Id, Url)
        If Id = 0 Then
            Path_ResClassList = "<a href=""" & Url & "Parent=0"">根类</a>"
            Exit Function
        End If

        Dim Sql, Rs, PId, title
        Sql = "SELECT TOP 1 id, parent, title FROM res_class_list WHERE id=" & Id
        Set Rs = Db.ExeCute(Sql)

        If Rs.Eof And Rs.Bof Then
            Rs.Close
            Set Rs = Nothing
            Exit Function
        End If

        PId = Rs("parent")
        title = Rs("title")
        Rs.Close
        Set Rs = Nothing

        Path_ResClassList = Path_ResClassList(PId, Url) & " &gt; <a href=""" & Url & "Parent=" & Id & """>" & title & "</a>"
    End Function

    '函数:创建一个唯一的记录Id
    '参数:键值
    Public Function CreateRecordId(auto_name)
        Dim Rs, Sql
            Sql = "SELECT TOP 1 * FROM auto_id_library WHERE auto_name='" & auto_name & "'"
        Set Rs = Db.CreateRS()
        Rs.Open Sql, Db.Conn, 1, 2
        If Rs.Eof And Rs.Bof Then
            CreateRecordId = -1
        Else
            CreateRecordId = Rs("auto_value")+1
            Rs("auto_value") = Rs("auto_value")+1
            Rs.Update()
        End If
        Rs.Close()
        Set Rs = Nothing
    End Function

    '////////////////////////////////////////
    '作 用：读取远程的文件数据
    '参 数：
    '   RemoteDataUrl           远程文件URL
    '返回：
    '   读取到的数据
    Public Function readRemoteFile(RemoteDataUrl)
        Dim XMLHttp
'       '    On Error Resume Next
        Set XMLHttp = Server.CreateObject("Microsoft.XMLHTTP")
        With XMLHttp
            .Open "Get", RemoteDataUrl, False
            .Send
            readRemoteFile = BytesToBstr(.responseBody, "GB2312")
        End With
        Set XMLHttp = Nothing   
    End Function

    '
    '
    Function BytesToBstr(body,  Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
    End Function


    '*******************************************************************************************************
    '                                       用户自定义的常用功能函数 - 开始
    '*******************************************************************************************************

    Public Function ResClassPopedom_process(objName)
        Dim RCPopedom, arrRCPopedom
        RCPopedom = Replace(FLib.SafeSql(Request("ResClassPopedom" & objName)), " ", "")
        ResClassPopedom_process = ""

        If RCPopedom = "" Then
            Exit Function
        End If

        arrRCPopedom = Split(RCPopedom, ",")

        '频道标志位，总长度设定为10位，从右往左使用。多个分类标志以;号分隔
        '数据格式为：
        '       资源Id,10位长度标志位,根节点标志
        '例如：
        '       12,0000011111,0;13,0000011111,1;21,0000000110,1
        Dim I
        For I=0 To Ubound(arrRCPopedom)
            If ResClassPopedom_process<>"" Then
                ResClassPopedom_process = ResClassPopedom_process & ";"
            End If
            ResClassPopedom_process = ResClassPopedom_process & arrRCPopedom(I) & ",000" & RequestRCFlag(objName, arrRCPopedom(I), 7) & RequestRCFlag(objName, arrRCPopedom(I), 6) & RequestRCFlag(objName, arrRCPopedom(I), 5) & RequestRCFlag(objName, arrRCPopedom(I), 4) & RequestRCFlag(objName, arrRCPopedom(I), 3) & RequestRCFlag(objName, arrRCPopedom(I), 2) & RequestRCFlag(objName, arrRCPopedom(I), 1) & "," & RequestRCRootNodeFlag(objName, arrRCPopedom(I))
        Next
    End Function

    Public Function RequestRCFlag(objName, RCId, Flag)
        If Request("flag" & Flag & "_" & RCId & objName) = "1" Then
            RequestRCFlag = "1"
        Else
            RequestRCFlag = "0"
        End If
    End Function

    Public Function RequestRCRootNodeFlag(objName, RCId)
        If Request("root_" & RCId & objName) = "1" Then
            RequestRCRootNodeFlag = "1"
        Else
            RequestRCRootNodeFlag = "0"
        End If
    End Function

    Public Function PopeFlag_OR(PopeFlag1, PopeFlag2)
        If PopeFlag1 = "" OR PopeFlag2 = "" Then
            PopeFlag_OR = "0000000000"
            Exit Function
        End If

        Dim I
        PopeFlag_OR = ""
        For I=1 To 10
            If Mid(PopeFlag1, I, 1) OR Mid(PopeFlag2, I, 1) Then
                PopeFlag_OR = PopeFlag_OR & "1"
            Else
                PopeFlag_OR = PopeFlag_OR & "0"
            End If
        Next
    End Function

    Public Function ChkRCPopeFlag(PopeFlag, PopeName)

        Dim FlagPossition           
        Select Case LCase(PopeName)
            Case "view":
                FlagPossition = 10
            Case "append":
                FlagPossition = 9
            Case "modify":
                FlagPossition = 8
            Case "delete":
                FlagPossition = 7
            Case "check":
                FlagPossition = 6
            Case "slice":
                FlagPossition = 5
            Case Else
                FlagPossition = -1
        End Select

        If FlagPossition = -1 Then
            ChkRCPopeFlag = False
        Else
            ChkRCPopeFlag = (Mid(PopeFlag, FlagPossition , 1) = "1")
        End If
    End Function

    '取得管理员对于指定频道的权限标识串
    Public Function chkPope_AboutTheClass(ClassId, PopeName)
        Dim Sql, Rs, PopeFlag
            Sql = "SELECT TOP 1 pope_flag FROM online_manage_resclass_popedom WHERE class_id=" & ClassId & " AND manager='" & Admin.UserName & "'"
        Set Rs = Db.ExeCute(Sql)
        If Rs.Eof And Rs.Bof Then
            PopeFlag = "0000000000"
        Else
            PopeFlag = Rs("pope_flag")
        End If
        Rs.Close()
        Set Rs = Nothing

        chkPope_AboutTheClass = FLib.ChkRCPopeFlag(PopeFlag, PopeName)

    End Function

	Public Function shareclassidstr(shareclassidstra,shareclassidstrb)
		dim aa,bb,a,b,astr,bstr,flagstr,lena,lenb,lenc
		dim classstra,classstrb,classstrc,classstr(3)
		astr = split(shareclassidstra,",")
		bstr = split(shareclassidstrb,",")
		flagstr = 0
		for a = 0 to ubound(astr)
			for b = 0 to ubound(bstr)
				if astr(a) = bstr(b) then
					flagstr = 1
					exit for
				end if
			next
			select case flagstr
				case 0
					classstra = classstra&astr(a)&","
				case 1
					classstrc = classstrc&astr(a)&","
					flagstr = 0
			end select
		next
		for b = 0 to ubound(bstr)
			for a = 0 to ubound(astr)
				if bstr(b) = astr(a) then
					flagstr = 1
					exit for
				end if
			next
			if flagstr =0 then
				classstrb = classstrb&bstr(b)&","
			end if
			flagstr =0
		next
		lena = len(classstra)
		lenb = len(classstrb)
		lenc = len(classstrc)
		if lenc>=1 then classstr(0) = mid(classstrc,1,len(classstrc)-1)
		if lena>=1 then classstr(1) = mid(classstra,1,len(classstra)-1)
		if lenb>=1 then classstr(2) = mid(classstrb,1,len(classstrb)-1)
		shareclassidstr = classstr
	End Function
	
	Public Function sharecidtosharerid(sharecidstr,sharereid)
		dim sharecid,sharerid,shareridstr
		dim ci
		Dim Rs, Sql
	    Set Rs = Db.CreateRs()
		sharecid = split(sharecidstr,",")
		for ci = 0 to ubound(sharecid)
		    Sql = Db.SqlTran("SELECT id FROM resource_list WHERE class_id=" & sharecid(ci) & " AND shareid = " & sharereid & " AND sharerale = 0")
		    Rs.Open Sql, Db.Conn, 1, 1
		    if not(Rs.bof and Rs.eof) then
				shareridstr = shareridstr&Rs("id")&","
			end if
			Rs.Close()
		next
		Set Rs = Nothing
		if len(shareridstr)>=1 then sharecidtosharerid = mid(shareridstr,1,len(shareridstr)-1)
	End Function

End Class
%>