Imports DevExpress.XtraBars.Ribbon Imports DevExpress.XtraRichEdit.API.Native Imports DevExpress.XtraRichEdit.Services Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Patterns Public Class frmSQLEditor Private ReadOnly Patterns As ClassPatterns Private ReadOnly LogConfig As LogConfig Private ReadOnly Database As MSSQLServer Private ReadOnly Placeholders As Placeholders Private ClearPlaceholdersAfterSuccessfulExecute As Boolean = False Private FormLoading As Boolean = False Public Property SQLCommand As String = "" Public Property SQLConnection As Integer = 0 Public Property LoadClipboardPlaceholders As Boolean = False Public Property PlaceholdersManual As List(Of String) Public Property PlaceholdersManualPrefix As String Public Property PlaceholdersAutomatic As List(Of String) Public Property PlaceholdersAutomaticPrefix As String Public Property PlaceholdersWindream As List(Of String) Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. LogConfig = pLogConfig Database = pDatabase Patterns = New ClassPatterns(LogConfig) Placeholders = New Placeholders() End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load FormLoading = True Try If PlaceholdersAutomatic Is Nothing Then PlaceholdersAutomatic = New List(Of String) End If If PlaceholdersManual Is Nothing Then PlaceholdersManual = New List(Of String) End If If PlaceholdersWindream Is Nothing Then PlaceholdersWindream = New List(Of String) End If If SQLCommand <> String.Empty Then txtSQLCommand.Document.Text = SQLCommand End If Dim oConnectionGroup = LoadConnections() Dim oSelectedItem = Nothing If SQLConnection > 0 Then For Each oItem As GalleryItem In oConnectionGroup.Items Dim oConnection = oItem.Tag If SQLConnection = oConnection.id Then oSelectedItem = oItem End If Next End If GalleryConnection.Gallery.Groups.Add(oConnectionGroup) GalleryConnection.Gallery.SetItemCheck(oSelectedItem, True) Dim oPlaceholderGroups = LoadPlaceholders() GalleryPlaceholders.Gallery.Groups.AddRange(oPlaceholderGroups.ToArray) ConfigureRichEditControl() chkClearPlaceholders.Checked = ClearPlaceholdersAfterSuccessfulExecute Catch ex As Exception Finally FormLoading = False End Try End Sub Private Sub RibbonGalleryBarItem1_GalleryItemClick(sender As Object, e As GalleryItemClickEventArgs) Handles GalleryPlaceholders.GalleryItemClick Dim oPlaceholder As Placeholder = e.Item.Tag Dim pPosition = txtSQLCommand.Document.CaretPosition txtSQLCommand.Document.InsertSingleLineText(pPosition, Patterns.WrapPatternValue(oPlaceholder.Module, oPlaceholder.Name)) End Sub Private Sub RibbonGalleryBarItem2_GalleryItemClick(sender As Object, e As GalleryItemClickEventArgs) Handles GalleryConnection.GalleryItemClick Dim oConnection As Connection = e.Item.Tag SQLConnection = oConnection.Id End Sub Private Function LoadPlaceholders() As List(Of GalleryItemGroup) Dim oPlaceholders = New List(Of GalleryItemGroup)() From { Placeholders.GetInternalPlaceholders(), Placeholders.GetUserPlaceholders() } Dim oAutomaticAttributes = Placeholders.GetAutomaticPlaceholders(PlaceholdersAutomatic, PlaceholdersAutomaticPrefix) If oAutomaticAttributes IsNot Nothing Then oPlaceholders.Add(oAutomaticAttributes) End If Dim oManualPlaceholders = Placeholders.GetManualPlaceholders(PlaceholdersManual, PlaceholdersManualPrefix) If oManualPlaceholders IsNot Nothing Then oPlaceholders.Add(oManualPlaceholders) End If Dim oWindreamPlaceholders = Placeholders.GetWindreamPlaceholders(PlaceholdersWindream) If oWindreamPlaceholders IsNot Nothing Then oPlaceholders.Add(oWindreamPlaceholders) End If If LoadClipboardPlaceholders Then oPlaceholders.Add(Placeholders.GetClipboardPlaceholder) End If Return oPlaceholders End Function Private Function LoadConnections() As GalleryItemGroup Try Dim oSql = "SELECT GUID, Bezeichnung FROM [DD_ECM].[dbo].[TBDD_CONNECTION] WHERE AKTIV = 1" Dim oTable = Database.GetDatatable(oSql) Dim oConnections = New List(Of Connection) For Each oRow As DataRow In oTable.Rows oConnections.Add(New Connection() With { .Id = oRow.Item("GUID"), .Name = oRow.Item("Bezeichnung")}) Next Dim oConnectionGroup = New GalleryItemGroup() With {.Caption = "Verbindungen"} Dim oItems As New List(Of GalleryItem) For Each oConnection In oConnections oItems.Add(GetGalleryItem(oConnection)) Next oConnectionGroup.Items.AddRange(oItems.ToArray) Return oConnectionGroup Catch ex As Exception Return Nothing End Try End Function Private Sub ConfigureRichEditControl() txtSQLCommand.Options.Search.RegExResultMaxGuaranteedLength = 500 txtSQLCommand.ReplaceService(Of ISyntaxHighlightService)(New SQLSyntaxHighlightService(txtSQLCommand.Document)) txtSQLCommand.ActiveViewType = DevExpress.XtraRichEdit.RichEditViewType.Simple txtSQLCommand.Document.Sections(0).Page.Width = DevExpress.Office.Utils.Units.InchesToDocumentsF(80.0F) txtSQLCommand.Document.DefaultCharacterProperties.FontName = "Courier New" txtSQLCommand.Document.DefaultCharacterProperties.FontSize = 12 End Sub Private Sub ClearPlaceholders() GridPlaceholders.DataSource = New List(Of Placeholder) End Sub Private Function GetGalleryItem(pConnection As Connection) As GalleryItem Dim oItem = New GalleryItem(Nothing, pConnection.Name, Nothing) With { .Tag = pConnection } oItem.ImageOptions.SvgImage = My.Resources.actions_database Return oItem End Function Private Property LastPatterns As New List(Of Pattern) Private Sub RichEditControl1_ContentChanged(sender As Object, e As EventArgs) Handles txtSQLCommand.ContentChanged Dim oSqlText = txtSQLCommand.Document.Text Dim oPatterns = Patterns.GetAllPatterns(oSqlText) If oPatterns.Count = 0 Then GridPlaceholders.DataSource = New List(Of Placeholder) ElseIf oPatterns.Count.Equals(LastPatterns.Count) Then ' noop Else Dim oPlaceholders = oPatterns. Select(Function(pattern) New Placeholder(pattern.Value, pattern.Value, pattern.Type, pattern.Value) With {.Pattern = pattern}). ToList() GridPlaceholders.DataSource = oPlaceholders End If LastPatterns = oPatterns End Sub Private Sub BarButtonItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnExecuteSQL.ItemClick ExecuteSQL() End Sub Private Class Connection Public Property Id As Integer Public Property Name As String End Class Private Sub ExecuteSQL() Try ViewPlaceholders.FocusInvalidRow() Dim oSql = txtSQLCommand.Document.Text Dim oPlaceholders As List(Of Placeholder) = GridPlaceholders.DataSource If oPlaceholders IsNot Nothing Then For Each oPlaceholder In oPlaceholders Dim oWrapped = Patterns.WrapPatternValue(oPlaceholder.Module, oPlaceholder.Name) If oPlaceholder.Value Is Nothing Then Throw New ApplicationException($"Der Platzhalter '{oWrapped}' wurde nicht ausgefüllt!") End If oSql = oSql.Replace(oWrapped, oPlaceholder.Value) Next End If Dim oDatatable As DataTable If SQLConnection > 0 Then Dim oConnectionString = Database.GetConnectionStringForId(SQLConnection) oDatatable = Database.GetDatatableWithConnection(oSql, oConnectionString) Else oDatatable = Database.GetDatatable(oSql) End If Dim oForm As New frmSQLResult(oDatatable) oForm.Show() Catch ex As ApplicationException MsgBox(ex.Message, MsgBoxStyle.Exclamation, Text) Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, Text) End Try End Sub Private Sub BarCheckItem1_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkClearPlaceholders.CheckedChanged If FormLoading = False Then ClearPlaceholdersAfterSuccessfulExecute = chkClearPlaceholders.Checked End If End Sub Private Sub btnClearPlaceholders_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnClearPlaceholders.ItemClick ClearPlaceholders() End Sub Private Sub chkShowPlaceholders_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkShowPlaceholders.CheckedChanged SplitContainerControl1.Collapsed = Not chkShowPlaceholders.Checked End Sub Private Sub SplitContainerControl1_SplitGroupPanelCollapsed(sender As Object, e As DevExpress.XtraEditors.SplitGroupPanelCollapsedEventArgs) Handles SplitContainerControl1.SplitGroupPanelCollapsed chkShowPlaceholders.Checked = Not e.Collapsed End Sub Private Sub btnSave_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnSave.ItemClick SQLCommand = txtSQLCommand.Text Close() End Sub Private Sub frmSQLEditor_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown If e.KeyCode = Keys.F5 Then ExecuteSQL() End If End Sub End Class