EDOKA_Client/EDOKA/Backup/Utils/mMain.vb

Imports System.Windows.Forms
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Runtime.Serialization.Formatters.Binary

Imports System.IO

Imports EDOKALib.Common

Public Module mMain
    Public Class SerialHelper
        '///Class mercilessly ripped-off from Dr GUI.Net #3 :)
        Public Shared Function SerializeToBase64String(ByVal o As Object) As String
            Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
            Dim serialMemoryStream As New MemoryStream()
            formatter.Serialize(serialMemoryStream, o)
            Dim bytes() As Byte = serialMemoryStream.ToArray()
            Return Convert.ToBase64String(bytes).Trim()
        End Function

        Public Shared Function DeserializeFromBase64String(ByVal base64String As String) As Object
            Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
            base64String = base64String.Trim(ControlChars.NullChar)
            Dim bytes() As Byte = Convert.FromBase64String(base64String)
            Dim serialMemoryStream As New MemoryStream(bytes)
            Return formatter.Deserialize(serialMemoryStream)
        End Function
    End Class

    Public Class SingleInstance
        Public Interface ISingleInstanceForm
            Delegate Sub _WndProc(ByVal m As Message, ByRef Cancel As Boolean)
            Event WndProc As _WndProc
            ReadOnly Property Handle() As IntPtr
            Sub HandleCommand(ByVal strCmd As String)
        End Interface
#Region "API"
        Private Const WM_COPYDATA As Integer = &H4A

        <StructLayout(LayoutKind.Sequential)> _
        Public Structure COPYDATASTRUCT
            Public dwData As Integer
            Public cbData As Integer
            Public lpData As Integer
        End Structure

        Private Declare Auto Function GetProp Lib "user32" (ByVal hWnd As Integer, ByVal lpString As String) As Integer
        Private Declare Auto Function SetProp Lib "user32" (ByVal hWnd As Integer, ByVal lpString As String, ByVal hData As Integer) As Integer

        Private Delegate Function EnumWindowsProc(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
        Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWindowsProc, ByVal lParam As Integer) As Integer

        Private Declare Auto Function SendMessage Lib "user32" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer

        Public Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
        (ByVal windowHandle As IntPtr, _
        ByVal Msg As UInt16, _
        ByVal wParam As IntPtr, _
         ByRef lParam As COPYDATASTRUCT, _
        ByVal flags As SendMessageTimeoutFlags, _
        ByVal timeout As UInt16, _
        ByVal result As IntPtr) As IntPtr

        <Flags()> _
        Public Enum SendMessageTimeoutFlags As Short
            SMTO_NORMAL = &H0           '0x0000
            SMTO_BLOCK = &H1            ''0x0001
            SMTO_ABORTIFHUNG = &H2          '0x0002
            SMTO_NOTIMEOUTIFNOTHUNG = &H8           '0x0008
        End Enum


#End Region

