skincreate.aspx.vb

如果不使用IIS,请先运行 XSP.exe,待提示已侦听 8080端口后

Imports System.IO
Imports System.Text.RegularExpressions
Partial Class Manage_SkinCreate
    Inherits System.Web.UI.Page

    Const SKINREGCONTROL As String = "<%@ Control Language=""C#"" AutoEventWireup=""true"" Inherits=""DNNLite.UI.Skins.Skin"" %>"
    Const CONTAINERREGCONTROL As String = "<%@ Control Language=""C#"" AutoEventWireup=""true""  Inherits=""DNNLite.UI.Containers.Container"" %>" & vbCrLf & _
            "<%@ Register src=""~/admin/Containers/solpartactions.ascx"" tagname=""solpartactions"" tagprefix=""uc1"" %>" & vbCrLf & _
            "<%@ Register src=""~/admin/Containers/moduletitle.ascx"" tagname=""moduletitle"" tagprefix=""uc2"" %>"

    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        If Not IsPostBack Then
            BindddlThemes()
        End If

    End Sub

    Private Sub BindddlThemes()
        ddlThemes.Items.Clear()
        Dim dir As String() = Directory.GetDirectories(Server.MapPath("~/Portals"))
        For Each d As String In dir
            ddlThemes.Items.Add(Path.GetFileName(d))
        Next
    End Sub

    Protected Sub btnAddTheme_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAddTheme.Click
        If txtAddTheme.Text = "" Then Return

        Try

            Dim dir As String = Server.MapPath("~/Portals/" & txtAddTheme.Text)

            Directory.CreateDirectory(dir)

            Directory.CreateDirectory(dir & "/Skins")
            Directory.CreateDirectory(dir & "/Containers")
            BindddlThemes()
            lblerr.Text = "新增成功"
        Catch ex As IOException
            lblerr.Text = ex.Message
        End Try

    End Sub
