MErge inkl Globif Finalisierung

This commit is contained in:
SchreiberM 2021-01-19 13:20:26 +01:00
commit d8f25ecbd2
22 changed files with 333 additions and 1964 deletions

View File

@ -1,67 +0,0 @@
Imports System.Runtime.InteropServices
Public Class ClassClipboardWatcher
Inherits NativeWindow
Implements IDisposable
Private Class Win32
<DllImport("user32", EntryPoint:="SetClipboardViewer")>
Public Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr
End Function
End Class
Const WM_DRAWCLIPBOARD As Integer = &H308
Public Event ClipboardChanged As EventHandler(Of IDataObject)
Public Shared Singleton As New ClassClipboardWatcher
Private _handle As IntPtr
Private Sub New()
MyBase.CreateHandle(New CreateParams)
_handle = Win32.SetClipboardViewer(Handle)
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_DRAWCLIPBOARD
Dim oData As IDataObject = Clipboard.GetDataObject
RaiseEvent ClipboardChanged(Me, oData)
End Select
MyBase.WndProc(m)
End Sub
#Region "IDisposable Support"
' Für diese Klasse ist korrekte Ressourcenbereinigung besonders wichtig, da
' mit systemübergreifenden Ressourcen gearbeitet wird
' So ermitteln Sie überflüssige Aufrufe
Private disposedValue As Boolean = False
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
' TODO: Verwaltete Ressourcen freigeben, wenn sie explizit
' aufgerufen werden
End If
MyBase.DestroyHandle()
Dim H As IntPtr = Win32.SetClipboardViewer(_handle)
End If
disposedValue = True
End Sub
' Dieser Code wird von Visual Basic hinzugefügt, um das Dispose-Muster
' richtig zu implementieren.
Public Sub Dispose() Implements IDisposable.Dispose
' Sie sollten diesen Code nicht ändern, sondern stattdessen ihren
' Bereinigungscode oben in
' Dispose(ByVal disposing As Boolean) einfügen.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
Dispose(False)
End Sub
#End Region
End Class

View File

@ -18,7 +18,12 @@
Public Const ATTR_TYPE_INTEGER = "BIG INTEGER"
Public Const ATTR_TYPE_DATE = "DATE"
Public Const ATTR_TYPE_BOOLEAN = "BIT"
Public Const VECTORSEPARATOR = ""
Public Const SERVICE_ADDRESS_SEPARATOR = ":"
Public Const HOTKEY_TOGGLE_WATCHER = 354522017
Public Const HOTKEY_TRIGGER_WATCHER = 354523017
Public Const SQLCMD_FLOW_SEARCH1 = "FLOW_SEARCH1"

View File

@ -1,3 +1,15 @@
Public Class ClassEnvironment
Imports DigitalData.Modules.ZooFlow
Public Class ClassEnvironment
Public Shared Function GetEnvironment() As Environment
Dim oEnvironment As New Environment() With {
.DatabaseIDB = My.DatabaseIDB,
.Database = My.Database,
.Modules = My.Application.Modules,
.Service = My.Application.Service,
.Settings = My.Application.Settings,
.User = My.Application.User
}
Return oEnvironment
End Function
End Class

View File

