Imports TBench.TBench
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.CodeDom
Imports System.ComponentModel
Public Class Form1
Private Open As New OpenFileDialog
Private TestMethods
As New Dictionary(Of
String, MethodInfo
)
Private Sub PopulateArgumentList(ByVal GridItem As GridItem)
Dim Name As String = GridItem.Label
Dim Method As MethodInfo = Me.TestMethods(Name)
Dim Item As ListViewItem
Dim ParType As New System.Text.StringBuilder
lstArguments.Items.Clear()
For Each PI As ParameterInfo In Method.GetParameters
ParType.Remove(0, ParType.Length)
Item = New ListViewItem
Item.SubItems(0).Text = PI.Name
Item.SubItems.Add(PI.ParameterType.FullName)
If PI.IsOptional Then
ParType.Append("Optional ")
End If
If PI.ParameterType.IsByRef Then
ParType.Append("ByRef")
Else
ParType.AppendFormat("ByVal")
End If
Item.SubItems.Add(ParType.ToString)
lstArguments.Items.Add(Item)
Next
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Open.Filter = "Assembly|*.dll;*.exe"
CodeGenerator.LoadExpandable()
End Sub
Private Sub btnBrowse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
If Open.ShowDialog = Windows.Forms.DialogResult.OK Then
txtAssembly.Text = Open.FileName
End If
End Sub
Private Sub btnAnalyze_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAnalyze.Click
If String.
IsNullOrEmpty(txtAssembly.
Text) OrElse
(Not IO.
File.
Exists(txtAssembly.
Text)) Then MessageBox.Show("Inserire un percorso valido per l'assembly!", "TBench", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Dim M As New TBenchManager(txtAssembly.Text)
Dim BMethods As List(Of MethodInfo)
Dim Item As ListViewItem
Dim Attr As TBenchAttribute
BMethods = M.GetBenchMethods
lstAllMethods.Items.Clear()
For Each MI As MethodInfo In BMethods
Attr = MI.GetCustomAttributes(GetType(TBenchAttribute), False)(0)
Item = New ListViewItem
Item.SubItems(0).Text = MI.Name
Item.SubItems.Add(Attr.Name)
Item.SubItems.Add(Attr.Group)
Item.SubItems.Add(MI.DeclaringType.FullName)
Item.Checked = True
Item.Tag = MI
lstAllMethods.Items.Add(Item)
Next
End Sub
Private Sub btnArguments_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnArguments.Click
Dim Code As New System.Text.StringBuilder
Dim MI As MethodInfo
Dim Arguments() As ParameterInfo
Dim Attr As TBenchAttribute
Code.AppendLine("Imports System")
Code.AppendLine("Imports System.ComponentModel")
Code.AppendLine(CodeGenerator.UniversalConverter)
Code.AppendLine("Public Class Arguments")
TestMethods.Clear()
For Each Item As ListViewItem In lstAllMethods.CheckedItems
MI = Item.Tag
Arguments = MI.GetParameters
TestMethods.Add(MI.Name, MI)
If Arguments IsNot Nothing AndAlso Arguments.Length > 0 Then
CodeGenerator.CodeIndent = 8
Code.AppendFormat(" Public Class Type_{0}{1}", MI.Name, vbCrLf)
For Each PI As ParameterInfo In Arguments
If Not PI.ParameterType.FullName.Contains("System") Then
MessageBox.Show(MI.Name & " richiede dei parametri non appartenenti al Framework .Net. Impossibile proseguire!", "TBench", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
'Code.Append(Me.GetFieldText(PI.Name, PI.ParameterType.FullName, 8))
'Code.Append(Me.GetPropertyText(PI.Name, PI.ParameterType.FullName, "Parametri", "Inserire un valore di tipo " & PI.ParameterType.Name & ".", 8, False))
Code.Append(CodeGenerator.GetFieldText(PI))
Code.Append(CodeGenerator.GetPropertyText(PI))
Next
Code.AppendFormat(" End Class{0}{0}", vbCrLf)
CodeGenerator.CodeIndent = 4
'Code.Append(Me.GetExpandable(ClassType, Arguments, 4))
'Code.Append(Me.GetFieldText(MI.Name, ClassType, 4))
'Code.Append(Me.GetPropertyText(MI.Name, ClassType, Attr.Group, Description, 4))
Code.Append(CodeGenerator.GetExpandable(MI))
Code.Append(CodeGenerator.GetFieldText(MI))
Code.Append(CodeGenerator.GetPropertyText(MI))
Else
Code.AppendFormat(" Public Class Type_{0}{1}", MI.Name, vbCrLf)
Code.AppendFormat(" 'Vuoto{0}", vbCrLf)
Code.AppendFormat(" End Class{0}", vbCrLf)
CodeGenerator.CodeIndent = 4
'Code.Append(Me.GetFieldText(MI.Name, ClassType, 4))
'Code.Append(Me.GetPropertyText(MI.Name, ClassType, Attr.Group, Description, 4, False))
Code.Append(CodeGenerator.GetFieldText(MI))
Code.Append(CodeGenerator.GetPropertyText(MI))
End If
Next
Code.AppendLine("End Class")
Dim Params As New Compiler.CompilerParameters
Dim CodeProvider As New VBCodeProvider
Dim Result As Compiler.CompilerResults
Dim Asm As Assembly
Params.GenerateExecutable = False
Params.ReferencedAssemblies.Add("System.dll")
Params.ReferencedAssemblies.Add("System.Xml.dll")
Result = CodeProvider.CompileAssemblyFromSource(Params, Code.ToString)
IO.
File.
WriteAllText(Application.
StartupPath & "\Codice.vb", Code.
ToString) If Result.Errors.Count > 0 Then
Dim Errors As New System.Text.StringBuilder
For Each [Error] As Compiler.CompilerError In Result.Errors
Errors.AppendFormat("Linea: {0}{1}Messaggio: {2}{1}{1}", [Error].Line, vbCrLf, [Error].ErrorText)
Next
IO.
File.
WriteAllText(Application.
StartupPath & "\Errors.txt", Errors.
ToString) MessageBox.Show("Si sono verificati errori nel codice generato. E' probabile che uno dei parametri analizzati non sia convertibile in stringa. Consultare il file Errors.txt per maggiori informazioni.", "TBench", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Asm = Result.CompiledAssembly
CodeProvider.Dispose()
Dim Arg As Object = Asm.CreateInstance("Arguments")
pgArguments.SelectedObject = Arg
btnTest.Enabled = True
End Sub
Private Sub pgArguments_SelectedGridItemChanged(ByVal sender As System.Object, ByVal e As System.Windows.Forms.SelectedGridItemChangedEventArgs) Handles pgArguments.SelectedGridItemChanged
If e.NewSelection.Expandable Then
Me.PopulateArgumentList(e.NewSelection)
Else
If e.NewSelection.Parent IsNot Nothing Then
'...
Else
lstArguments.Items.Clear()
End If
End If
End Sub
Private Sub btnTest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTest.Click
If TestMethods.Count = 0 Then
MessageBox.Show("Nessun metodo selezionato!", "TBench", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Dim Temp
As New Dictionary(Of MethodInfo, List
(Of
Object))
For Each PI As PropertyInfo In pgArguments.SelectedObject.GetType.GetProperties
'Proprietà -> Metodo
Dim Obj As Object = PI.GetValue(pgArguments.SelectedObject, Nothing)
Dim Objs As New List(Of Object)
'Proprietà -> Parametro del metodo
For Each ObjPI As PropertyInfo In Obj.GetType.GetProperties
Objs.Add(ObjPI.GetValue(Obj, Nothing))
Next
Temp.Add(TestMethods(PI.Name), Objs)
Next
Dim Result As BenchReport
Dim M As New TBenchManager()
Try
Result = M.Bench(Temp, 1)
Catch Ex As Exception
MessageBox.Show("Si è verificato un errore nel testing. Probabilmente non hai assegnato tutti i valori correttamente ai parametri dei metodi da testare.", "TBench", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End Try
lblResult.Text = String.Format("Test di benchmarking completato: {0} metodi testati in {1} secondi.", Result.TotalMethods, Result.TotalTime)
tabResults.TabPages.Clear()
For Each Group As GroupResult In Result.Groups
Dim Tab As New TabPage
Dim List As New ListView
Group.MakeComparison()
List.View = View.Details
List.FullRowSelect = True
List.GridLines = True
List.Dock = DockStyle.Fill
List.Columns.Add("Nome / Alias", 150)
List.Columns.Add("Tempo impiegato", 120)
List.Columns.Add("Comparazione", 150)
AddHandler List.ColumnClick, AddressOf ResultLists_ColumnClick
For Each Method As MethodResult In Group
List.Items.Add(New ListViewItem(New String() {Method.Name, String.Format("{0:N0} ms", Method.Time.Value), Method.Comparation}))
Next
Tab.Text = Group.Name
Tab.Controls.Add(List)
tabResults.TabPages.Add(Tab)
Next
End Sub
Private Sub ResultLists_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs)
Select Case e.Column
Case 0
DirectCast(sender, ListView).Sort()
End Select
End Sub
End Class
