脚本转换的VB.Net实例

代码如下：

' Copyright (C) 2009, Maarten Klaassen
'
' ScriptConverter is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' ScriptConverter is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU Lesser General Public License for more details.
'
' You should have received a copy of the GNU Lesser General Public License
' along with ScriptConverter. If not, see <http://www.gnu.org/licenses/>.

Imports System
Imports System.CodeDom.Compiler
Imports System.Collections.Generic
Imports System.Globalization
Imports System.Reflection
Imports System.Text
Imports System.Windows
Imports System.Windows.Data
Imports System.Windows.Markup
Imports Microsoft.CSharp

Namespace ScriptConverter
   
    Public Class ScriptExtension
        Inherits MarkupExtension
       
        Private script As String
       
        Public Sub New(ByVal script As String)
            Me.script = script
        End Sub
       
        Public Overloads Overrides Function ProvideValue(ByVal serviceProvider As IServiceProvider) As Object
            Dim sc As New ScriptConverter()
            sc.Script = script
            Return sc
        End Function
       
    End Class
   
    Public Class ExpressionExtension
        Inherits MarkupExtension
       
        Private script As String
       
        Public Sub New(ByVal script As String)
            Me.script = "return " & script & ";"
        End Sub
       
        Public Overloads Overrides Function ProvideValue(ByVal serviceProvider As IServiceProvider) As Object
            Dim sc As New ScriptConverter()
            sc.Script = script
            Return sc
        End Function
       
    End Class
   
    Public Enum ReferenceTypes
        UsingDirective
        AssemblyReference
    End Enum
   
    Public Class Reference
Private _Value As String
        Public Property Value() As String
            Get
                Return _Value
            End Get
            Set(ByVal value As String)
                _Value = value
            End Set
        End Property
Private _ReferenceType As ReferenceTypes
        Public Property ReferenceType() As ReferenceTypes
            Get
                Return _ReferenceType
            End Get
            Set(ByVal value As ReferenceTypes)
                _ReferenceType = value
            End Set
        End Property
    End Class
   
   
    <ContentProperty("Script")> _
    Public Class ScriptConverter
        Implements IMultiValueConverter
        Implements IValueConverter
        ' private fields
        Private Shared ReadOnly valueConvertersCache As New Dictionary(Of String, IValueConverter)()
        Private Shared ReadOnly multiValueConvertersCache As New Dictionary(Of String, IMultiValueConverter)()
       
        #Region "code constants"
        Private Const standardUsingDirectives As [String] = "using System;" & vbCr & vbLf & " using System.Globalization;" & vbCr & vbLf & " using System.Windows.Data;" & vbCr & vbLf & " using System.Windows;"
       
        Private Const codeBefore As [String] = "namespace ScriptConverter" & vbCr & vbLf & " {" & vbCr & vbLf & " "
       
       
        #End Region
       
        ' properties
Private _Script As String
        Public Property Script() As String
            Get
                Return _Script
            End Get
            Set(ByVal value As String)
                _Script = value
            End Set
        End Property
Private _BackScript As String
        Public Property BackScript() As String
            Get
                Return _BackScript
            End Get
            Set(ByVal value As String)
                _BackScript = value
            End Set
        End Property