@ -14,8 +14,10 @@ Public Class ClassInit
Private _MainForm As frmFlowForm
Private _Logger As Logger
Private _LogConfig As LogConfig
Public Event Completed As EventHandler
Private _DataASorDB As ClassDataASorDB
Private _Loader As ClassInitLoader
Public Event Completed As EventHandler
Public Sub New(LogConfig As LogConfig, ParentForm As frmFlowForm)
_MainForm = ParentForm
@ -37,22 +39,23 @@ Public Class ClassInit
MsgBox("Keine Verbindungs-Informationen hinterlegt. Anwendung wird beendet.", MsgBoxStyle.Critical, _MainForm.Text)
Application.Exit()
Else
Dim oInit As New ClassInitLoader()
_Loader = New ClassInitLoader()
' === Init Schritte definieren
oInit.AddStep("Checking connectivity..", AddressOf CheckConnectivity, True)
oInit.AddStep("Initializing User..", AddressOf InitializeUser, True)
oInit.AddStep("Initializing IDB Database..", AddressOf InitializeIDBDatabase, True)
oInit.AddStep("Initializing IDB Service..", AddressOf InitializeIDBService, True)
oInit.AddStep("Initializing Language..", AddressOf InitializeLanguage, False)
oInit.AddStep("Loading 3rd-party licenses..", AddressOf Initialize3rdParty, False)
oInit.AddStep("Loading Basic Configs..", AddressOf InitBasicData, False)
_Loader.AddStep("Checking connectivity..", AddressOf CheckConnectivity, True)
_Loader.AddStep("Initializing User..", AddressOf InitializeUser, True)
_Loader.AddStep("Initializing IDB Database..", AddressOf InitializeIDBDatabase, True)
_Loader.AddStep("Initializing IDB Service..", AddressOf InitializeIDBService, True)
_Loader.AddStep("Initializing Language..", AddressOf InitializeLanguage, False)
_Loader.AddStep("Initializing Clipboard Watcher..", AddressOf InitializeClipboardWatcher, False)
_Loader.AddStep("Loading 3rd-party licenses..", AddressOf Initialize3rdParty, False)
_Loader.AddStep("Loading Basic Configs..", AddressOf InitBasicData, False)
' === Init Schritte definieren
AddHandler oInit.ProgressChanged, AddressOf ProgressChanged
AddHandler oInit.InitCompleted, AddressOf InitCompleted
AddHandler _Loader.ProgressChanged, AddressOf ProgressChanged
AddHandler _Loader.InitCompleted, AddressOf InitCompleted
oInit.Run()
_Loader.Run()
End If
End Sub
@ -97,6 +100,7 @@ Public Class ClassInit
My.Application.User = oMyApplication.User
My.Application.Modules = oMyApplication.Modules
My.Application.ModulesActive = oMyApplication.ModulesActive
My.Application.ClipboardWatcher = oMyApplication.ClipboardWatcher
RaiseEvent Completed(sender, Nothing)
End If
@ -128,11 +132,9 @@ Public Class ClassInit
Dim oRow As DataRow = oDatatable.Rows.Item(0)
MyApplication.Settings.GdPictureKey = NotNull(oRow.Item("LICENSE"), String.Empty)
My.Application.Settings.GdPictureKey = NotNull(oRow.Item("LICENSE"), String.Empty)
My.Application.GDPictureLicense = My.Application.Settings.GdPictureKey
Catch ex As Exception
_Logger.Error(ex)
Throw New InitException("Error initializing3rdParty!")
Throw New InitException("Error initializing3rdParty!", ex)
End Try
End Sub
Private Sub InitBasicData(MyApplication As My.MyApplication)
@ -157,7 +159,7 @@ Public Class ClassInit
Next
Catch ex As Exception
_Logger.Error(ex)
Throw New InitException("Error in InitBasicData")
Throw New InitException("Error in InitBasicData", ex)
End Try
End Sub
@ -183,7 +185,7 @@ Public Class ClassInit
Catch ex As Exception
_Logger.Error(ex)
Throw New InitException("Error in InitBasicData")
Throw New InitException("Error in InitBasicData", ex)
End Try
End Sub
@ -253,7 +255,40 @@ Public Class ClassInit
Catch ex As Exception
_Logger.Error(ex)
Throw ex
Throw New InitException("Error while initializing user!", ex)
End Try
End Sub
Private Sub InitializeClipboardWatcher(MyApplication As My.MyApplication)
Try
Dim oUserId = My.Application.User.UserId
Dim oWhereClause = $"T1.USER_ID = {oUserId} OR GROUP_ID IN (SELECT DISTINCT GUID FROM TBDD_GROUPS WHERE GUID IN (SELECT GROUP_ID FROM TBDD_GROUPS_USER WHERE USER_ID = {oUserId}))"
Dim oProfileSQL As String = $"SELECT DISTINCT GUID, NAME,REGEX_EXPRESSION,COMMENT,PROC_NAME,PROFILE_TYPE FROM VWCW_USER_PROFILE T1 WHERE {oWhereClause}"
Dim oProcessSQL As String = $"SELECT DISTINCT T.GUID, T.PROFILE_ID,T.PROC_NAME FROM TBCW_PROFILE_PROCESS T, VWCW_USER_PROFILE T1 WHERE T.PROFILE_ID = T1.GUID AND ({oWhereClause})"
Dim oWindowSQL As String = $"SELECT DISTINCT T.* FROM VWCW_PROFILE_REL_WINDOW T, VWCW_USER_PROFILE T1 WHERE T.PROFILE_ID = T1.GUID AND ({oWhereClause})"
Dim oControlSQL As String = $"SELECT DISTINCT T.* FROM VWCW_PROFILE_REL_CONTROL T, VWCW_USER_PROFILE T1 WHERE T.PROFILE_ID = T1.GUID AND ({oWhereClause})"
Dim oUserProfiles = My.Database.GetDatatable(oProfileSQL)
If oUserProfiles Is Nothing OrElse oUserProfiles.Rows.Count = 0 Then
MyApplication.ClipboardWatcher.Status = ClipboardWatcher.State.EnumStatus.NoProfilesConfigured
End If
Dim oProfileProcesses = My.Database.GetDatatable(oProcessSQL)
Dim oProfileWindows = My.Database.GetDatatable(oWindowSQL)
Dim oProfileControls = My.Database.GetDatatable(oControlSQL)
MyApplication.ClipboardWatcher.Status = ClipboardWatcher.State.EnumStatus.OK
MyApplication.ClipboardWatcher.UserProfiles = oUserProfiles
MyApplication.ClipboardWatcher.ProfileProcesses = oProfileProcesses
MyApplication.ClipboardWatcher.ProfileWindows = oProfileWindows
MyApplication.ClipboardWatcher.ProfileControls = oProfileControls
MyApplication.ClipboardWatcher.MonitoringActive = True
Catch ex As Exception
MyApplication.ClipboardWatcher.Status = ClipboardWatcher.State.EnumStatus.Exception
_Logger.Error(ex)
Throw New InitException("Error while initializing clipboard watcher!", ex)
End Try
End Sub
@ -278,7 +313,6 @@ Public Class ClassInit
MyApplication.User.Language = NotNull(oValue.ToString, "de-DE")
End Select
End Sub
Private Sub HandleModuleInfo(MyApplication As My.MyApplication, ModuleName As String, Row As DataRow)
Dim oValue As Object = Row.Item("VALUE")
Dim oName As String = Row.Item("NAME").ToString

