Visual Basic

Public Class clsClassFactory

#Region "Variables And Properties"
    Public Structure FieldInformation
        Public FieldID As Integer
        Public FieldName As String
        Public DataType As String
        Public DefaultValue As String
        Public AutoIncrement As Boolean
        Public AllowNull As Boolean
        Public SQLSyntax As String
        Public Regex As String
        Public LabelName As String
        Public DependencyID As Integer
    End Structure

    Dim intTemplateID As Integer
    Dim strTemplateEngName As String

    Dim fxFunctions As cFunctions
    Dim fxControls As cControls

    Public _dicFields As New Dictionary(Of Integer, FieldInformation)
    Public ReadOnly Property dicFields() As Dictionary(Of Integer, FieldInformation)
        Get
            Return _dicFields
        End Get
    End Property

    Private _dicControls As New Dictionary(Of Integer, clsPair)
    Public ReadOnly Property dicControls() As Dictionary(Of Integer, clsPair)
        Get
            Return _dicControls
        End Get
    End Property
#End Region

    Public Sub New(ByVal intTemplateID As Integer)
        Try
            fxFunctions = New cFunctions
            Dim strSql = String.Format("SELECT * FROM Fields WHERE Template_ID = {0}", intTemplateID)
            Using dtFields As DataTable = fxFunctions.FillDataTable(strSql, "Templates")
                For Each row As DataRow In dtFields.Rows
                    Dim struct As New FieldInformation
                    struct.FieldID = row("Field_Id")
                    struct.FieldName = row("Field_Name")
                    struct.DataType = row("Data_Type_ID")
                    struct.DefaultValue = row("Default_Value")
                    struct.AllowNull = row("Allow_Null")
                    struct.AutoIncrement = row("Auto_Increment")
                    struct.SQLSyntax = row("SQL_Syntax")
                    struct.Regex = row("Regex")
                    struct.LabelName = "lbl" & Replace(struct.FieldName, "_", "")
                    struct.DependencyID = row("Dependency_ID")
                    _dicFields.Add(struct.FieldID, struct)
                Next
            End Using

            Using dtTemp As DataTable = fxFunctions.FillDataTable(String.Format("SELECT * FROM Templates WHERE Template_ID = {0}", intTemplateID), "Templates")
                If dtTemp.Rows.Count <= 0 Then
                    Throw New Exception("Invalid Template ID")
                End If
                strTemplateEngName = dtTemp.Rows(0)("Template_Name").ToString
            End Using

            For Each pair As KeyValuePair(Of Integer, FieldInformation) In _dicFields
                ProcessFieldControl(pair.Value)
            Next
        Catch ex As Exception
            Throw New Exception(ex.Message)
        End Try
    End Sub

    Private Sub ProcessFieldControl(ByRef struc As FieldInformation)
        Dim objPair As clsPair
        Dim control As Control
        fxControls = New cControls
        Select Case struc.DataType
            Case 1 : control = New TextBox
                objPair = New clsPair("System.Windows.Forms.TextBox", control)
                _dicControls.Add(struc.FieldID, objPair)
                control.Name = "txt" & Replace(struc.FieldName, "_", "")
                control.Dock = DockStyle.Top

            Case 2
                If struc.AutoIncrement = True Then
                    control = New System.Windows.Forms.Label
                    CType(control, Windows.Forms.Label).TextAlign = Drawing.ContentAlignment.MiddleLeft
                    objPair = New clsPair("System.Windows.Forms.Label", control)
                Else
                    control = New NumericUpDown
                    objPair = New clsPair("System.Windows.Forms.NumericUpDown", control)
                End If

                _dicControls.Add(struc.FieldID, objPair)
                control.Name = "txt" & Replace(struc.FieldName, "_", "")
                control.Dock = DockStyle.Fill

            Case 5
                control = New ComboBox
                control.Name = "cbx" & Replace(struc.FieldName, "_", "")
                control.Dock = DockStyle.Fill
                objPair = New clsPair("System.Windows.Forms.ComboBox", control)
                Dim cbx As ComboBox = control
                cbx.BindingContext = New BindingContext()
                cbx.DropDownStyle = ComboBoxStyle.DropDownList
                fxControls.Fill_ListControl(cbx, struc.SQLSyntax, "DisplayMember", "ValueMember", "Select", "Templates")
                _dicControls.Add(struc.FieldID, objPair)




            Case 3
                control = New DateTimePicker
                objPair = New clsPair("System.Windows.Forms.DateTimePicker", control)
                _dicControls.Add(struc.FieldID, objPair)
                control.Name = "dtp" & Replace(struc.FieldName, "_", "")
                control.Dock = DockStyle.Fill
                Dim dtp As DateTimePicker = control
                dtp.Format = DateTimePickerFormat.Custom
                dtp.CustomFormat = "dd/MM/yyyy"


            Case 4
                control = New CheckBox
                control.Name = "chk" & Replace(struc.FieldName, "_", "")
                control.Text = struc.ArabicFieldName
                control.Dock = DockStyle.Fill
                objPair = New clsPair("System.Windows.Forms.CheckBox", control)
                Dim chk As CheckBox = control
                chk.AutoSize = False
                _dicControls.Add(struc.FieldID, objPair)
        End Select
    End Sub
    
    '#######################################################################
    'EMIT PART
    '#######################################################################

    Public Function clsCreateType() As Type

        'We define the dynamic assembly name
        Dim anDynamicAssembly As New AssemblyName
        anDynamicAssembly.Name = "ua" & strTemplateEngName.Replace("_", "")

        'Create a new dynamic assembly in the current appdomain, then a virtual module
        Dim abDynamicAssembly As AssemblyBuilder = System.AppDomain.CurrentDomain.DefineDynamicAssembly(anDynamicAssembly, AssemblyBuilderAccess.RunAndSave)
        Dim mbDynamicAssembly As ModuleBuilder = abDynamicAssembly.DefineDynamicModule("mod" & strTemplateEngName)

        'Define the dynamic class in the module
        Dim tbDynamicAssembly As TypeBuilder = mbDynamicAssembly.DefineType("cls" & strTemplateEngName, _
                                TypeAttributes.Public Or TypeAttributes.Class, _
                                GetType(Object), New Type() {GetType(ITemplate)})

        'Create the default constructor for this class
        'Dim cbDynamicAssemblyConstructor As ConstructorBuilder = _
        '    tbDynamicAssembly.DefineConstructor(MethodAttributes.Public, CallingConventions.Standard, Type.EmptyTypes)
        'Dim ilConstructor As ILGenerator = cbDynamicAssemblyConstructor.GetILGenerator
        'ilConstructor.Emit(OpCodes.Ldarg_0)
        'Dim ciObject As ConstructorInfo = GetType(Object).GetConstructor(Type.EmptyTypes)
        'ilConstructor.Emit(OpCodes.Call, ciObject)
        'ilConstructor.Emit(OpCodes.Ret)

        Dim fbCFunctions As FieldBuilder = tbDynamicAssembly.DefineField("fxFunctions", GetType(cFunctions), FieldAttributes.Public)
        Dim fbCControls As FieldBuilder = tbDynamicAssembly.DefineField("fxControls", GetType(cControls), FieldAttributes.Public)
        Dim fbCLog As FieldBuilder = tbDynamicAssembly.DefineField("fxLog", GetType(cLog), FieldAttributes.Public)

        Dim hsFields As New HashSet(Of FieldBuilder)
        For Each pair As KeyValuePair(Of Integer, FieldInformation) In dicFields
            Dim strFieldName As String = String.Empty
            Dim type As Type = GetType(String)
            Select Case pair.Value.DataType
                Case 1
                    type = GetType(String)
                    strFieldName = "str" & Replace(Replace(pair.Value.FieldName, "_", ""), " ", "")
                Case 2
                    type = GetType(Integer)
                    strFieldName = "int" & Replace(Replace(pair.Value.FieldName, "_", ""), " ", "")
                Case 3
                    type = GetType(Date)
                    strFieldName = "dt" & Replace(Replace(pair.Value.FieldName, "_", ""), " ", "")
                Case 4
                    type = GetType(Boolean)
                    strFieldName = "bool" & Replace(Replace(pair.Value.FieldName, "_", ""), " ", "")
                Case 5
                    type = GetType(String)
                    strFieldName = "lkp" & Replace(Replace(pair.Value.FieldName, "_", ""), " ", "")

            End Select
            Dim fBuilder As FieldBuilder = tbDynamicAssembly.DefineField(strFieldName, type, FieldAttributes.Public)
            hsFields.Add(fBuilder)
        Next


        Dim mbInsert As MethodBuilder = tbDynamicAssembly.DefineMethod("boolInsert", MethodAttributes.Public Or MethodAttributes.Virtual, CallingConventions.Standard, GetType(Boolean), Type.EmptyTypes)
        Dim ilInsert As ILGenerator = mbInsert.GetILGenerator()
        Dim lbAryCriteria As LocalBuilder = ilInsert.DeclareLocal(GetType(cFunctions.InsertCriteria()))
        ilInsert.Emit(OpCodes.Ldarg_0)
        ilInsert.Emit(OpCodes.Newobj, GetType(cFunctions).GetConstructor(Type.EmptyTypes))
        ilInsert.Emit(OpCodes.Stfld, fbCFunctions)
        'ilInsert.Emit(OpCodes.Ldarg_0)
        'ilInsert.Emit(OpCodes.Newarr, GetType(cFunctions.InsertCriteria()))
        'ilInsert.Emit(OpCodes.Starg_S, lbAryCriteria)
        ilInsert.Emit(OpCodes.Ldarg_0)
        ilInsert.Emit(OpCodes.Ldfld, fbCFunctions)
        ilInsert.Emit(OpCodes.Ldloc_S, lbAryCriteria)
        ilInsert.Emit(OpCodes.Ldstr, "Value")
        ilInsert.Emit(OpCodes.Ldstr, "xD")
        Dim miAddCriteria As MethodInfo = GetType(cFunctions).GetMethod("AddCriteria", New Type() {GetType(cFunctions.InsertCriteria()).MakeByRefType, GetType(String), GetType(Object)})
        ilInsert.Emit(OpCodes.Ldc_I4_0)
        ilInsert.Emit(OpCodes.Ret)



        Return tbDynamicAssembly.CreateType

    End Function


    Public Class cFunctions

     Public Structure InsertCriteria
      Dim strFieldName As String
      Dim objFieldValue As Object
     End Structure

      Public Sub AddCriteria(ByRef aryData() As cFunctions.InsertCriteria, ByVal strFieldName As String, ByVal strValue As Object)
          Dim lngNewBound As Long
          If (aryData Is Nothing) Then
              ReDim aryData(0)
              lngNewBound = 0
          Else
              lngNewBound = UBound(aryData) + 1
              ReDim Preserve aryData(lngNewBound)
          End If
          aryData(lngNewBound).strFieldName = strFieldName
          aryData(lngNewBound).objFieldValue = strValue
      End Sub 
    End Class

