Imports System
Imports System.Data
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls

Namespace Security
    Public Class Verification
        Implements IHttpHandlerFactory
        Public Sub ReleaseHanlder(ByVal hanlder As IHttpHandler) Implements IHttpHandlerFactory.ReleaseHandler
        End Sub


        Public Function GetHandler(ByVal context As HttpContext, ByVal requestType As String, ByVal url As String, ByVal pathTranslated As String) As IHttpHandler Implements IHttpHandlerFactory.GetHandler
            
            Dim factory As PageHandlerFactory = CType(Activator.CreateInstance(GetType(PageHandlerFactory), True), PageHandlerFactory)

            If Not IO.File.Exists(pathTranslated) Then
                context.Response.Write("<script>alert('您请求的页面不存在，请联系系统管理员，确认后重试！');history.go(-1);</script>")
                context.Response.End()
                Return Nothing
            End If

            Dim handler As IHttpHandler = factory.GetHandler(context, requestType, url, pathTranslated)
            Dim EndTime As String = BaseFunction.PublicMethod.GetApplication("EndTime")

            If CDate(Now.ToShortDateString) >= CDate(EndTime) And url <> "ErrorPage.aspx?Error=5000" Then
                context.Response.Redirect(BaseFunction.PublicMethod.GetBaseUrl() & "/ErrorPage.aspx?Error=5000")
                Return handler
            End If

            '加载系统配置

            Dim OpenModel As Boolean = BaseFunction.PublicMethod.GetOpenModel
            '判断当前模式
            Dim PageUrlQuery As String = context.Request.Url.Query
            Dim mActions As List(Of clsAction) = GetAction(PageUrlQuery, handler, context)
            Dim mMsg As String = GetUrlSecurity(OpenModel, context, url, mActions)
            If mMsg.Length > 0 Then
                context.Response.Write(mMsg)
                Return Nothing
            Else
                Return handler
            End If

        End Function
        Public Function GetUrlSecurity(ByVal OpenModel As Boolean, ByVal context As HttpContext, ByVal RequestUrl As String, Optional ByVal mActions As List(Of clsAction) = Nothing) As String
            Dim db As New DB_PlugModular.DB_PlugDataContext
            Dim mPlugList As List(Of DB_PlugModular.Plug) = XrenCache.XrCache.GetList(db, "Plug", DB_PlugModular.clsPlug.GetLinq, XrenCache.XrCache.CacheLifeType.File, HttpContext.Current.Request.PhysicalApplicationPath & "CacheFile\Plug.txt", , , , CType(BaseFunction.PublicMethod.GetApplication("SecCache"), Boolean))
            Dim mParList As List(Of DB_PlugModular.PlugParameter) = XrenCache.XrCache.GetList(db, "PlugParameter", DB_PlugModular.clsPlugParameter.GetLinq, XrenCache.XrCache.CacheLifeType.File, HttpContext.Current.Request.PhysicalApplicationPath & "CacheFile\PlugParameter.txt", , , , CType(BaseFunction.PublicMethod.GetApplication("SecCache"), Boolean))
            Dim mPlugPath As String = IO.Path.GetDirectoryName(context.Request.FilePath.Replace(BaseFunction.PublicMethod.GetApplication("WebURL"), ""))
            Dim mPlugName As String = IO.Path.GetFileName(RequestUrl).ToLower
            If mPlugPath.StartsWith("\") Then
                mPlugPath = Microsoft.VisualBasic.Right(mPlugPath, Len(mPlugPath) - 1).ToLower
            End If
            If mPlugPath = "" Then mPlugPath = "manager"
            Dim mPlugID As Integer = (From p In mPlugList _
                                      Where p.PageSetFile.ToLower.Contains(mPlugName) _
                                      And p.BaseURL = mPlugPath _
                                      Select p.ID).FirstOrDefault
            Dim mMsg As String = ""
            If Not OpenModel Then '验证模式，根据页面动作参数，验证权限
                If mPlugID > 0 Then
                    mMsg = VerificationModel(mParList, mActions, mPlugID)
                Else
                    mMsg = "<script>alert('您请求的页面不存在或者没有注册！请稍后重试！');window.location='/Login.aspx';</script>"
                End If
            Else                  '配置模式，读取页面动作参数，比对数据库是否添加
                If mPlugID > 0 Then
                    mMsg = ConfigModel(mParList, mActions, mPlugID)
                Else
                    mMsg = "<script>alert('保存页面出错！请稍后重试！');history.go(-1);</script>"
                End If
            End If
            Return mMsg
        End Function


        ''' <summary>
        ''' 配置模式
        ''' </summary>
        ''' <param name="mParameterList"></param>
        ''' <param name="Actions"></param>
        ''' <param name="mPlugID"></param>
        ''' <remarks></remarks>
        Private Function ConfigModel(ByVal mParameterList As List(Of DB_PlugModular.PlugParameter), ByVal Actions As List(Of clsAction), ByVal mPlugID As Integer) As String
            Dim strMsg As String = ""
            Dim context As HttpContext = HttpContext.Current
            If Not IsNothing(Actions) AndAlso Actions.Count > 0 Then
                Dim mActionName As String
                Dim mActionType As Integer
                For Each a In Actions
                    mActionName = a.ActionName
                    mActionType = a.ActionType
                    Dim FindAction = (From f In mParameterList _
                                      Where f.ParName = mActionName _
                                      And f.ParType = mActionType _
                                      And f.PlugID = mPlugID _
                                      Select f).FirstOrDefault
                    If IsNothing(FindAction) Then
                        Dim mParameter As New DB_PlugModular.clsPlugParameter
                        Dim NewID As Integer = mParameter.Insert(mPlugID, a.ActionType, a.ActionName, "")
                        If NewID = 0 Then
                            strMsg = "<script>alert('配置模式已终止，添加数据库失败！');history.go(-1);</script>"
                        Else
                            Dim mSiteID As Integer = CType(BaseFunction.PublicMethod.GetApplication("SiteID"), Integer)
                            Dim mPlugUserSecurity As New DB_PlugModular.clsPlugUserSecurity
                            Dim SecID As Integer = mPlugUserSecurity.Insert(mSiteID, BaseFunction.SiteUser.UserGroupID, mPlugID, NewID)
                            If SecID = 0 Then
                                strMsg = "<script>alert('配置模式已终止，添加用户权限失败！');history.go(-1);</script>"
                            Else
                                strMsg = "<script>parent.GetParameter('" & mPlugID.ToString & "');history.go(-1);</script>"
                            End If
                        End If
                    End If
                Next
            End If
            Return strMsg
        End Function
        ''' <summary>
        ''' 验证模式
        ''' </summary>
        ''' <param name="Actions"></param>
        ''' <param name="mPlugID"></param>
        ''' <remarks></remarks>
        Private Function VerificationModel(ByVal mParameterList As List(Of DB_PlugModular.PlugParameter), ByVal Actions As List(Of clsAction), ByVal mPlugID As Integer) As String
            Dim strMsg As String = ""
            Dim context As HttpContext = HttpContext.Current
            Dim mUserGroupID As Integer = BaseFunction.SiteUser.UserGroupID
            If mUserGroupID > 0 Then
                Dim isOK As Boolean = False
                Dim mActionName As String
                Dim mActionType As Integer
                Dim db As New DB_PlugModular.DB_PlugDataContext
                Dim mSiteID As Integer = CType(BaseFunction.PublicMethod.GetApplication("SiteID"), Integer)
                Dim SiteSecurityList As List(Of DB_PlugModular.PlugUserSecurity) = XrenCache.XrCache.GetList(db, "Security" & mSiteID.ToString, DB_PlugModular.clsPlugUserSecurity.GetLinq(mSiteID), XrenCache.XrCache.CacheLifeType.File, HttpContext.Current.Request.PhysicalApplicationPath & "CacheFile\Security" & mSiteID.ToString & ".txt", , , , CType(BaseFunction.PublicMethod.GetApplication("SecCache"), Boolean))
                If Not IsNothing(Actions) AndAlso Actions.Count > 0 Then
                    For Each a In Actions
                        mActionName = a.ActionName
                        mActionType = a.ActionType
                        Dim mParID = (From p In mParameterList _
                                      Where p.ParName = mActionName _
                                      And p.ParType = mActionType _
                                      And p.PlugID = mPlugID _
                                      Select p.ParID).FirstOrDefault
                        If mParID > 0 Then
                            Dim FindUserPar = (From s In SiteSecurityList _
                                           Where s.GroupID = mUserGroupID _
                                           And s.ParID = mParID _
                                           Select s).FirstOrDefault
                            If IsNothing(FindUserPar) Then
                                isOK = False
                                Exit For
                            Else
                                isOK = True
                            End If
                        Else
                            isOK = True
                        End If
                    Next
                Else
                    Dim ViewSecurity = (From s In SiteSecurityList _
                                        Where s.PlugID = mPlugID _
                                        And s.ParID = 0 _
                                        And s.GroupID = mUserGroupID _
                                        Select s).FirstOrDefault
                    If Not IsNothing(ViewSecurity) Then
                        isOK = True
                    End If
                End If
                If Not isOK Then
                    strMsg = "<script>alert('您请求的操作权限不足或者没有注册！\r\n联系管理员或注册请选择配置模式！');history.go(-1);</script>"
                End If
            Else
                strMsg = "<script>alert('您登录信息错误！请重新登录！');window.location='/Login.aspx';</script>"
            End If
            Return strMsg
        End Function



        Private Function GetAction(ByVal URL As String, ByVal iHandler As IHttpHandler, ByVal iContext As HttpContext) As List(Of clsAction)
            Dim ActionList As New List(Of clsAction)
            Dim mclsAction As clsAction
            Dim itemAction() As String

            If URL.Length > 0 Then
                Dim mUrlAction As String = URL.Replace("?", "")
                If mUrlAction.Length > 1 Then
                    Dim mAction() As String = mUrlAction.Split("&")
                    For Each strAction As String In mAction
                        If strAction.Contains("Action") Then
                            itemAction = strAction.Split("=")
                            mclsAction = New clsAction
                            mclsAction.ActionName = itemAction(1)
                            mclsAction.ActionType = clsAction.ActionItemType.UrlAction
                            ActionList.Add(mclsAction)
                        End If
                    Next
                End If
            End If

            Dim btnName As String
            Dim mPage As Page = CType(iHandler, Page)
            If iContext.Request.Form.Keys.Count > 0 Then
                If iContext.Request.Form("__EVENTTARGET") <> "" Then
                    btnName = iContext.Request.Form("__EVENTTARGET")
                Else
                    Dim imgButton As String = (From k As String In iContext.Request.Form.Keys _
                                                Where k.IndexOf(".") > 0 _
                                                Select k).FirstOrDefault
                    Dim btnButton As String = (From key In iContext.Request.Form.Keys _
                                                Where iContext.Request.Form(key) = "Button" _
                                                Select key).FirstOrDefault
                    If Not IsNothing(imgButton) Then
                        btnName = imgButton.Split(".")(0)
                    Else
                        btnName = btnButton
                    End If
                End If
                If Not IsNothing(btnName) AndAlso btnName.Length > 0 Then
                    Dim aryBtnName() As String = btnName.Split("$")
                    mclsAction = New clsAction
                    mclsAction.ActionName = aryBtnName(UBound(aryBtnName))
                    mclsAction.ActionType = clsAction.ActionItemType.ButtonAction
                    ActionList.Add(mclsAction)
                End If
               
            End If
            Return ActionList
        End Function
    End Class
End Namespace