#Region "处理皮肤"
    Protected Sub btnAddSkin_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAddSkin.Click
        MultiView1.ActiveViewIndex = 1

        Try
            If Not Directory.Exists(Server.MapPath("~/Portals/" & ddlThemes.SelectedItem.Text & "/Skins")) Then
                Directory.CreateDirectory(Server.MapPath("~/Portals/" & ddlThemes.SelectedItem.Text & "/Skins"))
            End If

            Dim skins As String() = Directory.GetFiles(Server.MapPath("~/Portals/" & ddlThemes.SelectedItem.Text & "/Skins"))

            RBLSkins.Items.Clear()

            RBLSkins.Items.Add("新建一个皮肤")
            For i As Int16 = 0 To skins.Length - 1
                RBLSkins.Items.Add(New ListItem(Path.GetFileNameWithoutExtension(skins(i)), skins(i)))

            Next

        Catch ex As IOException
            lblerr.Text = ex.Message
        End Try




    End Sub

    Protected Sub btnLoadSkinTemplet_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnLoadSkinTemplet.Click
        If selfile1.FileName = "" Then Return

        LoadSkinFile(selfile1.FileName)

    End Sub


    Private Sub LoadSkinFile(ByVal file As String)
        Using sr As New StreamReader(Server.MapPath(file))

            txtSkinTemplet.Text = sr.ReadToEnd()

            If txtSkinTemplet.Text.StartsWith(SKINREGCONTROL) Then
                txtSkinTemplet.Text = txtSkinTemplet.Text.Substring(SKINREGCONTROL.Length)
            End If

        End Using
    End Sub

    Protected Sub btnCreateSkin_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnCreateSkin.Click
        If RBLSkins.SelectedIndex < 0 Then Return

        If RBLSkins.SelectedIndex = 0 And txtSkinName.Text = "" Then
            lblerr.Text = "请输入您要新建立的皮肤的名称"
            Return
        End If

        Dim skinname As String = "~/Portals/" & ddlThemes.SelectedItem.Text & "/Skins/" & _
                IIf(RBLSkins.SelectedIndex = 0, txtSkinName.Text, RBLSkins.SelectedItem.Text) _
                    & ".ascx"

        '********开始生成皮肤************
        Try
            Dim skincontent As String = SKINREGCONTROL & vbCrLf

            skincontent &= txtSkinTemplet.Text

            Using sw As New StreamWriter(Server.MapPath(skinname), False)
                sw.Write(skincontent)
            End Using

            Page.ClientScript.RegisterStartupScript(Me.GetType(), "msg", "<script>alert('生成成功')</script>")

        Catch ex As IOException
            lblerr.Text = ex.Message
        End Try



    End Sub

    Protected Sub btnBack1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnBack1.Click
        MultiView1.ActiveViewIndex = 0
    End Sub






    Private Function AnalysisSkin(ByVal input As String) As String
        '*********查找[  Pane]标记，替换为placeholder
        Dim pattern As String = "\[(?<panename>\w+)Pane]"

        Dim result As String = input

        Dim reg As New Regex(pattern, RegexOptions.IgnoreCase)

        For Each m As Match In reg.Matches(input)
            Dim panename As String = m.Groups("panename").Value



            result = result.Replace(m.Value, "<asp:PlaceHolder id=""" & panename & "Pane"" runat=""server""></asp:PlaceHolder>")
        Next

        '***********查找 {$tpl.include(" ")}**,替换为
        '  <dnnlite:IncludeTemplet TempletFile="~/tp1.htm" runat="server" />
        '*******

        pattern = "{$tpl.include\(""(?<filename>\S+?)\s*?""\s*?\)\s*?}"

        reg = New Regex(pattern, RegexOptions.IgnoreCase Or RegexOptions.Singleline)

        For Each m As Match In reg.Matches(input)
            Dim filename As String = m.Groups("filename").Value

            Dim str As String = _
                "<dnnlite:IncludeTemplet TempletFile=""" & filename & """ runat=""server"" />"
            result = result.Replace(m.Value, str)

        Next



        Return result

    End Function




    Protected Sub btnAnalysisSkin_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAnalysisSkin.Click
        txtSkinTemplet.Text = AnalysisSkin(txtSkinTemplet.Text)
    End Sub

    Protected Sub btnLoadSkin_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnLoadSkin.Click
        If RBLSkins.SelectedIndex < 1 Then
            Return
        End If
        Dim skinname As String = "~/Portals/" & ddlThemes.SelectedItem.Text & "/Skins/" & _
                 RBLSkins.SelectedItem.Text & ".ascx"
        LoadSkinFile(skinname)



    End Sub

#End Region


    Protected Sub btnAddContainer_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAddContainer.Click
        MultiView1.ActiveViewIndex = 2

        Try
            If Not Directory.Exists(Server.MapPath("~/Portals/" & ddlThemes.SelectedItem.Text & "/Containers")) Then
                Directory.CreateDirectory(Server.MapPath("~/Portals/" & ddlThemes.SelectedItem.Text & "/Containers"))
            End If

            Dim containers As String() = Directory.GetFiles(Server.MapPath("~/Portals/" & ddlThemes.SelectedItem.Text & "/Containers"))

            RBLContainer.Items.Clear()

            RBLContainer.Items.Add("新建一个容器")
            For i As Int16 = 0 To containers.Length - 1
                RBLContainer.Items.Add(New ListItem(Path.GetFileNameWithoutExtension(containers(i)), containers(i)))

            Next

        Catch ex As IOException
            lblerr.Text = ex.Message
        End Try
    End Sub

    Protected Sub btnContainerBack_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnContainerBack.Click
        MultiView1.ActiveViewIndex = 0
    End Sub

    Protected Sub btnLoadContainer_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnLoadContainer.Click
        If RBLContainer.SelectedIndex < 1 Then
            Return
        End If
        Dim containername As String = "~/Portals/" & ddlThemes.SelectedItem.Text & "/Containers/" & _
                 RBLContainer.SelectedItem.Text & ".ascx"
        LoadContainerFile(containername)

    End Sub

    Private Sub LoadContainerFile(ByVal file As String)
        Using sr As New StreamReader(Server.MapPath(file))

            txtContainerTemplet.Text = sr.ReadToEnd()

            If txtContainerTemplet.Text.StartsWith(CONTAINERREGCONTROL) Then
                txtContainerTemplet.Text = txtContainerTemplet.Text.Substring(CONTAINERREGCONTROL.Length)
            End If

        End Using
    End Sub

    Protected Sub btnLoadContainerTemplet_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnLoadContainerTemplet.Click
        If selfile2.FileName = "" Then Return

        LoadContainerFile(selfile2.FileName)
    End Sub

    Protected Sub btnAnalysisContainer_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAnalysisContainer.Click
        txtContainerTemplet.Text = AnalysisContainer(txtContainerTemplet.Text)
    End Sub


    Private Function AnalysisContainer(ByVal input As String) As String
        '*********查找[ContentPane]标记，替换为服务器控件
        Dim pattern As String = "\[(?<panename>ContentPane)]"

        Dim result As String = input

        Dim reg As New Regex(pattern, RegexOptions.Multiline)

        Dim ma As Match = reg.Match(input)
        If ma.Success Then
            Dim panename As String = ma.Groups("panename").Value
            
            result = result.Replace(ma.Value, "<asp:PlaceHolder id=""ContentPane"" runat=""server""></asp:PlaceHolder>")

        End If

        '********查找[Menu]标记，替换为服务器控件
        result = result.Replace("[Menu]", "<uc1:solpartactions  runat=""server"" />")

        '*******查找[Title]标记，替换为服务器控件
        result = result.Replace("[Title]", "<uc2:moduletitle runat=""server"" />")

        '***********查找 {$tpl.include(" ")}**,替换为
        '  <dnnlite:IncludeTemplet TempletFile="~/tp1.htm" runat="server" />
        '*******
        pattern = "{$tpl.include\(""(?<filename>\S+?)\s*?""\s*?\)\s*?}"

        reg = New Regex(pattern, RegexOptions.IgnoreCase Or RegexOptions.Singleline)

        For Each m As Match In reg.Matches(input)
            Dim filename As String = m.Groups("filename").Value

            Dim str As String = _
                "<dnnlite:IncludeTemplet TempletFile=""" & filename & """ runat=""server"" />"
            result = result.Replace(m.Value, str)

        Next



        Return result

    End Function



    Protected Sub btnCreateContainer_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnCreateContainer.Click
        If RBLContainer.SelectedIndex < 0 Then Return

        If RBLContainer.SelectedIndex = 0 And txtContainerName.Text = "" Then
            lblerr.Text = "请输入您要新建立的容器的名称"
            Return
        End If

        Dim containername As String = "~/Portals/" & ddlThemes.SelectedItem.Text & "/Containers/" & _
                IIf(RBLContainer.SelectedIndex = 0, txtContainerName.Text, RBLContainer.SelectedItem.Text) _
                    & ".ascx"

        '********开始生成容器************
        Try
            Dim containercontent As String = CONTAINERREGCONTROL & vbCrLf

            containercontent &= txtContainerTemplet.Text

            Using sw As New StreamWriter(Server.MapPath(containername), False)
                sw.Write(containercontent)
            End Using

            Page.ClientScript.RegisterStartupScript(Me.GetType(), "msg", "<script>alert('生成成功')</script>")

        Catch ex As IOException
            lblerr.Text = ex.Message
        End Try
    End Sub
End Class