End Class

Public Interface ITemplate
  Function boolInsert() as Boolean
End Interface

Dim objClassFactory As New clsClassFactory(intTemplateID)
Dim obj As ITemplate = objClassFactory.clsCreateType().GetConstructor(Type.EmptyTypes).Invoke(Type.EmptyTypes)
'CType(obj, Object).fxFunctions = New cFunctions
obj.boolInsert()

Dim xl As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet

Dim misValue As Object = System.Reflection.Missing.Value

xl = New Microsoft.Office.Interop.Excel.ApplicationClass
xlWorkBook = xl.Workbooks.Add(misValue)


xlWorkBook = xl.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")

Private Sub BGWorker_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BGWorker.DoWork
       
       For Each file As String In My.Computer.FileSystem.GetFiles(drive.Name, FileIO.SearchOption.SearchAllSubDirectories) 'drive.name is a directory

                    'Check for cancelation of Background worker.
                    If BGWorker.CancellationPending Then
                        e.Cancel = True
                        Exit Sub
                    End If

          Dim extn As String = IO.Path.GetExtension(file)

                    Try
if extn.toUpper=".GPS" then
                            Me.RefreshList(file, FileType)
                        End If
                   
                    Catch ex As Exception
                        MsgBox(ex.Message)
                    End Try
                Next
            End If
        Next
    End Sub

Delegate Sub UpdateList(ByVal [FileName] As String, ByVal [FileType] As String)

Private Sub RefreshList(ByVal [FileName] As String, ByVal [FileType] As String)
              If frmMain.Listview1.InvokeRequired Then
            Dim d As New UpdateList(AddressOf RefreshList)
            frmMain.Listview1.Invoke(d, New Object() {[FileName], [FileType]})
        Else
            frmMain.Listview1.Items.Add([FileName].subitems.add([ThreatType])
        End If
    End Sub