Creating a classlibrary to imitate Excel interface

Imports System.Reflection
Imports System.Runtime.InteropServices
<ComClass(ImitateExcelClass.ClassId, ImitateExcelClass.InterfaceId, ImitateExcelClass.EventsId)>
Public Class ImitateExcelClass : Implements IImitateExcel
Public Const ClassId As String = "4704E096-9263-48D3-8527-1FB63BD0E1F9"
Public Const InterfaceId As String = "22937F2C-23C6-4E64-B503-1F3D304657F4"
Public Const EventsId As String = "1E0B3789-117B-49DC-9EF3-76C43FB9EDCA"
Public Sub New()
MyBase.New()
_Property1 = "readonly Property1"
_Property2 = "ImitateExcelClass Property2"
End Sub
Dim _Property1 As String
Public ReadOnly Property Property1 As String Implements IImitateExcel.Property1
Get
Return _Property1
End Get
End Property
Dim _Property2 As String
Public Property Property2 As String Implements IImitateExcel.Property2
Get
Return _Property2
End Get
Set(value As String)
_Property2 = value
End Set
End Property
Public Event MyEvent(p As Int64) Implements IImitateExcel_Event.MyEvent
Public Event MyEvent2 As IImitateExcel_Event.MyEvent2_Delegate Implements IImitateExcel_Event.MyEvent2
Public Function WhoAreYou(ByVal str As String) As String
Dim Assembly As Assembly = Assembly.GetExecutingAssembly()
WhoAreYou = $"{str}
Hi,I am Mr.Chen. How are you?
This DLL name is {IO.Path.GetFileName(Assembly.CodeBase)}.
Its version is {Assembly.GetName().Version}.
Good bye"
Call Do_RaiseEvent()
End Function
Public Sub Do_RaiseEvent()
RaiseEvent MyEvent(55667788)
RaiseEvent MyEvent2("<MyEvent2>")
End Sub
End Class
<ComImport>
<CoClass(GetType(ImitateExcelClass))>
<Guid(ImitateExcelClass.InterfaceId)>
Public Interface IImitateExcel : Inherits _IImitateExcel, IImitateExcel_Event
End Interface
<ComImport> <TypeLibType(4160S)>
<Guid(ImitateExcelClass.InterfaceId)>
Public Interface _IImitateExcel
ReadOnly Property Property1 As String
Property Property2 As String
End Interface
<TypeLibType(16S)>
<ComVisible(False)>
<Guid(ImitateExcelClass.EventsId)>
Public Interface IImitateExcel_Event
Delegate Sub MyEvent2_Delegate(str As String)
Event MyEvent(Password As Int64)
Event MyEvent2 As MyEvent2_Delegate
End Interface