#Region "EnumWindows"
        Private Shared _EWP As New EnumWindowsProc(AddressOf EWP)
        Private Shared Function EWP(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
            ' Customised windows enumeration procedure.  Stops
            ' when it finds another application with the Window
            ' property set, or when all windows are exhausted.
            Try
                If IsThisApp(hWnd) Then
                    _hWnd = hWnd
                    Return 0
                Else
                    Return 1
                End If
            Catch
                Return 0
            End Try
        End Function
        Private Shared Function IsThisApp(ByVal hWnd As Long) As Boolean
            ' Check if the windows property is set for this
            ' window handle:
            If GetProp(hWnd, _mcThisAppID & "_APPLICATION") = 1 Then
                Return True
            End If
        End Function

        Private Shared Function FindWindow() As Boolean
            If _hWnd = -1 Then
                EnumWindows(_EWP, 0)
                If _hWnd = -1 Then
                    Return False
                Else
                    Return True
                End If
            Else
                Return True
            End If
        End Function

        Private Shared Function SendCDSToWindow(ByVal CD As COPYDATASTRUCT) As Boolean
            Try
                Dim lpCD As IntPtr = Marshal.AllocHGlobal(Len(CD))
                Marshal.StructureToPtr(CD, lpCD, False)
                'SendMessage(_hWnd, WM_COPYDATA, _hWnd, lpCD)
                Dim result As IntPtr
                Dim retVal As IntPtr

                Dim handle As New IntPtr(_hWnd)

                retVal = SendMessageTimeout(handle, Convert.ToUInt16(WM_COPYDATA), handle, CD, SendMessageTimeoutFlags.SMTO_NORMAL, Convert.ToUInt16(2000), result)

                Marshal.FreeHGlobal(lpCD)

                Return True
            Catch ex As Exception
                TKBLib.Errorhandling.TraceHelper.Msg("EdokaApp.mMain.SendCDSToWindow", ex.Message & ex.StackTrace, TraceLevel.Error)
                Return False
            End Try
        End Function

        Private Shared Function SendMessageToWindow(ByVal strCmd As String) As Boolean
            If _hWnd = -1 Then Return False
            If Len(strCmd) = 0 Then
                Try
                    Dim CD As COPYDATASTRUCT
                    With CD
                        .dwData = 0
                        .cbData = 0
                        .lpData = 0
                    End With
                    Return SendCDSToWindow(CD)
                Catch
                    Return False
                End Try
            Else
                Try
                    Dim B() As Byte = Encoding.Default.GetBytes(strCmd)
                    Dim lpB As IntPtr = Marshal.AllocHGlobal(B.Length)
                    Marshal.Copy(B, 0, lpB, B.Length)

                    Dim CD As COPYDATASTRUCT
                    With CD
                        .dwData = 0
                        .cbData = B.Length
                        .lpData = lpB.ToInt32
                    End With
                    Erase B

                    Try
                        If SendCDSToWindow(CD) Then
                            Return True
                        Else
                            Return False
                        End If
                    Catch
                        Return False
                    Finally
                        Marshal.FreeHGlobal(lpB)
                    End Try

                Catch
                    Return False
                End Try
            End If
        End Function
        Private Shared Function SendMessageToWindow(ByVal oCmd As Object) As Boolean
            Try
                Dim strCmd As String = SerialHelper.SerializeToBase64String(oCmd)
                Return SendMessageToWindow(strCmd)
            Catch
                Return False
            End Try
        End Function
#End Region

        Private Shared _hWnd As Integer = -1
        Private Shared _mcThisAppID As String
        Private Shared oMutex As Threading.Mutex
        Private Shared _MutexOwned As Boolean = False
        Private Shared WithEvents MainForm As ISingleInstanceForm

        Shared Sub New()
            _mcThisAppID = Reflection.Assembly.GetExecutingAssembly().FullName
            oMutex = New Threading.Mutex(True, _mcThisAppID & "_APPLICATION_MUTEX", _MutexOwned)
            If Not _MutexOwned Then
                If Not FindWindow() Then
                    _MutexOwned = True
                End If
            End If
            AddHandler AppDomain.CurrentDomain.ProcessExit, AddressOf OnExit
        End Sub
        Private Shared Sub OnExit(ByVal sender As Object, ByVal e As EventArgs)
            Try
                If Not oMutex Is Nothing Then
                    oMutex.ReleaseMutex()
                    CType(oMutex, IDisposable).Dispose()
                    oMutex = Nothing
                End If
            Catch
                'Do Nothing
            End Try
        End Sub

        Public Shared ReadOnly Property IsFirstInstance() As Boolean
            Get
                Return _MutexOwned
            End Get
        End Property

        Public Shared Function NotifyPreviousWindow() As Boolean
            Return SendMessageToWindow(vbNullString)
        End Function
        Public Shared Function NotifyPreviousWindow(ByVal strText As String) As Boolean
            Return SendMessageToWindow(strText)
        End Function
        Public Shared Function NotifyPreviousWindow(ByVal oCmd As Object) As Boolean
            Return SendMessageToWindow(oCmd)
        End Function

        Public Shared Sub SetMainForm(ByVal frm As ISingleInstanceForm)
            MainForm = frm
            Try
                Dim hWnd As Integer = frm.Handle.ToInt32
                SetProp(hWnd, _mcThisAppID & "_APPLICATION", 1)
            Catch
                MainForm = Nothing
            End Try
        End Sub

        Private Shared Sub MainForm_WndProc(ByVal m As System.Windows.Forms.Message, ByRef Cancel As Boolean) Handles MainForm.WndProc
            Select Case m.Msg
                Case WM_COPYDATA
                    Dim B() As Byte
                    Try
                        Dim CD As COPYDATASTRUCT = m.GetLParam(GetType(COPYDATASTRUCT))
                        ReDim B(CD.cbData)
                        Dim lpData As IntPtr = New IntPtr(CD.lpData)
                        Marshal.Copy(lpData, B, 0, CD.cbData)
                        Dim strData As String = Encoding.Default.GetString(B)
                        TKBLib.Errorhandling.TraceHelper.Msg("EdokaApp.mMain.SingleeInstance.MainForm_WndProc", "Received Windows Msg " & strData, TraceLevel.Info)
                        MainForm.HandleCommand(strData)
                        Cancel = True
                    Catch
                        Cancel = False
                    Finally
                        Erase B
                    End Try

                Case Else
                    Cancel = False
            End Select
        End Sub
    End Class

    Private MainForm As EDOKAMain

    <STAThread()> Public Function Main(ByVal CmdArgs() As String) As Integer
        If SingleInstance.IsFirstInstance Then
            Try
                g_bRun = True
                MainForm = New EDOKAMain()

                MainForm.CmdArgsSimulated = CmdArgs

                SingleInstance.SetMainForm(MainForm)
                Application.Run(MainForm)
            Catch ex As Exception
                If Not Force_Exit Then
                    MsgBox(ex.Message)
                End If
            End Try
        Else
            g_bRun = True
            SingleInstance.NotifyPreviousWindow(CmdArgs)
        End If

    End Function
End Module