Private _References As Reference()
        Public Property References() As Reference()
            Get
                Return _References
            End Get
            Set(ByVal value As Reference())
                _References = value
            End Set
        End Property
       
        #Region "IMultiValueConverter Members"
       
        Public Function Convert(ByVal values As Object(), ByVal targetType As Type, ByVal parameter As Object, ByVal culture As CultureInfo) As Object
            If [String].IsNullOrEmpty(Script) Then
                Throw New NotImplementedException()
            End If
           
            Dim result As Object = Nothing
           
            Dim converter As IMultiValueConverter
            If Not multiValueConvertersCache.TryGetValue(Script, converter) Then
                converter = CreateMultiConverter(Script)
            End If
           
            If converter IsNot Nothing Then
                result = converter.Convert(values, targetType, parameter, culture)
            End If
           
            Return result
        End Function
       
        Public Function ConvertBack(ByVal value As Object, ByVal targetTypes As Type(), ByVal parameter As Object, ByVal culture As CultureInfo) As Object()
            ' to do...
            Throw New NotImplementedException()
        End Function
       
        #End Region
       
        #Region "IValueConverter Members"
       
        Public Function Convert(ByVal value As Object, ByVal targetType As Type, ByVal parameter As Object, ByVal culture As CultureInfo) As Object
            If [String].IsNullOrEmpty(Script) Then
                Throw New NotImplementedException()
            End If
           
            Dim result As Object = Nothing
           
            Dim converter As IValueConverter
            If Not valueConvertersCache.TryGetValue(Script, converter) Then
                converter = CreateConverter(Script)
            End If
           
            If converter IsNot Nothing Then
                result = converter.Convert(value, targetType, parameter, culture)
            End If
           
               
            Return result  '更多.net源码和教程，来自[乐博网 www.lob.cn]
        End Function
       
        Public Function ConvertBack(ByVal value As Object, ByVal targetType As Type, ByVal parameter As Object, ByVal culture As CultureInfo) As Object
            If [String].IsNullOrEmpty(BackScript) Then
                Throw New NotImplementedException()
            End If
           
            Dim result As Object = Nothing
           
            Dim converter As IValueConverter
            If Not valueConvertersCache.TryGetValue(BackScript, converter) Then
                converter = CreateConverter(BackScript)
            End If
           
            If converter IsNot Nothing Then
                result = converter.Convert(value, targetType, parameter, culture)
            End If
           
            Return result
        End Function
       
        #End Region
       
       
        Private Function CreateConverter(ByVal scriptToCompile As String) As IValueConverter
            Dim converter As IValueConverter = Nothing
           
            Dim prov As New CSharpCodeProvider()
           
            ' specify compiler parameters
            Dim cp As New CompilerParameters()
            cp.CompilerOptions = "/target:library /optimize"
            cp.GenerateExecutable = False
            cp.GenerateInMemory = True
            cp.IncludeDebugInformation = False
           
            ' add the standard referenced assemblies (copy from this assembly)
            Dim assemblies As Assembly() = AppDomain.CurrentDomain.GetAssemblies()
            For Each a As Assembly In assemblies
                cp.ReferencedAssemblies.Add(a.Location)
            Next
           
            ' add the user specified assemblies
            If References IsNot Nothing Then
                For Each r As Reference In References
                    If r.ReferenceType = ReferenceTypes.AssemblyReference Then
                        If Not [String].IsNullOrEmpty(r.Value) Then
                            cp.ReferencedAssemblies.Add(r.Value)
                        End If
                    End If
                Next
            End If
           
            ' create the source and compile it
            Dim completeSource As String = GenerateCompleteSource(scriptToCompile, False)
            Dim lines As String() = completeSource.Split(New [String]() {vbLf}, StringSplitOptions.None)
            Dim cr As CompilerResults = prov.CompileAssemblyFromSource(cp, completeSource)
           
            ' handle compiling errors
            If cr.Errors.HasErrors Then
                For Each err As CompilerError In cr.Errors
                    Dim [error] As New StringBuilder()
                    [error].AppendLine("Error found while compiling converter.")
                    [error].AppendLine(err.ErrorText)
                    [error].AppendLine("in line: " & lines(err.Line - 1))
                    MessageBox.Show([error].ToString(), "ScriptConverter Error: ")
                Next
            Else
               
                ' instantiate the IValueConverter
                Dim a As Assembly = cr.CompiledAssembly
               
                Dim ts As Type() = a.GetTypes()
               
                Try
                    converter = TryCast(ts(0).InvokeMember("ctor", BindingFlags.CreateInstance, Nothing, Nothing, Nothing), IValueConverter)
                Catch ex As Exception
                    MessageBox.Show(ex.Message)
                End Try
            End If
           
            valueConvertersCache.Add(scriptToCompile, converter)
            ' even when the converter is null
            Return converter
        End Function
       
        Private Function CreateMultiConverter(ByVal scriptToCompile As String) As IMultiValueConverter
            Dim converter As IMultiValueConverter = Nothing
           
            Dim prov As New CSharpCodeProvider()
           
            ' specify compiler parameters
            Dim cp As New CompilerParameters()
            cp.CompilerOptions = "/target:library /optimize"
            cp.GenerateExecutable = False
            cp.GenerateInMemory = True
            cp.IncludeDebugInformation = False
           
            ' add the standard referenced assemblies (copy from this assembly)
            Dim assemblies As Assembly() = AppDomain.CurrentDomain.GetAssemblies()
            For Each a As Assembly In assemblies
                cp.ReferencedAssemblies.Add(a.Location)
            Next
           
            ' add the user specified assemblies
            If References IsNot Nothing Then
                For Each r As Reference In References
                    If r.ReferenceType = ReferenceTypes.AssemblyReference Then
                        If Not [String].IsNullOrEmpty(r.Value) Then
                            cp.ReferencedAssemblies.Add(r.Value)
                        End If
                    End If
                Next
            End If
           
            ' create the source and compile it
            Dim completeSource As String = GenerateCompleteSource(scriptToCompile, True)
            Dim lines As String() = completeSource.Split(New [String]() {vbLf}, StringSplitOptions.None)
            Dim cr As CompilerResults = prov.CompileAssemblyFromSource(cp, completeSource)
           
            ' handle compiling errors
            If cr.Errors.HasErrors Then
                For Each err As CompilerError In cr.Errors
                    Dim [error] As New StringBuilder()
                    [error].AppendLine("Error found while compiling converter.")
                    [error].AppendLine(err.ErrorText)
                    [error].AppendLine("in line: " & lines(err.Line - 1))
                    MessageBox.Show([error].ToString(), "ScriptConverter Error: ")
                Next
            Else
               
                ' instantiate the IValueConverter
                Dim a As Assembly = cr.CompiledAssembly
               
                Dim ts As Type() = a.GetTypes()
               
                Try
                    converter = TryCast(ts(0).InvokeMember("ctor", BindingFlags.CreateInstance, Nothing, Nothing, Nothing), IMultiValueConverter)
                Catch ex As Exception
                    MessageBox.Show(ex.Message)
                End Try
            End If
           
            multiValueConvertersCache.Add(scriptToCompile, converter)
            ' even when the converter is null
            Return converter
        End Function
       
        Private Function GenerateCompleteSource(ByVal csSource As String, ByVal multiValue As Boolean) As String
            ' Complete the source code to make it compilable
            Dim sb As New StringBuilder()
           
            ' add the standard using directives
            sb.AppendLine(standardUsingDirectives)
           
            ' add the user specified using directives
            If References IsNot Nothing Then
                For Each r As Reference In References
                    If r.ReferenceType = ReferenceTypes.UsingDirective Then
                        If Not [String].IsNullOrEmpty(r.Value) Then
                            sb.AppendLine("using " & r.Value & ";")
                        End If
                    End If
                Next
            End If
           
            ' add the code before the script
            sb.AppendLine(codeBefore)
           
            ' add the class declaration and the convert method header
            If Not multiValue Then
                sb.AppendLine("public class CSharpConverter : IValueConverter" & vbCr & vbLf & " {" & vbCr & vbLf & " public object Convert(object value, Type targetType, object parameter, System.Globalization.CultureInfo culture)" & vbCr & vbLf & " {")
            Else
                sb.AppendLine("public class CSharpConverter : IMultiValueConverter" & vbCr & vbLf & " {" & vbCr & vbLf & " public object Convert(object[] values, Type targetType, object parameter, System.Globalization.CultureInfo culture)" & vbCr & vbLf & " {")
            End If
           
            ' add the script
            sb.AppendLine(csSource)
           
            ' add the code after the script
            If Not multiValue Then
                sb.AppendLine(" }" & vbCr & vbLf & " public object ConvertBack(object value, Type targetType, object parameter, System.Globalization.CultureInfo culture)" & vbCr & vbLf & " { " & vbCr & vbLf & " throw new NotImplementedException();" & vbCr & vbLf & " }" & vbCr & vbLf & " }" & vbCr & vbLf & " }")
            Else
                sb.AppendLine(" }" & vbCr & vbLf & " public object[] ConvertBack(object value, Type[] targetTypes, object parameter, CultureInfo culture)" & vbCr & vbLf & " { " & vbCr & vbLf & " throw new NotImplementedException();" & vbCr & vbLf & " }" & vbCr & vbLf & " }" & vbCr & vbLf & " }")
            End If
           
           
           
            Return sb.ToString()
        End Function
       
       
    End Class
End Namespace