Option Strict On
Imports Microsoft.Office.Interop
Module Module1
Dim Excel_Application As Excel.Application
Dim Workbook As Excel.Workbook
Dim Worksheet As Excel.Worksheet
Sub Main()
Try
Dim Type_ImitateExcelApp As Type = Type.GetTypeFromCLSID(
New Guid(SimpleCom.ImitateExcelClass.ClassId))
Dim ImitateExcelApp_obj As Object = Activator.CreateInstance(Type_ImitateExcelApp, nonPublic:=False)
Dim Event_MyEvent2 As Reflection.EventInfo =
Type_ImitateExcelApp.GetEvent("MyEvent2")
Dim Event_MyEvent As Reflection.EventInfo =
Type_ImitateExcelApp.GetEvent("MyEvent")
Dim MyEvent2_Delegate As SimpleCom.IImitateExcel_Event.MyEvent2_Delegate =
CType(AddressOf EventHandler_2_1, SimpleCom.IImitateExcel_Event.MyEvent2_Delegate)
Dim MyEventEventHandle As SimpleCom.IImitateExcel_Event.MyEventEventHandler =
CType(AddressOf EventHandler_1, SimpleCom.IImitateExcel_Event.MyEventEventHandler)
Event_MyEvent2.AddEventHandler(ImitateExcelApp_obj, MyEvent2_Delegate)
Event_MyEvent.AddEventHandler(ImitateExcelApp_obj, MyEventEventHandle)
Dim Method_WhoAreYou As Reflection.MethodInfo =
Type_ImitateExcelApp.GetMethod("WhoAreYou", New Type() {GetType(String)})
Dim Answer As Object = Method_WhoAreYou.Invoke(ImitateExcelApp_obj,
New Object() {"Do you know my password?"})
Console.WriteLine($"{CType(Answer, String)}")
Console.Write("Press any key to continue") : Console.ReadKey()
Dim Property_Property2 As Reflection.PropertyInfo =
Type_ImitateExcelApp.GetProperty("Property2")
Dim Property2_Value As Object = Property_Property2.GetMethod.Invoke(
ImitateExcelApp_obj, New Object() {})
Console.WriteLine($"{CType(Property2_Value, String)}")
Property_Property2.SetMethod.Invoke(
ImitateExcelApp_obj, New Object() {"I can set Property2 to any value "})
Property2_Value = Property_Property2.GetMethod.Invoke(
ImitateExcelApp_obj, New Object() {})
Console.WriteLine($"{CType(Property2_Value, String)}")
Console.Write("Press any key to continue") : Console.ReadKey()
Dim ImitateExcelApp As SimpleCom.ImitateExcelClass = CType(ImitateExcelApp_obj,
SimpleCom.ImitateExcelClass)
AddHandler ImitateExcelApp.MyEvent, (AddressOf EventHandler_1)
AddHandler ImitateExcelApp.MyEvent2, AddressOf EventHandler_2
ImitateExcelApp.Do_RaiseEvent()
Console.Write("Press any key to continue") : Console.ReadKey()
Excel_Application = New Excel.Application
Dim TypeData_ImitateExcelApp As New BrowseHtml(ImitateExcelApp.GetType())
TypeData_ImitateExcelApp.Show_type()
Dim TypeData_ExcelApp As New BrowseHtml(Excel_Application.GetType())
TypeData_ExcelApp.Show_type()
Console.Write("Press any key to continue") : Console.ReadKey()
Workbook = Excel_Application.Workbooks.Add()
Worksheet = CType(Workbook.Worksheets(1), Excel.Worksheet)
Workbook.Windows(1).Caption = "Imitate Excel interface"
Dim R As Excel.Range = Worksheet.Range("B2")
Worksheet.Hyperlinks.Add(Anchor:=R, Address:="http://www.google.com", TextToDisplay:="Google")
R = R.Offset(2, 2)
R.ColumnWidth = 15 * CDbl(R.ColumnWidth)
R.Value = Environment.CurrentDirectory
With Excel_Application
.OnDoubleClick = "MyMacro"
.ActiveWindow.WindowState = Excel.XlWindowState.xlMaximized
AddHandler .SheetBeforeDoubleClick, AddressOf Module1.SheetBeforeDoubleClick
.Visible = True
.ActiveWindow.Visible = True
End With
Console.Write("Press any key to exit ") : Console.ReadKey()
Catch ex As Exception
Console.WriteLine(ex.Message)
Console.Write("Press any key to exit ") : Console.ReadKey()
Finally
If Excel_Application IsNot Nothing Then
Excel_Application.DisplayAlerts = False
Excel_Application.Quit()
End If
End Try
End Sub
Sub EventHandler_1(p As Int64)
Console.WriteLine($"{p,40} =====> EventHandler_1")
End Sub
Sub EventHandler_2(str As String)
Console.WriteLine($"{str,40} =====> EventHandler_2")
End Sub
Sub EventHandler_2_1(str As String)
Console.WriteLine($"{str,40} =====> EventHandler_2-1")
End Sub
Private Sub SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Excel.Range, ByRef Cancel As Boolean)
Dim WorkSheet2 As Excel.Worksheet = DirectCast(Sh, Excel.Worksheet)
If Target.Row = 4 AndAlso Target.Column = 4 Then
Dim path As String = TryCast(Target.Value2, String)
If String.IsNullOrEmpty(path) Then Exit Sub
Dim DirectoryInfo As New IO.DirectoryInfo(path)
If DirectoryInfo.Exists Then
Dim Explorer As String = $"{Environment.GetEnvironmentVariable("SystemRoot")}\Explorer.exe"
Process.Start(Explorer,
$"/n /e,/select,{DirectoryInfo.FullName}\{IO.Path.GetFileName(Reflection.Assembly.GetExecutingAssembly.CodeBase)}")
End If
End If
End Sub
Class BrowseHtml
Public Shared msedge_exe As String =
IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86),
"Microsoft\Edge\Application\msedge.exe")
Shared HtmlFilePath1 As String = IO.Path.GetTempFileName
Shared HtmlFilePath2 As String = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Desktop),
IO.Path.GetRandomFileName)
Shared HtmlFilePath As String
Const Myblog As String = "MyBlog_8", Key As String = "ViewType"
Public HtmlFilePath1_type As String
Dim HtmlFilePath2_type As String
Dim HtmlFilePath_type As String
ReadOnly For_HtmlFilePath_type As Register_RunTime_data
Dim type_forShow As Type
Sub New([type] As Type)
HtmlFilePath1_type = IO.Path.GetTempFileName
HtmlFilePath2_type = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Desktop),
IO.Path.GetRandomFileName)
HtmlFilePath_type = String.Empty
type_forShow = [type]
For_HtmlFilePath_type = New Register_RunTime_data(Me)
End Sub
Protected Overrides Sub finalize()
For_HtmlFilePath_type.SaveHtmlFilePath2()
End Sub
Class Register_RunTime_data
ReadOnly Delegate_Finalize As System.Action
ReadOnly Name_Space, Type_Name, Module_Name As String
ReadOnly Parent As BrowseHtml
Sub New(Optional OldFilePath As Boolean = True)
If OldFilePath Then GetHtmlFilePath()
If String.IsNullOrEmpty(HtmlFilePath) Then
HtmlFilePath = IO.Path.ChangeExtension(HtmlFilePath2, "html")
End If
Delegate_Finalize = AddressOf SaveHtmlFilePath
End Sub
Sub New(Parent As BrowseHtml)
Name_Space = Parent.type_forShow.Namespace
Type_Name = Parent.type_forShow.Name
Module_Name = Parent.type_forShow.Module.Name
Me.Parent = Parent
GetHtmlFilePath2()
If String.IsNullOrEmpty(Parent.HtmlFilePath_type) Then
Parent.HtmlFilePath_type = IO.Path.ChangeExtension(Parent.HtmlFilePath1_type, "html")
End If
Delegate_Finalize = AddressOf SaveHtmlFilePath2
End Sub
Protected Overrides Sub finalize()
Delegate_Finalize()
End Sub
Public Sub GetHtmlFilePath()
Try
HtmlFilePath =
Interaction.GetSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,
Myblog, Key)
Catch ex As Exception
End Try
End Sub
Public Sub GetHtmlFilePath2()
Try
Parent.HtmlFilePath_type =
Interaction.GetSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,
Name_Space, Type_Name)
Catch ex As Exception
End Try
End Sub
Public Sub SaveHtmlFilePath()
Try
Interaction.SaveSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,
Myblog, Key, HtmlFilePath)
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Sub
Public Sub SaveHtmlFilePath2()
Try
Interaction.SaveSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,
Name_Space, Type_Name, Parent.HtmlFilePath_type)
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Sub
End Class
Public Shared Sub Show(Html_content As String)
Static For_HtmlFilePath As New Register_RunTime_data()
Using HtmlFile As New IO.StreamWriter(HtmlFilePath, False, Text.Encoding.UTF8),
BrowserProcess As New Process
HtmlFile.Write(Html_content)
HtmlFile.Flush()
BrowserProcess.StartInfo = New ProcessStartInfo(HtmlFilePath) With {
.Verb = "open",
.UseShellExecute = True
}
If Not BrowserProcess.Start() Then Throw New Exception("error in BrowserProcess")
End Using
End Sub
Public Sub Show_type()
Dim class1_Viewer As New Type_viewer(Me.type_forShow)
Dim Html_content As String = $"{class1_Viewer:W}"
Using HtmlFile As New IO.StreamWriter(HtmlFilePath_type, False, Text.Encoding.UTF8),
BrowserProcess As New Process
HtmlFile.Write(Html_content)
HtmlFile.Flush()
BrowserProcess.StartInfo = New ProcessStartInfo(HtmlFilePath_type) With {
.Verb = "open",
.UseShellExecute = True
}
If Not BrowserProcess.Start() Then Throw New Exception("error in BrowserProcess")
End Using
End Sub
End Class
Class Type_viewer : Implements IFormattable
Dim type As Type
Public Sub New(type As Type)
Me.type = type
End Sub
Shared ReadOnly Color_set() As String = {"", "white", "yellow", "green", "red", "red", "red"}
Shared depth_table As Int32 = 0
Shared Function Table_TR(ParamArray ByVal td As String()) As String
Return $"<tr style=""color:{Color_set(depth_table)};"">" &
String.Concat(td) &
"</tr>"
End Function
Shared Function Head_TD(str As String) As String
Return $"<td>{str}</td>"
End Function
Shared Function Middle_TD(mt As Object) As String
Dim part() As String = $"{mt}".Split(New Char() {" "c}, 2)
Return $"<td>{part(0)}</td><td>{part(1)}</td>"
End Function
Shared Function Tail_TR(mt As Object) As String
Return $"<td>{mt}</td>"
End Function
Public Function Display_WebPage_Table() As String
Static PageContent As New Text.StringBuilder
Dim peKind As Reflection.PortableExecutableKinds
Dim machine As Reflection.ImageFileMachine
If depth_table = 0 Then
PageContent.Clear()
[type].Module.GetPEKind(peKind, machine)
Dim title As String = $"<title>{[type].Name}</title>"
PageContent.Append(
"<!DOCTYPE html>
<html dir=""ltr"" , lang=""zh-tw"">
<head>
<meta charset=""utf-8"" />")
PageContent.Append(title)
PageContent.Append(
"<style>
table {
white-space: pre;
background-color: lightslategrey;
}
caption {
font-family: ""Courier New"";
background-color: hotpink;
font-style: italic;
text-align: left
}
tr {
background-color: black;
}
span {
white-space: pre;
font-style: italic;
background-color: black;
}
div.mark1 {
border-bottom: 8px ridge red;
border-top: 8px ridge #f00;
border-left: 8px ridge #f00;
}
div.mark2 {
white-space: pre;
font-style: italic;
background-color: black;
}
</style>
</head>
<body>" & $"<div><h3> machine={machine} peKind={peKind} </h3></div>")
End If
depth_table += 1
PageContent.Append("<table>")
PageContent.AppendLine(
$"<caption style=""color:{Color_set(depth_table)}"">{depth_table}-Namespace:{[type].Namespace} TypeName:{[type].Name} ModuleName:{[type].Module}" &
$"{vbNewLine}{type.GUID.ToString.ToUpper}</caption>")
Dim Constructors() As Reflection.ConstructorInfo = [type].GetConstructors()
For Each ctor As Reflection.ConstructorInfo In Constructors
PageContent.AppendLine(
Table_TR(Head_TD("Constructor"), Middle_TD(ctor), Tail_TR(ctor.DeclaringType)))
Next
Dim FieldInfos() As Reflection.FieldInfo =
[type].GetFields(Reflection.BindingFlags.Instance Or Reflection.BindingFlags.Public)
For Each field As Reflection.FieldInfo In FieldInfos
PageContent.AppendLine(
Table_TR(Head_TD("Field"), Middle_TD(field), Tail_TR(field.DeclaringType)))
Next
Dim PropertyInfos() As Reflection.PropertyInfo =
[type].GetProperties()
For Each _property As Reflection.PropertyInfo In PropertyInfos
PageContent.AppendLine(
Table_TR(Head_TD("Property"), Middle_TD(_property), Tail_TR(_property.DeclaringType)))
Next
Dim MethodInfos() As Reflection.MethodInfo =
[type].GetMethods(Reflection.BindingFlags.Instance Or Reflection.BindingFlags.Public)
For Each method As Reflection.MethodInfo In MethodInfos
PageContent.AppendLine(
Table_TR(Head_TD("Method"), Middle_TD(method), Tail_TR(method.DeclaringType)))
Next
Dim EventInfos() As Reflection.EventInfo =
[type].GetEvents(Reflection.BindingFlags.Instance Or Reflection.BindingFlags.Public)
For Each event_ As Reflection.EventInfo In EventInfos
PageContent.AppendLine(
Table_TR(Head_TD("Event"), Middle_TD(event_), Tail_TR(event_.DeclaringType)))
Next
Dim FieldInfos_Static() As Reflection.FieldInfo =
[type].GetFields(Reflection.BindingFlags.Static Or Reflection.BindingFlags.Public)
For Each field As Reflection.FieldInfo In FieldInfos_Static
PageContent.AppendLine(Table_TR(Head_TD("Field static"), Middle_TD(field), Tail_TR(field.DeclaringType)))
Next
Dim MethodInfos_Static() As Reflection.MethodInfo =
[type].GetMethods(Reflection.BindingFlags.Static Or Reflection.BindingFlags.Public)
For Each method As Reflection.MethodInfo In MethodInfos_Static
PageContent.AppendLine(
Table_TR(Head_TD("Method static"), Middle_TD(method), Tail_TR(method.DeclaringType)))
Next
Dim EventInfos_Static() As Reflection.EventInfo =
[type].GetEvents(Reflection.BindingFlags.Static Or Reflection.BindingFlags.Public)
For Each event_ As Reflection.EventInfo In EventInfos_Static
PageContent.AppendLine(
Table_TR(Head_TD("Event static"), Middle_TD(event_), Tail_TR(event_.DeclaringType)))
Next
PageContent.AppendLine("</table>")
Dim InterfaceInfos() As Type = [type].GetInterfaces()
For Each InterfaceType As Type In InterfaceInfos
PageContent.AppendLine("<div class=""mark1"">" &
$"<div class=""mark2"" style=""color: {Color_set(depth_table)};""> Interface {InterfaceType.FullName}" &
$"{vbNewLine}{InterfaceType.GUID.ToString.ToUpper} </div>")
Dim temp_type As Type = Me.type
Me.type = InterfaceType
Me.Display_WebPage_Table()
PageContent.AppendLine("</div>")
Me.type = temp_type
Next
Dim NestedTypeInfos() As Type =
[type].GetNestedTypes(Reflection.BindingFlags.Instance Or Reflection.BindingFlags.Public)
For Each NestedType As Type In NestedTypeInfos
PageContent.AppendLine("<div class=""mark1"">" &
$"<div class=""mark2"" style=""color:{Color_set(depth_table)};""> NestedType {NestedType.FullName} DeclaringType:{NestedType.DeclaringType}</div>")
Dim temp_type As Type = Me.type
Me.type = NestedType
Me.Display_WebPage_Table()
PageContent.AppendLine("</div>")
Me.type = temp_type
Next
depth_table -= 1
If depth_table = 0 Then
PageContent.AppendLine("</body></html>")
Return PageContent.ToString()
Else
Return Nothing
End If
End Function
Public Overloads Function ToString(format As String, formatProvider As IFormatProvider) As String Implements IFormattable.ToString
Select Case format.ToUpperInvariant(0)
Case "W"c
Return Display_WebPage_Table()
Case Else
Return ""
End Select
End Function
End Class
End Module