Monorepo/Controls.SQLEditor/frmSQLEditor.vb
2022-05-11 13:49:34 +02:00

275 lines
10 KiB
VB.net

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