' 發展單位：風禹科技驗證有限公司
' 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水利博肄，微軟最有價值專家
' Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
' --------------------------------------------------------------------------------------

Public Class VBNetCode
	Private defaultAssemblies() As String = Split("system.dll,system.xml.dll,system.data.dll", ",")
	Private defaultImports() As String = Split("System,System.Math,Microsoft.VisualBasic", ",")

	Private refCompilerResults As System.CodeDom.Compiler.CompilerResults
	Private mNamespaceName As String = "hisdtDynamic"
	Private mClassName As String = "hisdtCodeRunTime"
	Private mObjectName As String = mNamespaceName & "." & mClassName
	Dim funEvalName As String = "functionRealEval"
	Private bCompiled As Boolean = False
	Private sbCode As New System.Text.StringBuilder

	Private m_AddClass As Boolean = True
	Private m_oCompilerErrors As New System.CodeDom.Compiler.CompilerErrorCollection

	Public Property AutoAddClass() As Boolean
		Get
			Return m_AddClass
		End Get
		Set(ByVal Value As Boolean)
			m_AddClass = Value
		End Set
	End Property


	Public Property [Imports]() As String()
		Get
			Return defaultImports
		End Get
		Set(ByVal Value As String())
			defaultImports = Value
		End Set
	End Property

	Public Property Assemblies() As String()
		Get
			Return defaultAssemblies
		End Get
		Set(ByVal Value As String())
			defaultAssemblies = Value
		End Set
	End Property

	Public Property CompilerErrors() As System.CodeDom.Compiler.CompilerErrorCollection
		Get
			Return m_oCompilerErrors
		End Get
		Set(ByVal Value As System.CodeDom.Compiler.CompilerErrorCollection)
			m_oCompilerErrors = Value
		End Set
	End Property

	Public Property Code() As String
		Get
			Return sbCode.ToString()
		End Get
		Set(ByVal Value As String)
			sbCode = New System.Text.StringBuilder(Value)
		End Set
	End Property

	Private Function GetImportsLines() As String
		Dim strReturn As String = "Imports " & Join(defaultImports, vbNewLine & "Imports ") & vbNewLine
		strReturn = strReturn.Replace("Imports " & vbNewLine, "")
		Return strReturn
	End Function

	Private Function CompilerCode(ByVal stringVBCode As String) As System.CodeDom.Compiler.CompilerResults
		Dim oCodeProvider As New VBCodeProvider
		Dim oCParams As New System.CodeDom.Compiler.CompilerParameters(defaultAssemblies)
		Dim rtnCompilerResults As System.CodeDom.Compiler.CompilerResults
		Dim sb As New System.Text.StringBuilder

		Try
			With oCParams
				.CompilerOptions = "/t:library"
				.GenerateExecutable = False
				.GenerateInMemory = True
			End With

			With sb
				.Append(GetImportsLines() & vbNewLine)
				.Append("Namespace " & mNamespaceName & vbNewLine)
				If m_AddClass Then
					.Append("Class " & mClassName & vbNewLine)
				End If

				.Append(stringVBCode & vbNewLine)

				If m_AddClass Then
					.Append("End Class " & vbNewLine)
				End If
				.Append("End Namespace" & vbNewLine)
				Debug.WriteLine(.ToString())
			End With

			Try
				rtnCompilerResults = oCodeProvider.CompileAssemblyFromSource(oCParams, sb.ToString)
				If rtnCompilerResults.Errors.Count <> 0 Then
					Me.CompilerErrors = rtnCompilerResults.Errors
					Throw New Exception("編譯錯誤")
				End If
			Catch ex As Exception
				Debug.WriteLine(ex.Message)
				Stop
			End Try
		Catch ex As Exception
			Debug.WriteLine(ex.Message)
			Stop
		End Try
		Return rtnCompilerResults
	End Function

	Private Function RunCode(ByVal hCompilerResults As System.CodeDom.Compiler.CompilerResults, ByVal procedureName As String, ByVal ParamArray parameters() As Object) As Object
		Dim oAssembly As System.Reflection.Assembly
		Dim oExecInstance As Object
		Dim oRetObj As Object
		Dim oMethodInfo As System.Reflection.MethodInfo
		Dim oType As Type

		Try
			oAssembly = hCompilerResults.CompiledAssembly
			oExecInstance = oAssembly.CreateInstance(mObjectName)

			oType = oExecInstance.GetType
			oMethodInfo = oType.GetMethod(procedureName)

			oRetObj = oMethodInfo.Invoke(oExecInstance, parameters)
			Return oRetObj
		Catch ex As Exception
			Debug.WriteLine(ex.Message)
			Return ex
		End Try
	End Function

	Public Function Run(ByVal procedureName As String, ByVal ParamArray parameters() As Object) As Object
		If Not bCompiled Then
			refCompilerResults = CompilerCode(sbCode.ToString())
		End If

		Return RunCode(refCompilerResults, procedureName, parameters)
	End Function

	Public Function AddCode(ByVal vbCodeExpression As String) As String
		sbCode.Append(vbCodeExpression & vbNewLine)
		bCompiled = False
		Return sbCode.ToString()
	End Function

	Public Sub Reset()
		bCompiled = False
		sbCode = New System.Text.StringBuilder
	End Sub

	Public Function Eval(ByVal vbCodeExpression As String) As Object
		Dim hCompilerResults As System.CodeDom.Compiler.CompilerResults
		Dim sb As New System.Text.StringBuilder
		Dim rtnValue As Object

		With sb
			.Append("Public Function " & funEvalName & "() As Object" & vbNewLine)
			.Append("Return " & vbCodeExpression & vbNewLine)
			.Append("End Function" & vbNewLine)
		End With
		hCompilerResults = CompilerCode(sb.ToString())
		rtnValue = RunCode(hCompilerResults, funEvalName)
		GC.Collect()
		Return rtnValue
	End Function

	Protected Overrides Sub Finalize()
		MyBase.Finalize()
		GC.Collect()
	End Sub
End Class