View File

@ -1,4 +1,5 @@
Imports System.ComponentModel
Imports DigitalData.GUIs.ZooFlow.My
Imports DigitalData.Modules.Logging
Public Class ClassInitLoader
@ -52,6 +53,13 @@ Public Class ClassInitLoader
Try
oStep.Action.Invoke(oMyApplication)
My.Application.Settings = oMyApplication.Settings
My.Application.User = oMyApplication.User
My.Application.Modules = oMyApplication.Modules
My.Application.ModulesActive = oMyApplication.ModulesActive
My.Application.ClipboardWatcher = oMyApplication.ClipboardWatcher
Catch ex As Exception
_Logger.Error(ex)
_Logger.Warn("Init Step '{0}' failed!", oStep.Name)

View File

@ -1,6 +1,17 @@
Imports System.Runtime.InteropServices
Public Class ClassWin32
Public Const ULW_COLORKEY As Int32 = &H1
Public Const ULW_ALPHA As Int32 = &H2
Public Const ULW_OPAQUE As Int32 = &H4
Public Const AC_SRC_OVER As Byte = &H0
Public Const AC_SRC_ALPHA As Byte = &H1
Public Const WM_NCLBUTTONDOWN As Integer = &HA1
Public Const HTCAPTION As Integer = &H2
Public Const WM_DRAWCLIPBOARD As Integer = &H308
Public Enum Bool
[False] = 0
[True]
@ -44,40 +55,51 @@ Public Class ClassWin32
Public AlphaFormat As Byte
End Structure
Public Const ULW_COLORKEY As Int32 = &H1
Public Const ULW_ALPHA As Int32 = &H2
Public Const ULW_OPAQUE As Int32 = &H4
Public Const AC_SRC_OVER As Byte = &H0
Public Const AC_SRC_ALPHA As Byte = &H1
Public Const WM_NCLBUTTONDOWN As Integer = &HA1
Public Const HTCAPTION As Integer = &H2
<DllImport("user32.dll", ExactSpelling:=True, SetLastError:=True)>
Public Shared Function UpdateLayeredWindow(ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pprSrc As Point, ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Bool
End Function
<DllImport("user32.dll", ExactSpelling:=True, SetLastError:=True)>
Public Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", ExactSpelling:=True)>
Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer
End Function
<DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
Public Shared Function CreateCompatibleDC(ByVal hDC As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
Public Shared Function DeleteDC(ByVal hdc As IntPtr) As Bool
End Function
<DllImport("gdi32.dll", ExactSpelling:=True)>
Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
End Function
<DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Bool
End Function
<DllImport("User32.dll")>
Public Shared Function ReleaseCapture() As Boolean
End Function
<DllImport("User32.dll")>
Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImport("user32", EntryPoint:="AddClipboardFormatListener")>
Public Shared Function AddClipboardFormatListener(ByVal hWnd As IntPtr) As Boolean
End Function
<DllImport("user32", EntryPoint:="RemoveClipboardFormatListener")>
Public Shared Function RemoveClipboardFormatListener(ByVal hWnd As IntPtr) As Boolean
End Function
<DllImport("user32", EntryPoint:="SetClipboardViewer")>
Public Shared Function SetClipboardViewer(ByVal hWnd As IntPtr) As IntPtr
End Function
End Class

View File

@ -1,8 +1,25 @@
Namespace ClipboardWatcher
Imports DigitalData.Modules.ZooFlow.Params
Namespace ClipboardWatcher
Public Class State
Public UserProfiles As DataTable
Public ProfileProcesses As DataTable
Public ProfileWindows As DataTable
Public ProfileControls As DataTable
Public Enum EnumStatus
OK
NoProfilesConfigured
Exception
End Enum
Public UserProfiles As DataTable = Nothing
Public ProfileProcesses As DataTable = Nothing
Public ProfileWindows As DataTable = Nothing
Public ProfileControls As DataTable = Nothing
Public MatchTreeView As TreeView = New TreeView()
Public Property CurrentMatchingProfiles As List(Of ProfileData) = New List(Of ProfileData)
Public Property CurrentProfilesWithResults As List(Of ProfileData) = New List(Of ProfileData)
Public Property CurrentClipboardContents As String = String.Empty
Public Property MonitoringActive As Boolean = False
Public Property Status As EnumStatus
End Class
End Namespace

View File

@ -0,0 +1,64 @@
Imports System.Runtime.InteropServices
Namespace ClipboardWatcher
Public Class Watcher
Inherits NativeWindow
Implements IDisposable
Public Event ClipboardChanged As EventHandler(Of IDataObject)
Public Shared Singleton As New Watcher
Private _Handle As IntPtr
Private Sub New()
MyBase.CreateHandle(New CreateParams)
_Handle = ClassWin32.SetClipboardViewer(Handle)
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case ClassWin32.WM_DRAWCLIPBOARD
Dim oData As IDataObject = Clipboard.GetDataObject
RaiseEvent ClipboardChanged(Me, oData)
End Select
MyBase.WndProc(m)
End Sub
#Region "IDisposable Support"
' Für diese Klasse ist korrekte Ressourcenbereinigung besonders wichtig, da
' mit systemübergreifenden Ressourcen gearbeitet wird
' So ermitteln Sie überflüssige Aufrufe
Private _DisposedValue As Boolean = False
Protected Overridable Sub Dispose(ByVal pDisposing As Boolean)
If Not _DisposedValue Then
If pDisposing Then
' TODO: Verwaltete Ressourcen freigeben, wenn sie explizit
' aufgerufen werden
End If
MyBase.DestroyHandle()
Dim H As IntPtr = ClassWin32.SetClipboardViewer(_Handle)
End If
_DisposedValue = True
End Sub
' Dieser Code wird von Visual Basic hinzugefügt, um das Dispose-Muster
' richtig zu implementieren.
Public Sub Dispose() Implements IDisposable.Dispose
' Sie sollten diesen Code nicht ändern, sondern stattdessen ihren
' Bereinigungscode oben in
' Dispose(ByVal disposing As Boolean) einfügen.
Dispose(True)
System.GC.SuppressFinalize(Me)
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
Dispose(False)
End Sub
#End Region
End Class
End Namespace

View File

@ -2,6 +2,7 @@
Imports DigitalData.Modules.Logging
Imports Oracle.ManagedDataAccess.Client
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.Modules.Language.Utils
Public Class GlobixControls
Private Property Form As frmGlobix_Index

View File

@ -2,6 +2,7 @@
Imports DevExpress.XtraEditors
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Language.Utils
Public Class GlobixPatterns
Private _Logger As Logger

View File

@ -113,7 +113,7 @@
<ItemGroup>
<Compile Include="ApplicationEvents.vb" />
<Compile Include="Base\BaseClass.vb" />
<Compile Include="ClassClipboardWatcher.vb" />
<Compile Include="ClipboardWatcher\Watcher.vb" />
<Compile Include="ClassCommandlineArgs.vb" />
<Compile Include="ClassDataASorDB.vb" />
<Compile Include="Globix\ClassEmailHeaderExtractor.vb" />

File diff suppressed because it is too large Load Diff

View File

@ -26,6 +26,8 @@ Public Class ImportZUGFeRDFiles
Public Const ZUGFERD_ATTACHMENTS = "ZUGFeRD Attachments"
Public HISTORY_ID As Integer
Private Const DIRECTORY_DONT_MOVE = "DIRECTORY_DONT_MOVE"
' List of allowed extensions for PDF/A Attachments
' This list should not contain xml so the zugferd xml file will be filtered out
Private ReadOnly AllowedExtensions As List(Of String) = New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
@ -406,29 +408,34 @@ Public Class ImportZUGFeRDFiles
_logger.Error(ex)
oTransaction.Rollback()
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Out of memory' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
oMoveDirectory = DIRECTORY_DONT_MOVE
AddRejectedState(oMessageId, "OutOfMemoryException", "", ex.Message)
'Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Out of memory' WHERE GUID = '{HISTORY_ID}'"
'_firebird.ExecuteNonQuery(oSQL)
'AddRejectedState(oMessageId, "OutOfMemoryException", "", ex.Message)
Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
oTransaction.Rollback()
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
oMoveDirectory = oArgs.ErrorDirectory
AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message)
oMoveDirectory = DIRECTORY_DONT_MOVE
'Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'"
'_firebird.ExecuteNonQuery(oSQL)
'oMoveDirectory = oArgs.ErrorDirectory
'AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message)
Finally
oConnection.Close()
' Move all files of the current group
Try
MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess)
' If an application error occurred, dont move files so they will be processed again later
If oMoveDirectory = DIRECTORY_DONT_MOVE Then
_logger.Info("Application Error occurred. Files for message Id {0} will not be moved.", oMessageId)
Else
' Move all files of the current group
MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess)
End If
_logger.Info("Finished processing file group {0}", oMessageId)
Catch ex As Exception
_logger.Warn("Could not move files!")

