Initial
This commit is contained in:
295
Backup/EDOKA/Utils/mMain.vb
Normal file
295
Backup/EDOKA/Utils/mMain.vb
Normal file
@@ -0,0 +1,295 @@
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user