-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
d26d1a8
commit f8af6e7
Showing
11 changed files
with
637 additions
and
64 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,62 @@ | ||
| Option Strict On | ||
| Option Explicit On | ||
| Option Compare Text | ||
| Imports System.Runtime.InteropServices | ||
|
|
||
| <ComVisible(True)> | ||
| <Guid(Functions.InterfaceId)> | ||
| Public Interface ICLASS_FUNCTIONS | ||
| Function IFX() As String | ||
|
|
||
| Function TIMENOW() As String | ||
|
|
||
| End Interface | ||
| <ComVisible(True)> | ||
| <Guid(Functions.ClassId)> | ||
| <ProgId("AUTOMATION.Formulas")> | ||
| <ClassInterface(ClassInterfaceType.None)> | ||
| <ComDefaultInterface(GetType(ICLASS_FUNCTIONS))> | ||
| Public Class Functions | ||
| Implements ICLASS_FUNCTIONS | ||
|
|
||
| #Region "COM GUIDs" | ||
| ' These GUIDs provide the COM identity for this class and its COM interfaces. | ||
| ' If you change them, existing clients will no longer be able to access the class. | ||
|
|
||
| Public Const ClassId As String = "df32904d-DEAD-BEEF-9352-5dc0ceafa03e" | ||
| Public Const EventsId As String = "ca59b115-DEAD-BEEF-8375-a8f652d3258f" | ||
| Public Const InterfaceId As String = "6c409593-DEAD-BEEF-8c16-f3804714e174" | ||
| #End Region | ||
|
|
||
| ' A creatable COM class must have a Public Sub New() with no parameters, otherwise, the | ||
| ' class will not be registered in the COM registry and cannot be created via CreateObject. | ||
| Public Sub New() | ||
|
|
||
| MyBase.New() | ||
|
|
||
| End Sub | ||
|
|
||
| Private Function IFX() As String Implements ICLASS_FUNCTIONS.IFX | ||
|
|
||
| Return "AUTO FX OK" | ||
|
|
||
| End Function | ||
| Private Function TIMENOW() As String Implements ICLASS_FUNCTIONS.TIMENOW | ||
|
|
||
| EXCEL.Volatile() | ||
|
|
||
| Dim DT As Date | ||
|
|
||
| Dim TimeString As String | ||
|
|
||
| DT = Now | ||
|
|
||
| TimeString = DT.ToLongTimeString.ToString() & "." & DT.Millisecond.ToString("D3") | ||
|
|
||
| Return TimeString | ||
|
|
||
| End Function | ||
|
|
||
| End Class | ||
|
|
||
|
|
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,157 @@ | ||
| Imports Microsoft.Win32 | ||
| Imports System.Reflection | ||
| Imports System.Runtime.InteropServices | ||
| Imports System.Runtime.Remoting.Contexts | ||
|
|
||
| <ComVisible(False)> | ||
| <ClassInterface(ClassInterfaceType.None)> | ||
| Public Class Installer | ||
|
|
||
| Public ASSEMBLY_TYPE As Type | ||
| Public ASSEMBLY_GUID As String | ||
| Public ASSEMBLY_NAME As Assembly | ||
| Public ASSEMBLY_KEYNAME As String | ||
| Public ASSEMBLY_DISPLAY_NAME As String | ||
| Public REGISTRATION_SERVICES As RegistrationServices | ||
|
|
||
| Public Sub New() | ||
|
|
||
| MyBase.New() | ||
|
|
||
| InitializeComponent() 'This call is required by the Component Designer. | ||
|
|
||
| 'Add initialization code after the call to InitializeComponent | ||
|
|
||
| ASSEMBLY_TYPE = GetType(Functions) | ||
| ASSEMBLY_GUID = Functions.ClassId.ToUpper | ||
| ASSEMBLY_NAME = GetType(Functions).Assembly | ||
| ASSEMBLY_KEYNAME = "CLSID\{" & ASSEMBLY_GUID & "}\" | ||
| ASSEMBLY_DISPLAY_NAME = ASSEMBLY_NAME.FullName | ||
| REGISTRATION_SERVICES = New RegistrationServices | ||
|
|
||
| End Sub | ||
|
|
||
| Public Overrides Sub Install(stateSaver As IDictionary) | ||
|
|
||
| MyBase.Install(stateSaver) | ||
|
|
||
| REGISTER_ASSEMBLY() | ||
|
|
||
| UPDATE_REGISTRY_KEYS() | ||
|
|
||
| End Sub | ||
|
|
||
| Public Overrides Sub Commit(savedState As IDictionary) | ||
|
|
||
| MyBase.Commit(savedState) | ||
|
|
||
| End Sub | ||
|
|
||
| Public Overrides Sub Rollback(savedState As IDictionary) | ||
|
|
||
| MyBase.Rollback(savedState) | ||
|
|
||
| End Sub | ||
|
|
||
| Public Overrides Sub Uninstall(savedState As IDictionary) | ||
|
|
||
| MyBase.Uninstall(savedState) | ||
|
|
||
| REMOVE_REGISTRY_KEY() | ||
|
|
||
| UNREGISTER_ASSEMBLY() | ||
|
|
||
| End Sub | ||
|
|
||
| Public Sub REGISTER_ASSEMBLY() | ||
|
|
||
| Try | ||
|
|
||
| REGISTRATION_SERVICES.RegisterAssembly(ASSEMBLY_NAME, AssemblyRegistrationFlags.SetCodeBase) | ||
|
|
||
| Catch ex As Exception | ||
|
|
||
| Dim BOXTEXT As String = Nothing | ||
| BOXTEXT &= "Assembly Name = " & ASSEMBLY_DISPLAY_NAME & vbCrLf | ||
| BOXTEXT &= "Assembly GUID = " & ASSEMBLY_GUID & vbCrLf | ||
| BOXTEXT &= "Message = " & ex.Message | ||
|
|
||
| MsgBox(BOXTEXT, vbCritical + vbOKOnly, " Error Registering Assembly") | ||
|
|
||
| End Try | ||
|
|
||
| End Sub | ||
|
|
||
| Public Sub UPDATE_REGISTRY_KEYS() | ||
|
|
||
| Dim SetKey As RegistryKey = Nothing | ||
|
|
||
| Try | ||
|
|
||
| Registry.ClassesRoot.CreateSubKey(ASSEMBLY_KEYNAME & "Programmable") | ||
|
|
||
| SetKey = Registry.ClassesRoot.OpenSubKey(ASSEMBLY_KEYNAME & "InprocServer32", True) | ||
|
|
||
| SetKey.SetValue("", Environment.SystemDirectory & "\mscoree.dll", RegistryValueKind.String) | ||
|
|
||
| ' Environment.SystemDirectory = auto 32/64 bit | ||
|
|
||
| Registry.ClassesRoot.Close() | ||
|
|
||
| Catch ex As Exception | ||
|
|
||
| Dim BOXTEXT As String = Nothing | ||
| BOXTEXT &= "Assembly Name = " & ASSEMBLY_DISPLAY_NAME & vbCrLf | ||
| BOXTEXT &= "Assembly GUID = " & ASSEMBLY_GUID & vbCrLf | ||
| BOXTEXT &= "Registry Key = " & SetKey.ToString & vbCrLf | ||
| BOXTEXT &= "Message = " & ex.Message | ||
|
|
||
| MsgBox(BOXTEXT, vbCritical + vbOKOnly, " Error updating registry") | ||
|
|
||
| End Try | ||
|
|
||
|
|
||
| End Sub | ||
|
|
||
| Public Sub REMOVE_REGISTRY_KEY() | ||
|
|
||
| Try | ||
|
|
||
| Registry.ClassesRoot.DeleteSubKey(ASSEMBLY_KEYNAME & "Programmable") | ||
|
|
||
| Registry.ClassesRoot.Flush() | ||
|
|
||
| Catch ex As Exception | ||
|
|
||
| Dim BOXTEXT As String = Nothing | ||
| BOXTEXT &= "Assembly Name = " & ASSEMBLY_DISPLAY_NAME & vbCrLf | ||
| BOXTEXT &= "Assembly GUID = " & ASSEMBLY_GUID & vbCrLf | ||
| BOXTEXT &= "Registry SubKey = " & ASSEMBLY_KEYNAME & "Programmable" | ||
| BOXTEXT &= "Message = " & ex.Message | ||
|
|
||
| MsgBox(BOXTEXT, vbCritical + vbOKOnly, " Error deleting subkey") | ||
|
|
||
| End Try | ||
|
|
||
| End Sub | ||
|
|
||
| Public Sub UNREGISTER_ASSEMBLY() | ||
|
|
||
| Try | ||
|
|
||
| REGISTRATION_SERVICES.UnregisterAssembly(ASSEMBLY_NAME) | ||
|
|
||
| Catch ex As Exception | ||
|
|
||
| Dim BOXTEXT As String = Nothing | ||
| BOXTEXT &= "Assembly Name = " & ASSEMBLY_DISPLAY_NAME & vbCrLf | ||
| BOXTEXT &= "Assembly GUID = " & ASSEMBLY_GUID & vbCrLf | ||
| BOXTEXT &= "Message = " & ex.Message | ||
|
|
||
| MsgBox(BOXTEXT, vbCritical + vbOKOnly, " Error UnRegistering Assembly") | ||
|
|
||
| End Try | ||
|
|
||
| End Sub | ||
|
|
||
| End Class |
Oops, something went wrong.