View File

@ -30,5 +30,5 @@ Imports System.Runtime.InteropServices
' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern
' übernehmen, indem Sie "*" eingeben:
<Assembly: AssemblyVersion("1.3.0.12")>
<Assembly: AssemblyFileVersion("1.3.0.12")>
<Assembly: AssemblyVersion("1.3.1.0")>
<Assembly: AssemblyFileVersion("1.3.1.0")>

View File

@ -56,9 +56,9 @@ Imports NLog.Targets
''' </remarks>
Public Class LogConfig
#Region "Private Properties"
Private Const OPEN_FILE_CACHE_TIMEOUT As Integer = 5
Private Const OPEN_FILE_CACHE_TIMEOUT As Integer = 30
Private Const OPEN_FILE_FLUSH_TIMEOUT As Integer = 5
Private Const AUTO_FLUSH As Boolean = True
Private Const AUTO_FLUSH As Boolean = False
Private Const KEEP_FILES_OPEN As Boolean = False
Private Const KEEP_FILES_OPEN_DEBUG As Boolean = True

View File

@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.0.4.0")>
<Assembly: AssemblyFileVersion("2.0.4.0")>
<Assembly: AssemblyVersion("2.0.4.1")>
<Assembly: AssemblyFileVersion("2.0.4.1")>

View File

@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.2.4.0")>
<Assembly: AssemblyVersion("1.2.5.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>

View File

@ -25,8 +25,6 @@ Public Class ThreadRunner
Private _jobArguments As WorkerArgs
Private _mssql As MSSQLServer
Private Const TIMER_INTERVAL_MS = 10_000
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()

84
Windows/Hotkey.vb Normal file
View File

@ -0,0 +1,84 @@
Imports System.Windows.Forms
Public Class Hotkey
Implements IMessageFilter
Private _OwnerForm As Form
Private _HotkeyList As New Dictionary(Of Short, HotKeyObject)
Private _HotkeyIDList As New Dictionary(Of String, Short)
''' <summary>
''' Diesem Event wird immer die zugewiesene HotKeyID übergeben, wenn eine HotKey Kombination gedrückt wurde.
''' </summary>
Public Event HotKeyPressed(ByVal HotKeyID As String)
''' <summary>
''' Definiert verfügbare Modfier Keys
''' </summary>
Public Enum ModfierKey As Integer
MOD_ALT = 1
MOD_CONTROL = 2
MOD_SHIFT = 4
MOD_WIN = 8
End Enum
Sub New(ByVal pOwnerForm As Form)
_OwnerForm = pOwnerForm
Application.AddMessageFilter(Me)
End Sub
''' <summary>
''' Diese Funktion fügt einen Hotkey hinzu und registriert ihn auch sofort
''' </summary>
''' <param name="pKeyCode">Den KeyCode für die Taste</param>
''' <param name="pModifiers">Die Zusatztasten wie z.B. Strg oder Alt, diese können auch mit OR kombiniert werden</param>
''' <param name="pHotKeyID">Die ID die der Hotkey bekommen soll um diesen zu identifizieren</param>
Public Sub AddHotKey(ByVal pKeyCode As Keys, ByVal pModifiers As ModfierKey, ByVal pHotKeyID As Integer)
If _HotkeyIDList.ContainsKey(pHotKeyID) = True Then
Exit Sub
End If
Dim oHotkeyId As Short = NativeMethods.GlobalAddAtom(pHotKeyID)
_HotkeyIDList.Add(pHotKeyID, oHotkeyId)
_HotkeyList.Add(oHotkeyId, New HotKeyObject(pKeyCode, pModifiers, pHotKeyID))
NativeMethods.RegisterHotKey(_OwnerForm.Handle, oHotkeyId, _HotkeyList(oHotkeyId).Modifier, _HotkeyList(oHotkeyId).HotKey)
End Sub
''' <summary>
''' Diese Funktion entfernt einen Hotkey und deregistriert ihn auch sofort
''' </summary>
''' <param name="pHotKeyID">Gibt die HotkeyID an welche entfernt werden soll</param>
Public Sub RemoveHotKey(ByVal pHotKeyID As Integer)
If _HotkeyIDList.ContainsKey(pHotKeyID) = False Then
Exit Sub
End If
Dim oHotkeyId As Short = _HotkeyIDList(pHotKeyID)
_HotkeyIDList.Remove(pHotKeyID)
_HotkeyList.Remove(oHotkeyId)
NativeMethods.UnregisterHotKey(_OwnerForm.Handle, CInt(oHotkeyId))
NativeMethods.GlobalDeleteAtom(oHotkeyId)
End Sub
Private Function PreFilterMessage(ByRef m As Message) As Boolean Implements IMessageFilter.PreFilterMessage
If m.Msg = NativeMethods.WM_HOTKEY Then
If Clipboard.GetText().Trim() <> String.Empty Then
RaiseEvent HotKeyPressed(_HotkeyList(CShort(m.WParam)).HotKeyID)
End If
End If
End Function
Public Class HotKeyObject
Public Property HotKey() As Keys
Public Property Modifier() As ModfierKey
Public Property HotKeyID() As String
Public Property AtomID() As Short
Sub New(ByVal NewHotKey As Keys, ByVal NewModifier As ModfierKey, ByVal NewHotKeyID As String)
HotKey = NewHotKey
Modifier = NewModifier
HotKeyID = NewHotKeyID
End Sub
End Class
End Class

View File

@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>
<Assembly: AssemblyVersion("1.1.0.0")>
<Assembly: AssemblyFileVersion("1.1.0.0")>

View File

@ -79,6 +79,27 @@ Public Class NativeMethods
Public Shared Function GetCursorPos(ByRef lpPoint As PointAPI) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
Public Declare Function RegisterHotKey Lib "user32" (
ByVal Hwnd As IntPtr,
ByVal ID As Integer,
ByVal Modifiers As Integer,
ByVal Key As Integer
) As Integer
Public Declare Function UnregisterHotKey Lib "user32" (
ByVal Hwnd As IntPtr,
ByVal ID As Integer
) As Integer
Public Declare Auto Function GetWindowText Lib "user32" (
ByVal hWnd As IntPtr,
ByVal lpString As StringBuilder,
ByVal cch As Integer
) As Integer
Public Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal IDString As String) As Short
Public Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal Atom As Short) As Short
Public Const STANDARD_RIGHTS_REQUIRED As Integer = &HF0000
Public Const SECTION_QUERY As Short = &H1
Public Const SECTION_MAP_WRITE As Short = &H2
@ -104,6 +125,7 @@ Public Class NativeMethods
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const WM_HOTKEY As Integer = &H312
Public Enum PageProtection As UInteger
NoAccess = &H1

View File

@ -76,6 +76,7 @@
<ItemGroup>
<Compile Include="Drawing.vb" />
<Compile Include="File.vb" />
<Compile Include="Hotkey.vb" />
<Compile Include="NativeMethods.vb" />
<Compile Include="Utils.vb" />
<Compile Include="Window.vb" />