ToolCollection/ToolCollection/frmNIVerknuepfungen.vb

3688 lines
176 KiB
VB.net

Imports System.Data.SqlClient
Imports System.Data.Odbc
Imports System.Data.OleDb
Imports System.Windows.Forms
Imports System.Xml
Imports System.DirectoryServices
Imports Oracle.ManagedDataAccess.Client
Imports System.IO
Imports DigitalData.Modules.Logging
Public Class frmNIVerknuepfungen
'Private _MyLogger As LogConfig
Private Shared _Logger As DigitalData.Modules.Logging.Logger
Private _selectedProfil As ClassNIProfil
Public Shared _windream As ClassWindream_allgemein
'Zum Speichern der Positionen
Dim _pos As Integer
Dim arrProfile(1, 1) As Object
' verhindert (wenn True) das _selectedProfil auf Nothing gesetzt wird, wenn das Panel auf visible = True gesetzt wird
Private _flagIgnoreVisibilityChanged As Boolean = False
Private _flagIgnoreCheckedChanged As Boolean = False
Private _formloaded As Boolean = False
Private selectedIndex_Type As String
Public Shared vSQL As String
Public Shared vstartwert As String
Public Shared vdatasource As String
Public Shared vUserID As String
Public Shared vPassword As String
Public Shared vDB_Art As String
Public Shared vInitialCatalog As String
Public Shared vReplace As String
Private database As ClassNIDatenbankzugriff
Private Shared _Instance As frmNIVerknuepfungen = Nothing
Private _windreamNI As ClassNIWindream
Public Shared Function Instance() As frmNIVerknuepfungen
If _Instance Is Nothing OrElse _Instance.IsDisposed = True Then
_Instance = New frmNIVerknuepfungen
End If
_Instance.BringToFront()
Return _Instance
End Function
''' <summary>
''' Konstruktor des Panels. Laden der Profilnamen in die Auswahliste.
''' </summary>
''' <remarks></remarks>
Sub New()
_flagIgnoreCheckedChanged = True
' Dieser Aufruf ist für den Windows Form-Designer erforderlich.
InitializeComponent()
_Logger = CURR_LogConfig.GetLogger()
_flagIgnoreCheckedChanged = False
_windream = New ClassWindream_allgemein(CURR_LogConfig)
database = New ClassNIDatenbankzugriff(CURR_LogConfig)
_windreamNI = New ClassNIWindream(CURR_LogConfig)
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
Me.LoadProfilesInCombobox()
End Sub
Public Sub ReDimEx(ByRef MyArray As Object, ByVal iDimX As Integer, ByVal iDimY As Integer)
Dim MyTempArray As Object
Dim I As Integer
Dim J As Integer
MyTempArray = MyArray
ReDim MyArray(iDimX, iDimY)
For I = LBound(MyTempArray, 1) To UBound(MyTempArray, 1)
For J = LBound(MyTempArray, 2) To UBound(MyTempArray, 2)
If I <= iDimX And J <= iDimY Then
MyArray(I, J) = MyTempArray(I, J)
End If
Next J
Next I
End Sub
''' <summary>
''' Schreibt die Profile in die Combobox in der Toolbar.
''' </summary>
''' <remarks></remarks>
Private Sub LoadProfilesInCombobox()
Try
ClassNIProfile.Init()
Me.cmbProfilauswahl.DropDownItems.Clear()
If ClassNIProfile.Profile IsNot Nothing Then
Dim anz As Integer = 0
For Each item As ClassNIProfil In ClassNIProfile.Profile
Me.cmbProfilauswahl.DropDownItems.Add(item.Profilname)
ReDimEx(arrProfile, anz, 1)
arrProfile(anz, 0) = item.Profilname
arrProfile(anz, 1) = anz
anz = anz + 1
Next
Me.lblAnzahlProfile.Text = "Anzahl Profile: " & anz
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Laden der Profile in die Auswahlliste")
End Try
End Sub
''' <summary>
''' Liest die Indexe des Dokumenttyps aus und schreibt diese in den ListView
''' </summary>
''' <remarks></remarks>
Private Sub LoadIndexesToListViews()
Try
' Indexliste
Me.lbxWMIndex.Items.Clear()
Me.cmbIndex_Statusfertig.Items.Clear()
Dim indexe = _windream.GetIndicesByObjecttype(Me._selectedProfil.Dokumenttyp.aName, False, "NI")
If indexe IsNot Nothing Then
'Erst die windream-Indexe in die Standard Listbox eintragen
For Each index As String In indexe
Me.lbxWMIndex.Items.Add(index)
Me.cmbIndex_Statusfertig.Items.Add(index)
Next
Me.lbxWMIndex.Items.Add("WD-Dateiname")
Me.lbxWMIndex.Items.Add("Manueller Volltext")
Me.cmbIndex_Statusfertig.Items.Add("")
Me.cmbIndex_Statusfertig.SelectedIndex = -1
'Und jetzt noch die Nachindexierungsartspezifischen
Select Case Me._selectedProfil.Ni_Art
Case "db"
Me.cmbWindreamIndexe.Items.Clear()
Me.cmbWindreamIndexeSQL.Items.Clear()
For Each index As String In indexe
Me.cmbWindreamIndexe.Items.Add(index)
Me.cmbWindreamIndexeSQL.Items.Add(index)
Next
Me.cmbWindreamIndexe.SelectedIndex = -1
Me.cmbWindreamIndexeSQL.SelectedIndex = -1
Case "xml"
Case "fulltext"
Case "activedirectory"
cmbLDAP_WDIndexSelect.Items.Clear()
For Each index As String In indexe
cmbLDAP_WDIndexSelect.Items.Add(index)
Next
cmbLDAP_WDIndexSelect.Items.Add("WD-Dateiname")
End Select
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Laden der windream-Indexe in die Auswahlliste")
End Try
End Sub
''' <summary>
''' Lädt ein Profil an Hand des Profilnamens und trägt die Werte in die Formularfelder ein
''' </summary>
''' <param name="profilname">Name des zu ladenden Profils</param>
''' <remarks></remarks>
Private Sub LoadSelectedProfile(ByVal profilname As String)
Try
' setzt erst einmal alles zurück
Me.tabctrlbottom.Visible = True
Me._selectedProfil = ClassNIProfile.getProfilByName(profilname) 'ClassNIProfile.aktivesProfil
pnlZielQuelle.Visible = False
pnlfulltext.Visible = False
grbFilterDB.Visible = False
pnlFilterLDAP.Visible = False
Me.trvwxml.Visible = False
chkbxXml_Always_Write.Visible = False
Me.btnxmlchooseFile.Visible = False
Me.lblxmlFileChoose.Visible = False
Me.txtxml_Beispieldatei.Visible = False
Me.lblxmlDescription.Visible = False
Me.rbvkt_add.Visible = False
Me.rbvkt_overwrite.Visible = False
Me.chkvkt_Dublette.Visible = False
Me.Label4.Text = "eindeutiger WD-Index:"
btnaddUniqueIndex.Enabled = True
txtfinalSkriptUpdate.Text = ""
Me.txtCheckIndexSQL.Text = ""
If Me._selectedProfil.Dokumenttyp IsNot Nothing Then
'Profilübergreifende Aktualisierungen
Me.pnlZielQuelle.Visible = True
Me.SplitContainer1.Visible = True
Me.tabctrlbottom.Visible = True
Me.pnlFooter.Visible = True
Me.pnlZielQuelle.Dock = DockStyle.Fill
Me.lblProfil.Text = "Gewähltes Profil: '" & Me._selectedProfil.Profilname & "'"
Me.lblProfil.Visible = True
Me._selectedProfil._links.LoadFromXmlFile()
Me.lblDescrIndex.Text = "1. windream-Index wählen:"
Me.lblDataviews.Visible = False
Me.rbTables.Visible = False
Me.rbViews.Visible = False
Me.cmbDataviews.Visible = False
Me.lblDescrQuelle.Visible = True
Me.lbxQuelle1.Visible = True
Me.trvwxml.Visible = False
Me.lvwVerknuepfungen.Items.Clear()
If Me._selectedProfil.Dokumenttyp IsNot Nothing Then
Me.pnlZielQuelle.Enabled = True
Me.LoadIndexesToListViews()
Else
Me.pnlZielQuelle.Enabled = False
Me.lblProfil.Text = "Gewähltes Profil: '" & Me._selectedProfil.Profilname & "'" & " - unbekannter Objekttyp -"
End If
'Überprüfungsselect
Me.txtCheckIndexSQL.Text = Me._selectedProfil.checkIndexsql
'Move and Rename aktiv?
If Me._selectedProfil.SQL_Anweisung IsNot Nothing Then
If Me._selectedProfil.SQL_Anweisung <> "" Then
Me.txtfinalSkriptUpdate.Text = Me._selectedProfil.SQL_Anweisung
End If
End If
'##################################################
'###### Nachindexierung über xml-Dateien ##########
'##################################################
If Me._selectedProfil.Ni_Art = "xml" Then
'PROFILEIGENSCHAFTEN
'DbArt = "Dateityp"
'datasource = Dateiendung
'initialCatalog = löschen
Me.lblDescr_Verknüpfungen.Location = New Point(7, 57)
Me.lblDescr_Verknüpfungen.Text = "Bestimmen Sie hier die Verknüpfung Index - xml-Knoten:"
Me.lblDescrQuelle.Text = "2. Ergebnis-Knoten xml wählen:"
lvwVerknuepfungen.Columns(1).Text = "XML-Knoten/Wert"
lvwVerknuepfungen.Columns(2).Width = 0
Me.lblxmlDescription.Visible = True
lblDescrangelegteVerknuepf.Text = "Jeder hier aufgelistete Index wird einzeln über den ausgewählten xml-Knoten" & vbNewLine & "nachindexiert."
lblDescr_manuellerWert.Text = "Manueller Wert anstatt" & vbNewLine & "xml-Wert:"
If Me._selectedProfil._links.Links IsNot Nothing Then
For Each link As ClassNIVerknüpfung In Me._selectedProfil._links.Links
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {link.Index, link.Spalte, link.From}))
' wenn es den aktuellen Index noch in der Indexliste gibt
If Me.lbxWMIndex.Items.Contains(link.Index) Then
Dim indextype As String = _windreamNI.GetIndex_Type(link.Index)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(link.Index)
End If
End If
Next
Else
Me.grbFilterDB.Enabled = False
End If
Me.lbxQuelle1.Visible = False
Me.trvwxml.Visible = True
Me.trvwxml.Size = New Size(235, 160)
Me.trvwxml.Location = New Point(166, 98)
Me.btnxmlchooseFile.Visible = True
Me.btnxmlchooseFile.Location = New Point(407, 32)
Me.lblxmlFileChoose.Visible = True
Me.lblxmlFileChoose.Location = New Point(9, 13)
Me.txtxml_Beispieldatei.Visible = True
Me.txtxml_Beispieldatei.Location = New Point(12, 32)
Me.txtxml_Beispieldatei.Text = Me._selectedProfil.xmlFolder
ElseIf Me._selectedProfil.Ni_Art = "db" Then
Me.lblDataviews.Visible = True
Me.rbTables.Visible = True
Me.rbViews.Visible = True
Me.cmbDataviews.Visible = True
Me.lblDescr_Verknüpfungen.Location = New Point(7, 57)
Me.lblDescr_Verknüpfungen.Text = "Bestimmen Sie hier die Verknüpfung Index-Datenbankspalte:"
Me.lblDescrQuelle.Text = "2. Datenbankspalte wählen:"
lblDescr_manuellerWert.Text = "Manueller Wert anstatt" & vbNewLine & "Datenbankspalte:"
lblDescrangelegteVerknuepf.Text = "Jeder hier aufgelistete Index wird einzeln mit dem zugehörigen " & vbNewLine & "SQL-Statement nachindexiert."
lvwVerknuepfungen.Columns(1).Text = "Datenbankspalte/-Wert"
lvwVerknuepfungen.Columns(2).Text = "aus Datenbankobjekt"
lvwVerknuepfungen.Columns(2).Width = 150
'##################################################
'###### Nachindexierung über Datenbank ##########
'##################################################
Me.grbFilterDB.Visible = True
'Me.grbFilterDB.Anchor = AnchorStyles.None
' Me.grbFilterDB.Location = New Point(10, 323)
'Me.grbFilterDB.Size = New Size(pnlZielQuelle.Size.Width - 35, pnlZielQuelle.Size.Height - 320)
'Me.grbFilterDB.Anchor = AnchorStyles.Bottom
'Me.grbFilterDB.Anchor = AnchorStyles.Right
'Me.grbFilterDB.Anchor = AnchorStyles.Top
'Me.grbFilterDB.Anchor = AnchorStyles.Left
Me.lvwVerknuepfungen.Items.Clear()
Me.cmbDataviews.Items.Clear()
Me.lbxQuelle1.Items.Clear()
Me.lblDokumenttyp.Text = Me._selectedProfil.DokumenttypString
If Me._selectedProfil._links.Links IsNot Nothing Then
For Each link As ClassNIVerknüpfung In Me._selectedProfil._links.Links
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {link.Index, link.Spalte, link.From}))
' wenn es den aktuellen Index noch in der Indexliste gibt
If Me.lbxWMIndex.Items.Contains(link.Index) Then
Dim indextype As String = _windreamNI.GetIndex_Type(link.Index)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(link.Index)
End If
End If
Next
Else
Me.grbFilterDB.Enabled = False
End If
Me.txteindeutigerIndex.Text = Me._selectedProfil.Desk_windreamIndex
Me.txteindeutigerIndex.BackColor = Color.WhiteSmoke
' Viewliste
Dim dataviews() As String = Nothing
If Me._selectedProfil.DbArt = "Oracle" Then
dataviews = Me.GetOracleDataviews(Me.rbViews.Checked)
ElseIf Me._selectedProfil.DbArt = "MS-SQL" Then
dataviews = Me.GetMsSqlDataviews(Me.rbViews.Checked)
ElseIf Me._selectedProfil.DbArt = "ODBC" Then
dataviews = Me.GetOdbcDataviews(Me.rbViews.Checked)
ElseIf Me._selectedProfil.DbArt = "OLE (Access)" Then
dataviews = Me.GetOleDataviews(Me.rbViews.Checked)
Else
MsgBox("Der gewählte Datenbanktyp ist unbekannt.", MsgBoxStyle.Critical, "Unbekannter Datenbanktyp")
End If
If dataviews IsNot Nothing Then
For Each dataview As String In dataviews
Me.cmbDataviews.Items.Add(dataview)
Next
End If
Me.cmbDataviews.Sorted = True
Me.txtSelectAnweisung.Text = ""
'Finaler Index ja nein?
If Me._selectedProfil.finalerIndex <> "" Then
Me.chbxStatusfertig.CheckState = CheckState.Checked
Me.cmbIndex_Statusfertig.Items.Clear()
Me.cmbIndex_Statusfertig.ForeColor = Color.Black
Me.cmbIndex_Statusfertig.Items.Add(Me._selectedProfil.finalerIndex) ' den index eintragen
Me.cmbIndex_Statusfertig.SelectedIndex = 0 ' und direkt auswählen
Else
Me.chbxStatusfertig.CheckState = CheckState.Unchecked
End If
'#### VOLLTEXTINDEXER #####
ElseIf Me._selectedProfil.Ni_Art = "fulltext" Then
Me.txteindeutigerIndex.Text = Me._selectedProfil.Desk_windreamIndex
Me.txteindeutigerIndex.BackColor = Color.WhiteSmoke
Me.Label4.Text = "Volltext Index:"
btnaddUniqueIndex.Enabled = False
Me.lblDescrIndex.Text = "1. Wählen Sie den zu indexierenden windream-Index"
Me.lblDescr_Verknüpfungen.Location = New Point(7, 40)
Me.lblDescr_Verknüpfungen.Text = "Jeder hier aufgelistete Index wird einzeln mit der zugehörigen " & vbNewLine & "Regular Expression nachindexiert."
Me.lblDescrQuelle.Text = "AD-Attribut:"
lblDescr_manuellerWert.Text = "Manueller Wert anstatt" & vbNewLine & "Regular Expression:"
Me.lblDescrQuelle.Visible = False
Me.lbxQuelle1.Visible = False
Me.pnlfulltext.Visible = True
pnlfulltext.Enabled = False
pnlfulltext.Location = New Point(9, 317)
pnlfulltext.Size = New Size(1000, 200)
pnlfulltext.Anchor = AnchorStyles.Top Or AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right
lvwVerknuepfungen.Columns(1).Text = "Regular Expression"
lvwVerknuepfungen.Columns(2).Text = "Einschränkung"
lvwVerknuepfungen.Columns(2).Width = 0
If Me._selectedProfil._links.Links IsNot Nothing Then
Dim i As Integer
For Each link As ClassNIVerknüpfung In Me._selectedProfil._links.Links
i += 1
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {link.Index, link.Spalte, link.SelectAnweisung}))
' wenn es den aktuellen Index noch in der Indexliste gibt
If Me.lbxWMIndex.Items.Contains(link.Index) Then
Dim indextype As String = _windreamNI.GetIndex_Type(link.Index)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(link.Index)
End If
End If
Next
If i = 0 Then
pnlfulltext.Enabled = True
End If
Else
pnlfulltext.Enabled = True
End If
ElseIf Me._selectedProfil.Ni_Art = "activedirectory" Then
Me.pnlFilterLDAP.Visible = True
pnlFilterLDAP.Location = New Point(12, 324)
pnlFilterLDAP.Size = New Size(730, 220)
Me.lblDescr_Verknüpfungen.Location = New Point(7, 57)
Me.lblDescr_Verknüpfungen.Text = "Bestimmen Sie hier die Indexverknüpfungen:"
Me.lblDescrQuelle.Text = "AD-Attribut:"
Me.lblDescrangelegteVerknuepf.Text = "Verknüpfungen windreamIndex - AD-Attribut:"
lvwVerknuepfungen.Columns(1).Text = "AD-Attribut/-Wert"
lvwVerknuepfungen.Columns(2).Text = "Typ"
lvwVerknuepfungen.Columns(2).Width = 100
lblDescr_manuellerWert.Text = "Manueller Wert anstatt" & vbNewLine & "AD-Attribut:"
Dim path As String = Application.StartupPath & "\ADAttribute.txt"
lbxQuelle1.Items.Clear()
cmbLDAP_Attribut.Items.Clear()
' This text is added only once to the file.
If IO.File.Exists(path) = True Then
' Open the file to read from.
Dim readText() As String = IO.File.ReadAllLines(path)
Dim s As String
For Each s In readText
Me.lbxQuelle1.Items.Add(s)
cmbLDAP_Attribut.Items.Add(s)
Next
End If
If Me._selectedProfil._links.Links IsNot Nothing Then
For Each link As ClassNIVerknüpfung In Me._selectedProfil._links.Links
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {link.Index, link.Spalte, link.From}))
' wenn es den aktuellen Index noch in der Indexliste gibt
If Me.lbxWMIndex.Items.Contains(link.Index) Then
Dim indextype As String = _windreamNI.GetIndex_Type(link.Index)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(link.Index)
End If
End If
Next
Else
Me.grbFilterDB.Enabled = False
End If
End If
' Nach vollständigem Laden wird saved auf true (changed auf false) gesetzt
Me._selectedProfil.setSaved()
Else
Me.lblProfil.Text = "Gewähltes Profil: '" & Me._selectedProfil.Profilname & "'" & " - unbekannter Objekttyp -"
MsgBox("Ein Dokumenttyp konnte nicht bestimmt werden! Vergewissern Sie sich das das Profil korrekt gespeichert wurde!", MsgBoxStyle.Exclamation, "Ausnahme:")
Me.Close()
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Laden des Profils")
End Try
End Sub
''' <summary>
''' Reaktion auf die Auswahl eines Profils über die ComboBox
''' </summary>
''' <remarks></remarks>
Private Sub cmbProfilauswahl_DropDownItemClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolStripItemClickedEventArgs) Handles cmbProfilauswahl.DropDownItemClicked
ClassNIProfile.aktivesProfil = ClassNIProfile.getProfilByName(e.ClickedItem.Text)
Me._selectedProfil = ClassNIProfile.aktivesProfil
Try
'wenn noch kein Profil geladen wurde soll das ausgewählte auf jeden Fall geladen werden
If Me._selectedProfil IsNot Nothing Then
Me.LoadSelectedProfile(e.ClickedItem.Text)
Me.pnlZielQuelle.Enabled = True
Else ' wenn bereits ein Profil geladen war
If Me._selectedProfil.HasChanges Then
Me._selectedProfil.Save(True, "profile")
End If
' wenn ein anderes Profil ausgewählt wurde
If Not e.ClickedItem.Text = Me._selectedProfil.OriginalProfilname Then
Me.LoadSelectedProfile(e.ClickedItem.Text)
Else
'MsgBox("Keine Änderung")
End If
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei der Auswahl der Profile")
End Try
End Sub
''' <summary>
''' Reaktion auf die Auswahl eines Datenbankviews oder einer Tabelle
''' </summary>
''' <remarks></remarks>
Private Sub cmbDataviews_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbDataviews.SelectedIndexChanged
Try
' die Liste mit den Spaltennamen löschen
Me.lbxQuelle1.Items.Clear()
' wenn ein VIEW ausgewählt wurde
If Not Me.cmbDataviews.SelectedItem = "" Then
Dim words As String() = cmbDataviews.SelectedItem.Split(".")
' ein Array für die Spaltennamen definieren
Dim columns() As String = Nothing
' wenn es sich um die Oracle Version handelt
If Me._selectedProfil.DbArt = "Oracle" Then
' alle Spalten aus Oracle auslesen
columns = Me.GetOracleColumnsByTable(words(0))
ElseIf Me._selectedProfil.DbArt = "MS-SQL" Then
' alle Spalten aus Oracle auslesen
If rbFunctionsSc.Checked Or rbFunctionsTb.Checked Then
Dim oColumns() As String
ReDim oColumns(0)
oColumns(0) = "ReturnValue"
columns = oColumns
Else
columns = Me.GetMsSqlColumnsByTable(words(1)) 'Me.cmbDataviews.SelectedItem
End If
ElseIf Me._selectedProfil.DbArt = "ODBC" Then
' alle Spalten aus Oracle auslesen
columns = Me.GetOdbcColumnsByTable(words(0))
ElseIf Me._selectedProfil.DbArt = "OLE (Access)" Then
' alle Spalten aus Oracle auslesen
columns = Me.GetOleColumnsByTable(words(1))
Else
' die Art der Datenbank wird noch nicht unterstützt (falscher Eintrag in Settings)
MsgBox("Der gewählte Datenbanktyp ist unbekannt.", MsgBoxStyle.Critical, "Ungültiger Datenbanktyp")
End If
If Me._selectedProfil.DbArt = "xml" Then
Else
' alle ausgelesenen Spalten des VIEWs durchlaufen
For Each column As String In columns
' und in die ListBox eintragen
Me.lbxQuelle1.Items.Add(column)
Next
End If
End If
Catch ex As Exception
MsgBox("Die Datenansicht konnte nicht angelegt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim wählen einer Datenansicht")
End Try
End Sub
Private Sub LoadTreeViewFromXmlFile(ByVal file_name As _
String, ByVal trv As TreeView)
' Load the XML document.
Dim xml_doc As New XmlDocument
xml_doc.Load(file_name)
' Add the root node's children to the TreeView.
trv.Nodes.Clear()
AddTreeViewChildNodes(trv.Nodes,
xml_doc.DocumentElement)
End Sub
Private Sub AddTreeViewChildNodes(ByVal parent_nodes As _
TreeNodeCollection, ByVal xml_node As XmlNode)
For Each child_node As XmlNode In xml_node.ChildNodes
Select Case child_node.NodeType
'Case
End Select
' Make the new TreeView node.
Dim new_node As TreeNode =
parent_nodes.Add(child_node.Name)
' Recursively make this node's descendants.
AddTreeViewChildNodes(new_node.Nodes, child_node)
' If this is a leaf node, make sure it's visible.
If new_node.Nodes.Count = 0 Then _
new_node.EnsureVisible()
Next child_node
End Sub
'Private Function getxmltags2(ByVal filepath As String)
' Try
' ' Wir benötigen einen XmlReader für das Auslesen der XML-Datei
' Dim _XMLReader As Xml.XmlReader = New Xml.XmlTextReader(filepath)
' Dim Feldbezeichnung As String
' Dim Supply_inserted As Boolean = False
' Dim _insertnow As Boolean = False
' ' Es folgt das Auslesen der XML-Datei
' With _XMLReader
' Do While .Read ' Es sind noch Daten vorhanden
' ' Welche Art von Daten liegt an?
' Select Case .NodeType
' ' Ein Element
' Case Xml.XmlNodeType.Element
' 'MsgBox("Es folgt ein Element vom Typ " & .Name, MsgBoxStyle.Information, .HasValue.ToString)
' If .Name = "FieldResults" Then
' 'Hier kommt das Flag für ein Neues Device
' MsgBox("Xml.XmlNodeType.Element und FieldResults")
' Else
' 'Hier ist klar, es handelt sich um eine Deviceeigenschaft
' Feldbezeichnung = .Name
' End If
' Case Xml.XmlNodeType.Text
' ' MsgBox("Es folgt ein Text: " & .Value)
' If .Name = "FieldResults" Then
' MsgBox("Xml.XmlNodeType.Text und FieldResults")
' End If
' 'If Geraetezaehler <> String.Empty Then
' ' If .Value <> "<Nicht unterstützt>" Or .Value <> "<Anmeldedaten erforderlich>" Then
' ' Else
' ' 'MsgBox(" .Value = <Nicht unterstützt> Or .Value = <Anmeldedaten erforderlich>", MsgBoxStyle.Critical, vGeraete_Bez & " - " & vSerienNr)
' ' End If
' 'End If
' ' Ein Kommentar
' 'Case Xml.XmlNodeType.Comment
' ' MsgBox("Es folgt ein Kommentar: " & .Value)
' End Select
' Loop ' Weiter nach Daten schauen
' .Close() ' XMLTextReader schließen
' End With
' Catch ex As Exception
' MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei XML-Reader")
' End Try
'End Function
Public Sub LVWItemsMoveSelected(ByVal LVW As ListView, Optional ByVal Down As Boolean = False)
Try
Dim OldItem As ListViewItem
Dim OldPos As Integer
Dim i As Integer
If LVW.SelectedItems.Count > 0 Then
LVW.Sorting = Windows.Forms.SortOrder.None
If Down = True Then
If LVW.SelectedItems(LVW.SelectedItems.Count - 1).Index < LVW.Items.Count - 1 Then
For i = LVW.SelectedItems.Count - 1 To 0 Step -1
OldItem = LVW.Items(LVW.SelectedItems(i).Index + 1)
OldPos = LVW.Items(LVW.SelectedItems(i).Index).Index
LVW.Items(OldPos + 1) = LVW.SelectedItems(i).Clone
LVW.Items(OldPos) = OldItem
LVW.Items(OldPos + 1).Selected = True
Next
End If
Else
If LVW.SelectedItems(0).Index > 0 Then
For i = 0 To LVW.SelectedItems.Count - 1
OldItem = LVW.Items(LVW.SelectedItems(i).Index - 1)
OldPos = LVW.Items(LVW.SelectedItems(i).Index).Index
LVW.Items(OldPos - 1) = LVW.SelectedItems(i).Clone
LVW.Items(OldPos) = OldItem
LVW.Items(OldPos - 1).Selected = True
Next
End If
End If
'' definieren das am aktuellen Profil Änderungen vorgenommen wurden
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
LVW.Focus()
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Ändern der Nachindizierungsreihenfolge:")
End Try
End Sub
''' <summary>
''' Liest alle Microsoft SQL-server Datenbankviews aus, die in der Datenbank des gewählten Profils gespeichert sind
''' </summary>
''' <returns>Liefert eine Liste mit den Namen der Datenbankviews</returns>
''' <remarks></remarks>
Private Function GetMsSqlDataviews(Optional ByVal return_views As Boolean = True) As String()
Try
Dim SqlString As String
Dim DataViews() As String = Nothing
Dim i As Integer = 0
'Dim ConnectionString As SqlConnectionStringBuilder
Dim Connection As SqlConnection
Dim Command As SqlCommand
Dim DataAdapter As SqlDataAdapter
Dim DataSet As DataSet = New DataSet()
Dim con As String
' ConnectionString aufbauen
If _selectedProfil.UserId = "WINAUTH" Then
con = "Data Source=" & _selectedProfil.DataSource & ";Initial Catalog=" & _selectedProfil.InitialCatalog & ";Trusted_Connection=True;"
Else
con = "Server=" & _selectedProfil.DataSource & ";Database=" & _selectedProfil.InitialCatalog & ";User Id=" & _selectedProfil.UserId & ";Password=" & _selectedProfil.Password & ";"
End If
'ConnectionString = New SqlConnectionStringBuilder()
'ConnectionString.DataSource = Me._selectedProfil.DataSource
'ConnectionString.UserID = Me._selectedProfil.UserId
'ConnectionString.Password = Me._selectedProfil.Password
'ConnectionString.InitialCatalog = Me._selectedProfil.InitialCatalog
' Verbindung zur DB herstellen
Connection = New SqlConnection(con)
Connection.Open()
' DB-Abfrage für alle Views definieren
SqlString = "select * from INFORMATION_SCHEMA.TABLES"
' die DB-Abfrage erzeugen
Command = New SqlCommand(SqlString, Connection)
' die DB-Abfrage durchführen
DataAdapter = New SqlDataAdapter(Command)
' das DataSet mit den Daten füllen
DataAdapter.Fill(DataSet)
If DataSet.Tables(0).Rows.Count > 0 Then
Dim tabellenart As String = "VIEW"
If Me.rbViews.Checked Then
tabellenart = "VIEW"
Else
tabellenart = "TABLE"
End If
' alle Ergebnisse (VIEWs) durchlaufen
For Each row As DataRow In DataSet.Tables(0).Rows
If return_views Then
' Arraygrösse anpassen
If row!TABLE_TYPE.ToString = "VIEW" Then
If DataViews IsNot Nothing Then ReDim Preserve DataViews(DataViews.Length) Else ReDim DataViews(0)
' View in Array schreiben
DataViews(i) = row.Item(1) & "." & row.Item(2)
i += 1
End If
Else
If row!TABLE_TYPE.ToString = "BASE TABLE" Then
If DataViews IsNot Nothing Then ReDim Preserve DataViews(DataViews.Length) Else ReDim DataViews(0)
' Tabelle in Array schreiben
DataViews(i) = row.Item(1) & "." & row.Item(2)
i += 1
End If
End If
Next
' Array zurückgeben
Return DataViews
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die MSSQL-Datenansichten der Datenbank konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenansichten MSSQL")
Return Nothing
End Try
End Function
Private Function GetMsSqlFunctions(Type As String) As String()
Try
Dim SqlString As String
Dim DataViews() As String = Nothing
Dim i As Integer = 0
'Dim ConnectionString As SqlConnectionStringBuilder
Dim Connection As SqlConnection
Dim Command As SqlCommand
Dim DataAdapter As SqlDataAdapter
Dim DataSet As DataSet = New DataSet()
Dim con As String
' ConnectionString aufbauen
If _selectedProfil.UserId = "WINAUTH" Then
con = "Data Source=" & _selectedProfil.DataSource & ";Initial Catalog=" & _selectedProfil.InitialCatalog & ";Trusted_Connection=True;"
Else
con = "Server=" & _selectedProfil.DataSource & ";Database=" & _selectedProfil.InitialCatalog & ";User Id=" & _selectedProfil.UserId & ";Password=" & _selectedProfil.Password & ";"
End If
'ConnectionString = New SqlConnectionStringBuilder()
'ConnectionString.DataSource = Me._selectedProfil.DataSource
'ConnectionString.UserID = Me._selectedProfil.UserId
'ConnectionString.Password = Me._selectedProfil.Password
'ConnectionString.InitialCatalog = Me._selectedProfil.InitialCatalog
' Verbindung zur DB herstellen
Connection = New SqlConnection(con)
Connection.Open()
' DB-Abfrage für alle Views definieren
SqlString = $"SELECT O.name FROM sys.sql_modules M INNER JOIN sys.objects O ON M.object_id=O.object_id WHERE O.type = '{Type}'"
' die DB-Abfrage erzeugen
Command = New SqlCommand(SqlString, Connection)
' die DB-Abfrage durchführen
DataAdapter = New SqlDataAdapter(Command)
' das DataSet mit den Daten füllen
DataAdapter.Fill(DataSet)
If DataSet.Tables(0).Rows.Count > 0 Then
Dim tabellenart As String = "FUNCTIONS"
' alle Ergebnisse (VIEWs) durchlaufen
For Each row As DataRow In DataSet.Tables(0).Rows
If DataViews IsNot Nothing Then ReDim Preserve DataViews(DataViews.Length) Else ReDim DataViews(0)
' View in Array schreiben
DataViews(i) = row.Item(0)
i += 1
Next
' Array zurückgeben
Return DataViews
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die MSSQL-Datenansichten der Datenbank konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenansichten MSSQL")
Return Nothing
End Try
End Function
''' <summary>
''' Liest alle Spalten eines Datenbankviews oder einer Tabelle aus
''' </summary>
''' <param name="table">Name des Datenbankviews oder der Tabelle</param>
''' <returns>Liefert eine Liste mit Namen aller Spalten in dem View oder der Tabelle</returns>
''' <remarks></remarks>
Private Function GetMsSqlColumnsByTable(ByVal table As String) As String()
Try
Dim Columns() As String
Dim i As Integer = 0
'Dim ConnectionString As SqlConnectionStringBuilder = New SqlConnectionStringBuilder()
'ConnectionString.InitialCatalog = Me._selectedProfil.InitialCatalog
'ConnectionString.DataSource = Me._selectedProfil.DataSource
'ConnectionString.UserID = Me._selectedProfil.UserId
'ConnectionString.Password = Me._selectedProfil.Password
Dim con As String
' ConnectionString aufbauen
If _selectedProfil.UserId = "WINAUTH" Then
con = "Data Source=" & _selectedProfil.DataSource & ";Initial Catalog=" & _selectedProfil.InitialCatalog & ";Trusted_Connection=True;"
Else
con = "Server=" & _selectedProfil.DataSource & ";Database=" & _selectedProfil.InitialCatalog & ";User Id=" & _selectedProfil.UserId & ";Password=" & _selectedProfil.Password & ";"
End If
Dim Connection As SqlConnection = New SqlConnection(con)
Connection.Open()
Dim query As String = "select COLUMN_NAME from INFORMATION_SCHEMA.COLUMNS where TABLE_NAME='" & table & "'"
Dim Command As SqlCommand = New SqlCommand(query, Connection)
Dim da As SqlDataAdapter = New SqlDataAdapter(Command)
Dim ds As DataSet = New DataSet()
da.Fill(ds)
ReDim Columns(ds.Tables(0).Rows.Count - 1)
If ds.Tables(0).Rows.Count > 0 Then
For Each row As DataRow In ds.Tables(0).Rows
Columns(i) = row.Item(0)
i += 1
Next
Return Columns
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die Spalten aus dem View '" & table & "' konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenbankspalten MSSQL")
Return Nothing
End Try
End Function
''' <summary>
''' Liest alle Datenbankviews aus, die in der Datenbank des gewählten Profils gespeichert sind
''' </summary>
''' <returns>Liefert eine Liste mit den Namen der Datenbankviews</returns>
''' <remarks></remarks>
Private Function GetOracleDataviews(Optional ByVal return_views As Boolean = True) As String()
Try
Dim SqlString As String
Dim DataViews() As String
Dim i As Integer = 0
Dim conn As New OracleConnectionStringBuilder
Dim connstr As String
If Me._selectedProfil.DataSource <> "" And Me._selectedProfil.InitialCatalog <> "" Then
connstr = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & _selectedProfil.DataSource & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" &
_selectedProfil.InitialCatalog & ")));User Id=" & Me._selectedProfil.UserId & ";Password=" & Me._selectedProfil.Password & ";"
Else
conn.DataSource = Me._selectedProfil.DataSource
conn.UserID = Me._selectedProfil.UserId
conn.Password = Me._selectedProfil.Password
conn.PersistSecurityInfo = True
conn.ConnectionTimeout = 120
connstr = conn.ConnectionString
End If
Dim Oracle_Connection As New OracleConnection(connstr)
Dim Oracle_Command As OracleCommand = Nothing
Dim DataAdapter As OracleDataAdapter = Nothing
Dim DataSet As DataSet = New DataSet()
Oracle_Connection.Open()
If return_views Then
' DB-Abfrage für alle Views definieren
SqlString = "select VIEW_NAME from USER_VIEWS"
Else
' DB-Abfrage für alle Tables definieren
SqlString = "select TABLE_NAME from USER_TABLES"
End If
' die DB-Abfrage erzeugen
Oracle_Command = New OracleCommand(SqlString, Oracle_Connection)
' die DB-Abfrage durchführen
DataAdapter = New OracleDataAdapter(Oracle_Command)
' das DataSet mit den Daten füllen
DataAdapter.Fill(DataSet)
' Arraygrösse anpassen
ReDim DataViews(DataSet.Tables(0).Rows.Count - 1)
If DataSet.Tables(0).Rows.Count > 0 Then
' alle Ergebnisse (VIEWs) durchlaufen
For Each row As DataRow In DataSet.Tables(0).Rows
' View in Array schreiben
DataViews(i) = row.Item(0)
i += 1
Next
' Array zurückgeben
Return DataViews
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die Datenansichten der Datenbank konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenansichten Oracle:")
Return Nothing
End Try
End Function
''' <summary>
''' Liest alle Spalten eines Datenbankviews oder einer Tabelle aus
''' </summary>
''' <param name="table">Name des Datenbankviews oder der Tabelle</param>
''' <returns>Liefert eine Liste mit Namen aller Spalten in dem View oder der Tabelle</returns>
''' <remarks></remarks>
Private Function GetOracleColumnsByTable(ByVal table As String) As String()
Try
Dim Columns() As String
Dim i As Integer = 0
Dim conn As New OracleConnectionStringBuilder
Dim connstr As String
If Me._selectedProfil.DataSource <> "" And Me._selectedProfil.InitialCatalog <> "" Then
connstr = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & _selectedProfil.DataSource & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" &
_selectedProfil.InitialCatalog & ")));User Id=" & Me._selectedProfil.UserId & ";Password=" & Me._selectedProfil.Password & ";"
Else
conn.DataSource = Me._selectedProfil.DataSource
conn.UserID = Me._selectedProfil.UserId
conn.Password = Me._selectedProfil.Password
conn.PersistSecurityInfo = True
conn.ConnectionTimeout = 120
connstr = conn.ConnectionString
End If
Dim Oracle_Connection As New OracleConnection(connstr)
Dim Oracle_Command As OracleCommand = Nothing
Dim DataAdapter As OracleDataAdapter = Nothing
Dim DataSet As DataSet = Nothing
Oracle_Connection.Open()
Dim query As String = "select COLUMN_NAME from USER_TAB_COLS where TABLE_NAME='" & table & "'"
Oracle_Command = New OracleCommand(query, Oracle_Connection)
Dim da As OracleDataAdapter = New OracleDataAdapter(Oracle_Command)
Dim ds As DataSet = New DataSet()
da.Fill(ds)
ReDim Columns(ds.Tables(0).Rows.Count - 1)
If ds.Tables(0).Rows.Count > 0 Then
For Each row As DataRow In ds.Tables(0).Rows
Columns(i) = row.Item(0)
i += 1
Next
Return Columns
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die Spalten aus dem View '" & table & "' konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenbankspalten")
Return Nothing
End Try
End Function
Private Function MyGetSchemaRoutine(ByVal sConnString As String, ByVal sCollectionName As String, ByVal aRestrictArray As String()) As DataTable
' create a connection to the database
Using conn As New SqlConnection(sConnString)
Try
conn.Open()
' return DataTable with all metadata about Tables that
' match the restrictions specified in the array
Return conn.GetSchema(sCollectionName, aRestrictArray)
Catch ex As Exception
'output.Text = "* ERROR: " & ex.Message
Return Nothing
Finally
conn.Close()
End Try
End Using
End Function
''' <summary>
''' Liest alle Datenbankviews aus, die in der Datenbank des gewählten Profils gespeichert sind
''' </summary>
''' <returns>Liefert eine Liste mit den Namen der Datenbankviews</returns>
''' <remarks></remarks>
Private Function GetOdbcDataviews(Optional ByVal return_views As Boolean = True) As String()
Try
Dim SqlString As String = Nothing
Dim DataViews() As String = Nothing
Dim Connection As OdbcConnection = Nothing
Dim ConnectionString As OdbcConnectionStringBuilder = Nothing
Dim Command As OdbcCommand = Nothing
Dim DataAdapter As OdbcDataAdapter = Nothing
Dim DataSet As DataSet = Nothing
' ConnectionString aufbauen (aus Settings auslesen)
ConnectionString = New OdbcConnectionStringBuilder()
ConnectionString.ConnectionString = "Dsn=" & Me._selectedProfil.DataSource
If Me._selectedProfil.UserId IsNot Nothing Then
ConnectionString.ConnectionString &= ";Uid=" & Me._selectedProfil.UserId
If Me._selectedProfil.UserId IsNot Nothing Then
ConnectionString.ConnectionString &= ";Pwd=" & Me._selectedProfil.Password
End If
End If
' Verbindung zur Datenbank aufbauen
Try
Connection = New OdbcConnection(ConnectionString.ConnectionString)
Connection.Open()
Catch ex As Exception
_Logger.Error(ex)
' DB-Connection schliessen
Me.CloseOdbcDb(Connection)
Return Nothing
End Try
Dim restrictions(3) As String
restrictions(0) = Nothing ' database/catalog name
restrictions(1) = Nothing ' owner/schema name
restrictions(2) = Nothing ' table name
restrictions(3) = "TABLE" ' table type
Dim table As DataTable = Connection.GetSchema("Tables") ', restrictions)
Dim tabellenart As String = "VIEW"
If return_views Then
tabellenart = "VIEW"
Else
tabellenart = "TABLE"
End If
If table.Rows.Count > 0 Then
Dim indexEintrag As Integer = 0
' Array mit Namen der DatenViews erstellen
For i As Integer = 0 To table.Rows.Count - 1
If table.Rows(i)!TABLE_TYPE.ToString = tabellenart Then
' Größe des Arrays anpassen
If DataViews Is Nothing Then ReDim DataViews(0) Else ReDim Preserve DataViews(DataViews.Length)
' Tabellen- oder Viewname eintragen
DataViews(indexEintrag) = table.Rows(i)!TABLE_NAME.ToString
indexEintrag += 1
End If
Next i
Me.CloseOdbcDb(Connection)
' Array zurückgeben
Return DataViews
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die Datenansichten der ODBC-Datenbank konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenansichten")
Return Nothing
End Try
End Function
Private Function GetOdbcColumnsByTable(ByVal table As String) As String()
Try
Dim SqlString As String = Nothing
Dim Columns() As String = Nothing
Dim Connection As OdbcConnection = Nothing
Dim ConnectionString As OdbcConnectionStringBuilder = Nothing
Dim Command As OdbcCommand = Nothing
Dim DataAdapter As OdbcDataAdapter = Nothing
Dim DataSet As DataSet = Nothing
' ConnectionString aufbauen (aus Settings auslesen)
ConnectionString = New OdbcConnectionStringBuilder()
ConnectionString.ConnectionString = "Dsn=" & Me._selectedProfil.DataSource
If Me._selectedProfil.UserId IsNot Nothing Then
ConnectionString.ConnectionString &= ";Uid=" & Me._selectedProfil.UserId
If Me._selectedProfil.UserId IsNot Nothing Then
ConnectionString.ConnectionString &= ";Pwd=" & Me._selectedProfil.Password
End If
End If
' Verbindung zur Datenbank aufbauen
Try
Connection = New OdbcConnection(ConnectionString.ConnectionString)
Connection.Open()
Catch ex As Exception
_Logger.Warn("ClassSearchResults.GetValueFromOdbcDb: Verbindung zur Datenbank aufbauen: " & ex.Message)
' DB-Connection schliessen
Me.CloseOdbcDb(Connection)
Return Nothing
End Try
Dim restrictions(2) As String
restrictions(0) = Nothing ' Datenbank (Northwind)
restrictions(1) = Nothing ' Tabellenschema (dbo)
restrictions(2) = table ' Tabellenname (Orders)
Dim schemaTable As DataTable = Connection.GetSchema("Columns", restrictions)
If schemaTable.Rows.Count > 0 Then
ReDim Columns(schemaTable.Rows.Count - 1)
' Array mit Namen der DatenViews erstellen
For i As Integer = 0 To schemaTable.Rows.Count - 1
' Tabellen- oder Viewname eintragen
Columns(i) = schemaTable.Rows(i)!COLUMN_NAME.ToString
Next i
Me.CloseOdbcDb(Connection)
' Array zurückgeben
Return Columns
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die Tabellenspalten der Tabelle " & table & " konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenansichten ODBC")
Return Nothing
End Try
End Function
Private Sub CloseOdbcDb(ByRef Connection As OdbcConnection)
' wenn eine Datenbank-Connection aufgebaut ist
If Connection IsNot Nothing Then
' diese schliessen
Connection.Close()
Connection = Nothing
End If
End Sub
''' <summary>
''' Liest alle Datenbankviews aus, die in der Datenbank des gewählten Profils gespeichert sind
''' </summary>
''' <returns>Liefert eine Liste mit den Namen der Datenbankviews</returns>
''' <remarks></remarks>
Private Function GetOleDataviews(Optional ByVal return_views As Boolean = True) As String()
Try
Dim DataViews() As String = Nothing
Dim ConnectionString As OleDbConnectionStringBuilder
Dim Connection As OleDbConnection
' ConnectionString aufbauen
ConnectionString = New OleDbConnectionStringBuilder()
ConnectionString.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & Me._selectedProfil.DataSource
' wenn für das Profil eine UserId angegeben wurde
If Me._selectedProfil.UserId <> "" Then
' die UserId an ConnectionString anhängen
ConnectionString.ConnectionString &= ";User Id=" & Me._selectedProfil.UserId
' und das Passwort anhängen, falls eins angegeben wurde
If Me._selectedProfil.Password <> "" Then ConnectionString.ConnectionString &= ";Password=" & Me._selectedProfil.Password
End If
' Verbindung zur DB herstellen
Connection = New OleDbConnection(ConnectionString.ConnectionString)
Connection.Open()
Dim schemaTable
If return_views Then
' die Schema-Tabelle mit Informationen über Views auslesen
schemaTable = Connection.GetOleDbSchemaTable(OleDbSchemaGuid.Views,
New Object() {Nothing, Nothing, Nothing})
Else
' die Schema-Tabelle mit Informationen über Tabellen auslesen
schemaTable = Connection.GetOleDbSchemaTable(OleDbSchemaGuid.Tables,
New Object() {Nothing, Nothing, Nothing})
End If
If schemaTable.Rows.Count > 0 Then
' Array mit Namen der DatenViews erstellen
For i As Integer = 0 To schemaTable.Rows.Count - 1
If Not return_views Then
If schemaTable.Rows(i)!TABLE_TYPE.ToString = "TABLE" Or schemaTable.Rows(i)!TABLE_TYPE.ToString = "PASS-THROUGH" Then
If DataViews IsNot Nothing Then
' Größe des Arrays anpassen
ReDim Preserve DataViews(DataViews.Length)
Else
ReDim DataViews(0)
End If
DataViews(DataViews.Length - 1) = schemaTable.Rows(i)!TABLE_NAME.ToString
End If
Else
If DataViews IsNot Nothing Then
' Größe des Arrays anpassen
ReDim Preserve DataViews(DataViews.Length)
Else
ReDim DataViews(0)
End If
DataViews(DataViews.Length - 1) = schemaTable.Rows(i)!TABLE_NAME.ToString
End If
Next i
' Array zurückgeben
Return DataViews
Else
Return Nothing
End If
Catch ex As Exception
MsgBox("Die Datenansichten der Datenbank konnten nicht fehlerfrei ausgelesen werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Auslesen der Datenansichten OLE")
Return Nothing
End Try
End Function
Private Function GetOleColumnsByTable(ByVal table As String) As String()
Dim Columns() As String = Nothing
Dim ConnectionString As OleDbConnectionStringBuilder
Dim Connection As OleDbConnection
' ConnectionString aufbauen
ConnectionString = New OleDbConnectionStringBuilder()
ConnectionString.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & Me._selectedProfil.DataSource
' wenn für das Profil eine UserId angegeben wurde
If Me._selectedProfil.UserId <> "" Then
' die UserId an ConnectionString anhängen
ConnectionString.ConnectionString &= ";User Id=" & Me._selectedProfil.UserId
' und das Passwort anhängen, falls eins angegeben wurde
If Me._selectedProfil.Password <> "" Then ConnectionString.ConnectionString &= ";Password=" & Me._selectedProfil.Password
End If
' Verbindung zur DB herstellen
Connection = New OleDbConnection(ConnectionString.ConnectionString)
Connection.Open()
Dim schemaTable = Connection.GetOleDbSchemaTable(OleDbSchemaGuid.Columns,
New Object() {Nothing, Nothing, table, Nothing})
If schemaTable.Rows.Count > 0 Then
' Größe des Arrays anpassen
ReDim Columns(schemaTable.Rows.Count - 1)
' Array mit Namen der DatenViews erstellen
For i As Integer = 0 To schemaTable.Rows.Count - 1
Columns(i) = schemaTable.Rows(i)!COLUMN_NAME.ToString
'Console.WriteLine(schemaTable.Rows(i)!COLUMN_NAME.ToString)
Next i
' Array zurückgeben
Return Columns
Else
Return Nothing
End If
End Function
Private Function Getvktinsert_State()
Try
If rbvkt_add.Checked = True Then
If chkvkt_Dublette.Checked Then
Return 3
Else
Return 2
End If
Else
Return 1
End If
Catch ex As Exception
MsgBox("Fehler in Getvktinsert_State:" & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Function
Private Sub btnLink_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLink.Click
' wenn im ListView ein Element selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' ListView deselektieren
Me.lvwVerknuepfungen.SelectedItems.Item(0).Selected = False
End If
Dim vktState = Getvktinsert_State()
Select Case Me._selectedProfil.Ni_Art
Case "db"
Try
' wenn sowohl ein Index als auch eine Spalte ausgewählt wurde
If (Me.lbxWMIndex.SelectedItems.Count > 0) And ((Me.lbxQuelle1.SelectedItems.Count > 0) Or Me.txtManIndexwert.Text <> "") Then
Dim Indexquelle, Datenquelle As String
If Me.txtManIndexwert.Text <> "" Then
Indexquelle = "%" & txtManIndexwert.Text & "%"
Datenquelle = "manuell"
Else
Indexquelle = Me.lbxQuelle1.SelectedItem
Datenquelle = Me.cmbDataviews.SelectedItem
End If
' Eintrag in ListView machen
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {Me.lbxWMIndex.SelectedItem, Indexquelle, Datenquelle}))
' das Textfeld der SQL-Anweisung leeren
Me.txtSelectAnweisung.Text = ""
' dem Profil den neuen Link anhängen
Me._selectedProfil._links.AddLink(Me.lbxWMIndex.SelectedItem, Indexquelle, Datenquelle, Me.txtSelectAnweisung.Text, vktState)
' Liste mit Spalten deselektieren
Me.lbxQuelle1.SelectedIndex = -1
If Me.txtManIndexwert.Text = "" Then
Dim indextype As String = _windreamNI.GetIndex_Type(Me.lbxWMIndex.SelectedItem)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(Me.lbxWMIndex.SelectedItem)
End If
Else
Me.txtManIndexwert.Text = ""
End If
' definieren das am aktuellen Profil Änderungen vorgenommen wurden
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
End If
Catch ex As Exception
MsgBox("Die Verknüpfung (Datenbank) konnte nicht angelegt werden:" & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "xml"
Try
Dim _value As String
' wenn sowohl ein Index als auch eine Spalte ausgewählt wurde
If (Me.lbxWMIndex.SelectedItems.Count > 0) And ((Me.trvwxml.SelectedNode Is Nothing = False Or Me.txtManIndexwert.Text <> "")) Then
If Me.txtManIndexwert.Text <> "" Then
_value = "%" & Me.txtManIndexwert.Text & "%"
Me.txtManIndexwert.Text = ""
Else
If _selectedProfil.xmlEnd = "xml (ZugFerd)" Then
If trvwxml.SelectedNode.Tag = "SellerTradeParty:Name" Then
_value = "SellerTradeParty:Name"
ElseIf trvwxml.SelectedNode.Tag = "SpecifiedTaxRegistration" Then
_value = "SpecifiedTaxRegistration"
End If
Else
If trvwxml.SelectedNode.Index = 0 Then
'Typ soll indexiert werden
_value = Me.trvwxml.Nodes(0).Nodes(0).Text
ElseIf trvwxml.SelectedNode.Index >= 1 Then
'Wert soll indexiert werden
' MsgBox(trvwxml.SelectedNode.ToString & vbNewLine & trvwxml.SelectedNode.Index)
_value = "FreeFormField|" & trvwxml.SelectedNode.ToString.Replace("TreeNode: ", "")
End If
End If
End If
' Eintrag in ListView machen
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {Me.lbxWMIndex.SelectedItem, _value}))
' dem Profil den neuen Link anhängen
Me._selectedProfil._links.AddLink(Me.lbxWMIndex.SelectedItem, _value, "", "", vktState)
' den Index aus Liste mit Indexen löschen
' Me.lbxIndexDatei.Items.Remove(Me.lbxIndexDatei.SelectedItem)
' definieren das am aktuellen Profil Änderungen vorgenommen wurden
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
'Else
' MsgBox("Bitte wählen Sie einen Orangefarbenen Unterknoten aus, da dieser den Pfad innerhalb der xml-Datei zum indexierenden Wert beschreibt!", MsgBoxStyle.Exclamation, "Falsche Wahl:")
End If
Catch ex As Exception
MsgBox("Die XML-Verknüpfung konnte nicht angelegt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "fulltext"
Try
Dim _value As String
' wenn sowohl ein Index als auch eine Spalte ausgewählt wurde
If (Me.lbxWMIndex.SelectedItems.Count > 0) And ((Me.txtregex.Text <> "" Or Me.txtManIndexwert.Text <> "")) Then
If Me.txtManIndexwert.Text <> "" Then
_value = "%" & txtManIndexwert.Text & "%"
Me.txtManIndexwert.Text = ""
Else
_value = Me.txtregex.Text
End If
Dim pos_von, pos_bis As Integer
pos_von = 10000
If chkbxFT_Position.Checked Then
If rbFT_Position.Checked Then
If txtFT_Posvon.Text <> "" And txtFT_Posbis.Text <> "" Then
pos_von = txtFT_Posvon.Text
pos_bis = txtFT_Posbis.Text
End If
Else
If txtFT_Posvon.Text <> "" Then
pos_von = txtFT_Posvon.Text
End If
End If
Else
pos_von = 10000
End If
Dim Ft_area As String
If pos_von = 10000 Then
Ft_area = ""
Else
Ft_area = pos_von & ";" & pos_bis
End If
If chkboxWhitespace.Checked Then
Ft_area = Ft_area & ";" & "True"
Else
Ft_area = Ft_area & ";" & "False"
End If
' dem Profil den neuen Link anhängen
Me._selectedProfil._links.AddLink(Me.lbxWMIndex.SelectedItem, _value, "ft", Ft_area)
' Eintrag in ListView machen
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {Me.lbxWMIndex.SelectedItem, _value, Ft_area}))
Dim indextype As String = _windreamNI.GetIndex_Type(Me.lbxWMIndex.SelectedItem)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(lbxWMIndex.SelectedItem)
End If
' definieren das am aktuellen Profil Änderungen vorgenommen wurden
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
'Else
' MsgBox("Bitte wählen Sie einen Orangefarbenen Unterknoten aus, da dieser den Pfad innerhalb der xml-Datei zum indexierenden Wert beschreibt!", MsgBoxStyle.Exclamation, "Falsche Wahl:")
End If
Catch ex As Exception
MsgBox("Die fulltext-Verknüpfung konnte nicht angelegt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "activedirectory"
Try
' wenn sowohl ein Index als auch eine Spalte ausgewählt wurde
If (Me.lbxWMIndex.SelectedItems.Count > 0) And ((Me.lbxQuelle1.SelectedItems.Count > 0) Or Me.txtManIndexwert.Text <> "") Then
' wenn im ListView ein Element selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' ListView deselektieren
Me.lvwVerknuepfungen.SelectedItems.Item(0).Selected = False
End If
Dim Indexquelle, Datenquelle As String
If Me.txtManIndexwert.Text <> "" Then
Indexquelle = "%" & txtManIndexwert.Text & "%"
Datenquelle = "manuell"
Else
Indexquelle = Me.lbxQuelle1.SelectedItem.ToString.Trim
Datenquelle = "AD"
End If
' Eintrag in ListView machen
Me.lvwVerknuepfungen.Items.Add(New Windows.Forms.ListViewItem(New String() {Me.lbxWMIndex.SelectedItem, Indexquelle, Datenquelle}))
' das Textfeld der SQL-Anweisung leere
Me.txtLDAP_EinschrUserGroup.Text = "(" & Indexquelle & "=[%" & Me.lbxWMIndex.SelectedItem & "])"
' dem Profil den neuen Link anhängen
Me._selectedProfil._links.AddLink(Me.lbxWMIndex.SelectedItem, Indexquelle, Datenquelle, Me.txtLDAP_EinschrUserGroup.Text)
' Liste mit Spalten deselektieren
Me.lbxQuelle1.SelectedIndex = -1
If Me.txtManIndexwert.Text = "" Then
Dim indextype As String = _windreamNI.GetIndex_Type(Me.lbxWMIndex.SelectedItem)
If Not indextype.StartsWith("Vektor") Then
' dann diesen Eintrag löschen
Me.lbxWMIndex.Items.Remove(Me.lbxWMIndex.SelectedItem)
End If
Else
Me.txtManIndexwert.Text = ""
End If
' definieren das am aktuellen Profil Änderungen vorgenommen wurden
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
End If
Catch ex As Exception
MsgBox("Die Verknüpfung (LDAP) konnte nicht angelegt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Select
End Sub
Private Sub btnUnlink_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnUnlink.Click
Select Case Me._selectedProfil.Ni_Art
Case "db"
Try
' wenn eine Zeile im ListView ausgewählt wurde
If (Me.lvwVerknuepfungen.SelectedItems.Count > 0) Then
' wenn der Index nicht in der Liste der Indexe steht
If Me.lbxWMIndex.FindStringExact(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text) = Windows.Forms.ListBox.NoMatches Then
' diesen Index hinzufügen
Me.lbxWMIndex.Items.Add(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text)
End If
' den Link aus dem aktuellen Profil entfernen
Me._selectedProfil._links.RemoveLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(2).Text)
' den Link aus dem ListView entfernen
Me.lvwVerknuepfungen.Items.Remove(Me.lvwVerknuepfungen.SelectedItems.Item(0))
End If
Catch ex As Exception
MsgBox("Die Verknüpfung (DB) konnte nicht entfernt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "xml"
Try
' wenn eine Zeile im ListView ausgewählt wurde
If (Me.lvwVerknuepfungen.SelectedItems.Count > 0) Then
' wenn der Index nicht in der Liste der Indexe steht
If Me.lbxWMIndex.FindStringExact(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text) = Windows.Forms.ListBox.NoMatches Then
' diesen Index hinzufügen
Me.lbxWMIndex.Items.Add(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text)
End If
' den Link aus dem aktuellen Profil entfernen
Me._selectedProfil._links.RemoveLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, "")
' den Link aus dem ListView entfernen
Me.lvwVerknuepfungen.Items.Remove(Me.lvwVerknuepfungen.SelectedItems.Item(0))
End If
Catch ex As Exception
MsgBox("Die Xml-Verknüpfung konnte nicht entfernt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "fulltext"
Try
' wenn eine Zeile im ListView ausgewählt wurde
If (Me.lvwVerknuepfungen.SelectedItems.Count > 0) Then
' wenn der Index nicht in der Liste der Indexe steht
If Me.lbxWMIndex.FindStringExact(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text) = Windows.Forms.ListBox.NoMatches Then
' diesen Index hinzufügen
Me.lbxWMIndex.Items.Add(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text)
End If
' den Link aus dem aktuellen Profil entfernen
Me._selectedProfil._links.RemoveLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, "ft")
' den Link aus dem ListView entfernen
Me.lvwVerknuepfungen.Items.Remove(Me.lvwVerknuepfungen.SelectedItems.Item(0))
End If
Catch ex As Exception
MsgBox("Die fulltext-Verknüpfung konnte nicht entfernt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "activedirectory"
Try
' wenn eine Zeile im ListView ausgewählt wurde
If (Me.lvwVerknuepfungen.SelectedItems.Count > 0) Then
' wenn der Index nicht in der Liste der Indexe steht
If Me.lbxWMIndex.FindStringExact(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text) = Windows.Forms.ListBox.NoMatches Then
' diesen Index hinzufügen
Me.lbxWMIndex.Items.Add(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text)
End If
' den Link aus dem aktuellen Profil entfernen
Me._selectedProfil._links.RemoveLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(2).Text)
' den Link aus dem ListView entfernen
Me.lvwVerknuepfungen.Items.Remove(Me.lvwVerknuepfungen.SelectedItems.Item(0))
End If
Catch ex As Exception
MsgBox("Die Verknüpfung LDAP konnte nicht entfernt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Select
End Sub
Private Sub lvwVerknuepfungen_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lvwVerknuepfungen.SelectedIndexChanged
If Not Me._selectedProfil._links.IsSaved Then
Dim msgResult As MsgBoxResult = MsgBox("Möchten Sie die Änderungen speichern?", MsgBoxStyle.YesNoCancel, "Änderungen übernehmen?")
If msgResult = MsgBoxResult.Yes Then
'If Not Me._selectedProfil.IsSaved Then
' SaveProfile()
'End If
If Not Me._selectedProfil._links.IsSaved Then
SaveLinks()
End If
Else
Me._selectedProfil._links.setLinksSaved()
End If
End If
Select Case Me._selectedProfil.Ni_Art
Case "db"
Try
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
If Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text.StartsWith("%") And Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text.EndsWith("%") Then
Me.grbFilterDB.Enabled = False
Exit Sub
End If
End If
'If Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text <> "manuell" Or Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text <> "ft" TGetVariableNameshen
'grbEinschränkung.Visible = True
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
'wenn es Änderungen gab werden diese zurückgesetzt
If Not Me._selectedProfil._links.selectedLink.getSelectAnweisung = Me._selectedProfil._links.selectedLink.getOriginalSelectAnweisung Then
Me._selectedProfil._links.selectedLink.setSelectAnweisung(Me._selectedProfil._links.selectedLink.getOriginalSelectAnweisung)
End If
End If
' merken ob das Profil geändert wurde
Dim gespeichertVorher = Me._selectedProfil.GetSaved
Dim gespeichertLinkVorher = Me._selectedProfil._links.IsLinksSaved
' wenn im ListView eine Zeile ausgewählt wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' die GroupBox aktivieren wenn sie noch nicht aktiviert ist
If Me.grbFilterDB.Enabled = False Then
Me.grbFilterDB.Enabled = True
End If
'MsgBox(Me.lvwVerbunden.SelectedItems(0).SubItems(0).Text & vbNewLine & Me.lvwVerbunden.SelectedItems(0).SubItems(1).Text & vbNewLine & Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text)
' den aktuell gewählten Link festlegen
Me._selectedProfil._links.selectedLink = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text)
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
' die SQL-Anweisung der ausgewählten Verknüpfung in das Textfeld schreiben
Me.txtSelectAnweisung.Text = Me._selectedProfil._links.selectedLink.SelectAnweisung 'Me.selectedProfil.getLinkByValues(Me.lvwVerbunden.SelectedItems(0).SubItems(0).Text, Me.lvwVerbunden.SelectedItems(0).SubItems(1).Text, Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text).getSelectAnweisung()
Me.grbFilterDB.Enabled = True
Me.btnSaveAll.Enabled = False
' mit dem Cursor an die letzte Position springen
Me.txtSelectAnweisung.SelectionStart = Me.txtSelectAnweisung.Text.Length
End If
' die ComboBox mit den windream-Indexen deselektieren
Me.cmbWindreamIndexe.SelectedIndex = -1
Me.cmbIndex_Statusfertig.SelectedIndex = -1
' die ComboBox mit den Spalten der aktuellen Verknüpfung leeren
Me.cmbDatenbankSpalten.Items.Clear()
Me.cmbSpalten_indexSQL.Items.Clear()
' den VIEW der aktuell ausgewählten Verknüpfung auslesen
Dim selectedView As String = Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text
' ein Array für die DB-Spalten definieren
Dim columns() As String = Nothing
Dim words As String() = Me._selectedProfil._links.selectedLink.From.ToString.Split(".")
' wenn es sich um die Oracle Version handelt
If Me._selectedProfil.DbArt = "Oracle" Then
' alle Spalten aus Oracle auslesen
columns = Me.GetOracleColumnsByTable(words(0))
ElseIf Me._selectedProfil.DbArt = "MS-SQL" Then
' alle Spalten aus MS-SQL auslesen
Try
columns = Me.GetMsSqlColumnsByTable(words(1)) 'Me._selectedProfil._links.selectedLink.From)
Catch ex As Exception
End Try
ElseIf Me._selectedProfil.DbArt = "ODBC" Then
' alle Spalten über ODBC auslesen
columns = Me.GetOdbcColumnsByTable(words(0))
ElseIf Me._selectedProfil.DbArt = "OLE (Access)" Then
' alle Spalten aus Access-Tabelle auslesen
columns = Me.GetOleColumnsByTable(words(1))
Else
' die Art der Datenbank wird noch nicht unterstützt (falscher Eintrag in Settings)
MsgBox("Der gewählte Datenbanktyp ist unbekannt.", MsgBoxStyle.Critical, "Ungültiger Datenbanktyp")
End If
If columns IsNot Nothing Then
' alle Spalten durchlaufen
For Each column As String In columns
' und in die ComboBox eintragen
Me.cmbDatenbankSpalten.Items.Add(column)
Me.cmbSpalten_indexSQL.Items.Add(column)
Next
End If
Me.cmbDatenbankSpalten.SelectedIndex = -1
Me.cmbSpalten_indexSQL.SelectedIndex = -1
Me.txtSelectAnweisung.Focus()
Else ' wenn keine Verknüpfung ausgewählt ist
' MsgBox(Me.lvwVerbunden.SelectedIndices.Item(0))
' die GroupBox deaktivieren
Me.grbFilterDB.Enabled = False
' und die TextBox der SQL-Anweisung leeren
Me.txtSelectAnweisung.Text = ""
End If
' das Profil auf den (un-)gespeichert Status zurücksetzen
If gespeichertLinkVorher Then
Me._selectedProfil._links.setLinksSaved()
Else
Me._selectedProfil._links.setLinksChanged()
End If
If gespeichertVorher Then
Me._selectedProfil.setSaved()
Else
Me._selectedProfil.setChanged()
End If
'Else
'grbEinschränkung.Visible = False
'End If
Catch ex As Exception
MsgBox("Die Verknüpfung (DB) konnte nicht fehlerfrei gewählt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation)
End Try
Case "xml"
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
Me._selectedProfil._links.selectedLink = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text, "")
End If
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
Me.chkbxXml_Always_Write.Visible = True
' wenn es Änderungen gab werden diese zurückgesetzt
If Me._selectedProfil._links.selectedLink.getSelectAnweisung = "WRITE_ALWAYS" Then
change = True
chkbxXml_Always_Write.Checked = True
change = False
Else
change = True
chkbxXml_Always_Write.Checked = False
change = False
End If
End If
Case "fulltext"
Try
' If Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text <> "manuell" Or Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text <> "ft" Then
' grbEinschränkung.Visible = True
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
' wenn es Änderungen gab werden diese zurückgesetzt
If Not Me._selectedProfil._links.selectedLink.getSelectAnweisung = Me._selectedProfil._links.selectedLink.getOriginalSelectAnweisung Then
Me._selectedProfil._links.selectedLink.setSelectAnweisung(Me._selectedProfil._links.selectedLink.getOriginalSelectAnweisung)
End If
End If
' merken ob das Profil geändert wurde
Dim gespeichertVorher = Me._selectedProfil.GetSaved
Dim gespeichertLinkVorher = Me._selectedProfil._links.IsLinksSaved
' wenn im ListView eine Zeile ausgewählt wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
'MsgBox(Me.lvwVerbunden.SelectedItems(0).SubItems(0).Text & vbNewLine & Me.lvwVerbunden.SelectedItems(0).SubItems(1).Text & vbNewLine & Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text)
' den aktuell gewählten Link festlegen
pnlfulltext.Enabled = True
Me._selectedProfil._links.selectedLink = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text, "ft")
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
' die RegeX-Anweisung der ausgewählten Verknüpfung in das Textfeld schreiben
Me.txtregex.Text = Me._selectedProfil._links.selectedLink.Spalte 'Me.selectedProfil.getLinkByValues(Me.lvwVerbunden.SelectedItems(0).SubItems(0).Text, Me.lvwVerbunden.SelectedItems(0).SubItems(1).Text, Me.lvwVerbunden.SelectedItems(0).SubItems(2).Text).getSelectAnweisung()
If Me._selectedProfil._links.selectedLink.SelectAnweisung = "" Then
Me.chkbxFT_Position.Checked = False
Else
Dim area As String() = Me._selectedProfil._links.selectedLink.SelectAnweisung.Split(";")
Try
If CLng(area(0)) = 10000 Then
Me.chkbxFT_Position.Checked = False
Else
Me.chkbxFT_Position.Checked = True
Try
If CLng(area(1)) > 0 Then
Me.rbFT_Position.Checked = True
Me.txtFT_Posvon.Text = area(0)
Me.txtFT_Posbis.Text = area(1)
Else
Me.rbFT_single.Checked = True
Me.txtFT_Posvon.Text = area(0)
Me.txtFT_Posbis.Text = 0
End If
Catch ex As Exception
Me.chkbxFT_Position.Checked = False
End Try
End If
Catch ex As Exception
Me.chkbxFT_Position.Checked = False
End Try
Try
Me.chkboxWhitespace.Checked = CBool(area(2))
Catch ex As Exception
chkboxWhitespace.Checked = False
End Try
End If
End If
Else ' wenn keine Verknüpfung ausgewählt ist
' und die TextBox der SQL-Anweisung leeren
Me.txtregex.Text = ""
End If
' das Profil auf den (un-)gespeichert Status zurücksetzen
If gespeichertLinkVorher Then
Me._selectedProfil._links.setLinksSaved()
Else
Me._selectedProfil._links.setLinksChanged()
End If
If gespeichertVorher Then
Me._selectedProfil.setSaved()
Else
Me._selectedProfil.setChanged()
End If
'Else
'grbEinschränkung.Visible = False
'End If
Catch ex As Exception
MsgBox("Die fulltext-Verknüpfung konnte nicht fehlerfrei gewählt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
Case "activedirectory"
Try
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
' wenn es Änderungen gab werden diese zurückgesetzt
If Not Me._selectedProfil._links.selectedLink.getSelectAnweisung = Me._selectedProfil._links.selectedLink.getOriginalSelectAnweisung Then
Me._selectedProfil._links.selectedLink.setSelectAnweisung(Me._selectedProfil._links.selectedLink.getOriginalSelectAnweisung)
End If
End If
' merken ob das Profil geändert wurde
Dim gespeichertVorher = Me._selectedProfil.GetSaved
Dim gespeichertLinkVorher = Me._selectedProfil._links.GetSaved
' wenn im ListView eine Zeile ausgewählt wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' den aktuell gewählten Link festlegen
'MsgBox(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text & vbNewLine & Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text & vbNewLine & Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text)
Me._selectedProfil._links.selectedLink = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text)
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
' die SQL-Anweisung der ausgewählten Verknüpfung in das Textfeld schreiben
Me.txtLDAP_EinschrUserGroup.Text = Me._selectedProfil._links.selectedLink.SelectAnweisung
If Me._selectedProfil._links.selectedLink.SelectAnweisung <> "" Then
lblLDAP_Testwert.Text = "Testwert für " & LDAP_Return_Regex(Me.txtLDAP_EinschrUserGroup.Text)
Else
Me.txtLDAP_EinschrUserGroup.Text = "(sAMAccountName=[%Windream-INDEX])"
lblLDAP_Testwert.Text = "Testwert für " & LDAP_Return_Regex(Me.txtLDAP_EinschrUserGroup.Text)
End If
End If
' die ComboBox mit den windream-Indexen deselektieren
Me.cmbLDAP_Attribut.SelectedIndex = -1
Me.cmbLDAP_WDIndexSelect.SelectedIndex = -1
Else ' wenn keine Verknüpfung ausgewählt ist
' die GroupBox deaktivieren
' Me.grbEinschränkung.Enabled = False
' und die TextBox der SQL-Anweisung leeren
'Me.txtSelectAnweisung.Text = ""
End If
' das Profil auf den (un-)gespeichert Status zurücksetzen
If gespeichertLinkVorher Then
Me._selectedProfil._links.setLinksSaved()
Else
Me._selectedProfil._links.setLinksChanged()
End If
If gespeichertVorher Then
Me._selectedProfil.setSaved()
Else
Me._selectedProfil.setChanged()
End If
'Else
'grbEinschränkung.Visible = False
'End If
Catch ex As Exception
MsgBox("Die Verknüpfung LDAP konnte nicht fehlerfrei gewählt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation)
End Try
End Select
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
'Radiobuttons Vektor InsertState Überprüfen
selectedIndex_Type = _windreamNI.GetIndex_Type(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text)
visinvisible_Vektor_ins_State()
If selectedIndex_Type.StartsWith("Vektor") Then
Me.Changeinaction = True
Select Case Me._selectedProfil._links.selectedLink.vktins_state
Case 1
Me.rbvkt_overwrite.Checked = True
Case 2
Me.rbvkt_add.Checked = True
Me.chkvkt_Dublette.Checked = False
Case 3
Me.rbvkt_add.Checked = True
Me.chkvkt_Dublette.Checked = True
End Select
Me.Changeinaction = False
End If
End If
End If
End Sub
Private Sub btnZurücksetzen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnZurücksetzen.Click
Try
' wenn im ListView eine Zeile selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' die originale SQL-Anweisung der Verknüpfung auslesen und in die TextBox schreiben
Me.txtSelectAnweisung.Text = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).getOriginalSelectAnweisung()
End If
Catch ex As Exception
MsgBox("Die SELECT-Anweisung konnte nicht auf ihren Ursprungswert zurückgesetzt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Zurücksetzen der SQL-Anweisung")
End Try
End Sub
Private Sub SaveLinks()
Try
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
'Me._selectedProfil.Save(True, "link")
If Me._selectedProfil._links.selectedLink.SaveLink(Me._selectedProfil.Profilname, Me._selectedProfil.Ni_Art) = True Then
Me._selectedProfil._links.setLinksSaved()
Me.btnSaveAll.Enabled = False
'MsgBox("Verknüpfung erfolgreich gespeichert!", MsgBoxStyle.Information)
End If
With btnSaveAll
.Enabled = False
.ForeColor = Drawing.Color.Black
End With
End If
Catch ex As Exception
MsgBox("Fehler beim Speichern der DB-Verknüpfung." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub txtSelectAnweisung_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtSelectAnweisung.TextChanged
Try
' wenn im ListView eine Zeile selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' Überprüfen ob eingegebener Wert gepeichert werden muß?
Dim SQL_ORIGIN As String = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).getSelectAnweisung().ToString
If SQL_ORIGIN <> Me.txtSelectAnweisung.Text Then
With btnSaveAll
.Enabled = True
.ForeColor = Drawing.Color.Black
End With
End If
' die Informationen der selektierten Verknüpfung auslesen
Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).setSelectAnweisung(Me.txtSelectAnweisung.Text)
Me.btnSaveAll.Enabled = True
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
'Jetzt den Startwert bestimmen
'MsgBox("[%" & Me.lvwVerbunden.SelectedItems(0).SubItems(0).Text & "]")
If Me.txteindeutigerIndex.Text <> "" Then
If Me.txtSelectAnweisung.Text.Contains(Me.txteindeutigerIndex.Text) Then
Me.lblSQLTest.Text = "Testwert für eind. Index: " & "[%" & Me.txteindeutigerIndex.Text & "]"
End If
End If
End If
Catch ex As Exception
MsgBox("Die Verknüpfung konnte nicht angelegt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Anlegen einer Verknüpfung")
End Try
End Sub
' fügt den Spaltennamen der, in der ComboBox ausgewählten Spalte, in die TextBox ein
Private Sub btnSpalteEinfügen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSpalteEinfügen.Click
If Not Me.cmbDatenbankSpalten.SelectedItem = "" Then
Dim text As String = " " & Me.cmbDatenbankSpalten.SelectedItem.ToString.ToUpper & " ="
Dim altePosition As Integer = Me.txtSelectAnweisung.SelectionStart()
Me.txtSelectAnweisung.Text = Me.txtSelectAnweisung.Text.Insert(altePosition, text)
Me.txtSelectAnweisung.SelectionStart = altePosition + text.Length
End If
End Sub
' fügt den Indexnamen des, in der ComboBox ausgewählten Indexes, in die TextBox ein
Private Sub btnInsertWindreamIndex_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWindreamIndexEinfügen.Click
If Not Me.cmbWindreamIndexe.SelectedItem = "" Then
Dim text As String = " '[%" & Me.cmbWindreamIndexe.SelectedItem & "]' "
Dim altePosition As Integer = Me.txtSelectAnweisung.SelectionStart()
Me.txtSelectAnweisung.Text = Me.txtSelectAnweisung.Text.Insert(altePosition, text)
Me.txtSelectAnweisung.SelectionStart = altePosition + text.Length
vReplace = "[%" & cmbWindreamIndexe.SelectedItem & "]"
Me.lblSQLTest.Text = "Testwert für eind. Index: " & "[%" & cmbWindreamIndexe.SelectedItem & "]"
End If
End Sub
' fügt 'SELECT [%spalte] FROM [%view] WHERE' in die TextBox ein
Private Sub btnStandardSQL_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStandardSQL.Click
Me.txtSelectAnweisung.Text = "SELECT [%spalte] FROM [%view] WHERE "
Me.txtSelectAnweisung.SelectionStart = Me.txtSelectAnweisung.Text.Length
End Sub
Private Sub rbViews_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbViews.CheckedChanged
If Not _flagIgnoreCheckedChanged Then
If Me._selectedProfil Is Nothing = False Then
Me.cmbDataviews.Items.Clear()
' View- oder Tabellenliste
Dim dataviews() As String = Nothing
If Me._selectedProfil.DbArt = "Oracle" Then
dataviews = Me.GetOracleDataviews(Me.rbViews.Checked)
ElseIf Me._selectedProfil.DbArt = "MS-SQL" Then
dataviews = Me.GetMsSqlDataviews(Me.rbViews.Checked)
ElseIf Me._selectedProfil.DbArt = "ODBC" Then
dataviews = Me.GetOdbcDataviews(Me.rbViews.Checked)
ElseIf Me._selectedProfil.DbArt = "OLE (Access)" Then
dataviews = Me.GetOleDataviews(Me.rbViews.Checked)
Else
MsgBox("Der gewählte Datenbanktyp ist unbekannt.", MsgBoxStyle.Critical, "Unbekannter Datenbanktyp")
End If
If dataviews IsNot Nothing Then
For Each dataview As String In dataviews
Me.cmbDataviews.Items.Add(dataview)
Next
End If
Me.txtSelectAnweisung.Text = ""
Else
MsgBox("Bitte wählen Sie ein Profil aus!", MsgBoxStyle.Information, "Achtung:")
End If
End If
End Sub
Private Sub btnlvw_up_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnlvw_up.Click
LVWItemsMoveSelected(Me.lvwVerknuepfungen)
If _selectedProfil.Ni_Art <> "fulltext" Then
Dim vktState = Getvktinsert_State()
Me._selectedProfil._links.RenewLinks(Me.lvwVerknuepfungen, vktState)
End If
End Sub
Private Sub btnlvw_down_Click(sender As Object, e As EventArgs) Handles btnlvw_down.Click
LVWItemsMoveSelected(Me.lvwVerknuepfungen, True)
If _selectedProfil.Ni_Art <> "fulltext" Then
Dim vktState = Getvktinsert_State()
Me._selectedProfil._links.RenewLinks(Me.lvwVerknuepfungen, vktState)
End If
End Sub
'Private Sub btnSQL_Updatespeichern_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSQL_Updatespeichern.Click
' Try
' ' die Änderungen speichern
' If Me._selectedProfil.Save(True,"profile") = True Then ' wenn das Speichern erfolgreich war
' ' den Speichern-Button deaktivieren
' Me.btnSQL_Updatespeichern.Enabled = False
' Else
' MsgBox("Das Profil konnte nicht erfolgreich gespeichert werden.", MsgBoxStyle.Exclamation, "Fehler beim Speichern eines Profils")
' End If
' Catch ex As Exception
' MsgBox("Fehler beim Speichern des SQL-Befehles." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Speichern eines SQL-Befehls.")
' End Try
'End Sub
'Private Sub txtUpdateAnweisung_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtfinalSkriptUpdate.LostFocus
' Me._selectedProfil.SQL_Anweisung = txtfinalSkriptUpdate.Text
'If Me.txtfinalSkriptUpdate.Text <> "" Then
' Try
' ' die Änderungen speichern
' If Me._selectedProfil.Save(True,"profile") = True Then ' wenn das Speichern erfolgreich war
' Me._selectedProfil.setChanged()
' Else
' MsgBox("Das Profil konnte nicht erfolgreich gespeichert werden.", MsgBoxStyle.Exclamation, "Fehler beim Speichern eines Profils")
' End If
' Catch ex As Exception
' MsgBox("Fehler beim Speichern des SQL-Befehles." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Speichern eines SQL-Befehls.")
' End Try
'End If
'End Sub
Private Sub txtUpdateAnweisung_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtfinalSkriptUpdate.TextChanged
If Not Me.txtfinalSkriptUpdate.Text = String.Empty And Not Me.txtfinalSkriptUpdate.Text = Me._selectedProfil.OriginalSQL_Anweisung Then
Me._selectedProfil.SQL_Anweisung = Me.txtfinalSkriptUpdate.Text
Me._selectedProfil.setChanged()
btnSaveAll.Enabled = True
End If
End Sub
Private Sub btnWindreamIndexEinfügenSQL_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWindreamIndexEinfügenSQL.Click
If Not Me.cmbWindreamIndexeSQL.SelectedItem = "" Then
Dim text As String = "[%" & Me.cmbWindreamIndexeSQL.SelectedItem & "]"
Dim altePosition As Integer = Me.txtfinalSkriptUpdate.SelectionStart()
Me.txtfinalSkriptUpdate.Text = Me.txtfinalSkriptUpdate.Text.Insert(altePosition, text)
Me.txtfinalSkriptUpdate.SelectionStart = altePosition + text.Length
If Me._selectedProfil IsNot Nothing Then
Me._selectedProfil.SQL_Anweisung = Me.txtfinalSkriptUpdate.Text
If Not Me._selectedProfil.SQL_Anweisung = Me._selectedProfil.OriginalSQL_Anweisung Then
End If
End If
End If
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnaddUniqueIndex.Click
If (Me.lbxWMIndex.SelectedItems.Count > 0) Then
' Eintrag in textBox aktualisieren
Me.txteindeutigerIndex.Text = Me.lbxWMIndex.SelectedItem
Dim text As String = Me.lbxWMIndex.SelectedItem
If Me._selectedProfil IsNot Nothing Then
Me._selectedProfil.Desk_windreamIndex = text
If Not text = Me._selectedProfil.OriginalwindreamIndex Then
Me._selectedProfil.setChanged()
End If
End If
End If
End Sub
Private Sub btnTestSQL_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTestSQL.Click
Try
If Me.txtSelectAnweisung.Text = "" Then
MsgBox("Bitte geben Sie eine Select-Anweisung ein!", MsgBoxStyle.Exclamation, "Select-Anweisung fehlt:")
Me.txtTestwert.BackColor = Drawing.Color.Lime
Me.txtTestwert.Focus()
Exit Sub
End If
If Me.txtTestwert.Text = "" Then
MsgBox("Bitte geben Sie einen Testwert für den eindeutigen Startwert ein!", MsgBoxStyle.Exclamation, "Testparameter fehlt:")
Me.txtTestwert.BackColor = Drawing.Color.Lime
Me.txtTestwert.Focus()
Exit Sub
End If
Dim sql As String = Me.txtSelectAnweisung.Text
Dim sql_string As String = sql.Replace("[%spalte]", Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text)
Dim sql1 As String = sql_string.Replace("[%view]", Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(2).Text)
Dim sql2 As String
If _selectedProfil.DbArt = "Oracle" Then
sql2 = sql1.Replace("[%Startwert]", ":Startwert")
ElseIf _selectedProfil.DbArt = "MS-SQL" Then
sql2 = sql1.Replace("[%Startwert]", "@Startwert")
End If
'MsgBox(sql2)
vSQL = sql2
vstartwert = Me.txtTestwert.Text
vdatasource = Me._selectedProfil.DataSource
vInitialCatalog = Me._selectedProfil.InitialCatalog
vUserID = Me._selectedProfil.UserId
vPassword = _selectedProfil.Password
vDB_Art = _selectedProfil.DbArt
vReplace = "[%" & Me.txteindeutigerIndex.Text & "]"
If _selectedProfil.DbArt = "Oracle" Then
Dim FMTest_SQL As System.Windows.Forms.Form = New frmNI_SQLTest()
FMTest_SQL.ShowDialog()
ElseIf _selectedProfil.DbArt = "MS-SQL" Then
Dim FMTest_SQL As System.Windows.Forms.Form = New frmNI_SQLTest()
FMTest_SQL.ShowDialog()
End If
Me.txtTestwert.BackColor = Drawing.Color.White
Me.txtTestwert.Text = ""
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Öffnen des Testfensters SQL:")
End Try
End Sub
Private Sub frmNIVerknuepfungen_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If Me._selectedProfil IsNot Nothing Then
If Me._selectedProfil.Desk_windreamIndex = "" Then
If Me._selectedProfil.DbArt = "xml" Then
MsgBox("Bitte definieren Sie einen eindeutigen/deskriptiven Index!", MsgBoxStyle.Critical, "Fehlende Konfiguration:")
Me.txteindeutigerIndex.BackColor = Color.Lime
e.Cancel = True
End If
End If
If Me._selectedProfil.HasChanges Then
If _selectedProfil.MR_DAIndex <> "" And Me._selectedProfil.checkIndexsql = "" Then
MsgBox("Bitte definieren Sie einen SQL-Befehl zum überprüfen des gültigen Startindexwertes!", MsgBoxStyle.Critical, "Fehlende Konfiguration:")
Me.tabctrlbottom.SelectedIndex = 0
e.Cancel = True
End If
End If
Select Case Me.DialogResult
Case DialogResult.OK
If Not Me._selectedProfil.IsSaved Then SaveProfile()
If Not Me._selectedProfil._links.IsLinksSaved Then SaveLinks()
Case DialogResult.Cancel
'nichts
Case Else
' If Not Me._selectedProfil.IsSaved Or Not Me._selectedProfil._links.IsSaved Then
If Not Me._selectedProfil.IsSaved Then
Dim msgResult As MsgBoxResult = MsgBox("Möchten Sie die Änderungen speichern?", MsgBoxStyle.YesNoCancel, "Änderungen übernehmen?")
If msgResult = MsgBoxResult.Yes Then
If Not Me._selectedProfil.IsSaved Then
SaveProfile()
End If
If Not Me._selectedProfil._links.IsSaved Then
SaveLinks()
End If
End If
End If
End Select
End If
End Sub
Private Sub frmNIVerknuepfungen_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.LoadProfilesInCombobox()
If ClassNIProfile.aktivesProfilAusProfileigenschaften And ClassNIProfile.aktivesProfil Is Nothing = False Then
Me._selectedProfil = ClassNIProfile.aktivesProfil
Me.lblProfil.Text = "(" & Me._selectedProfil.Profilname & ")"
Me.lblProfil.Visible = True
Me.LoadSelectedProfile(Me._selectedProfil.Profilname)
ClassNIProfile.aktivesProfilAusProfileigenschaften = False
If Me._selectedProfil.Dokumenttyp Is Nothing Then
Me.lblProfil.Enabled = False
Else
Me.lblProfil.Enabled = True
End If
Else
Me._selectedProfil = Nothing
Me.pnlZielQuelle.Visible = False
Me.SplitContainer1.Visible = False
Me.pnlfulltext.Visible = False
End If
End Sub
Private Sub btnEindIndex_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEindIndex.Click
Dim text As String = Me.txteindeutigerIndex.Text
If text = "" Then
MsgBox("Bitte definieren Sie den eindeutigen Index!", MsgBoxStyle.Critical, "Eindeutiger Index fehlt!")
Exit Sub
End If
Dim altePosition As Integer = Me.txtSelectAnweisung.SelectionStart()
Me.txtSelectAnweisung.Text = Me.txtSelectAnweisung.Text.Insert(altePosition, "[%" & text & "]")
Me.txtSelectAnweisung.SelectionStart = altePosition + text.Length
End Sub
Private Sub CheckBox1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chbxStatusfertig.CheckedChanged
If Me.chbxStatusfertig.Checked Then
Me.cmbIndex_Statusfertig.Enabled = True
Try
Me.cmbIndex_Statusfertig.Items.Clear()
Dim indexe = _windream.GetIndicesByObjecttype(Me._selectedProfil.Dokumenttyp.aName, True, "NI")
If indexe IsNot Nothing Then
For Each index As String In indexe
Me.cmbIndex_Statusfertig.Items.Add(index)
Next
End If
If Not IsNothing(Me._selectedProfil.finalerIndex) Then
cmbIndex_Statusfertig.SelectedIndex = cmbIndex_Statusfertig.FindStringExact(Me._selectedProfil.finalerIndex)
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler beim Laden der windream-Indexe in die Auswahlliste 'cmbIndex_Statusfertig'")
End Try
Else
Me.cmbIndex_Statusfertig.Enabled = False
If Me._selectedProfil IsNot Nothing Then
Me._selectedProfil.finalerIndex = ""
Me._selectedProfil.setChanged()
End If
End If
End Sub
Private Sub cmbIndex_Statusfertig_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmbIndex_Statusfertig.SelectedIndexChanged
If Me.cmbIndex_Statusfertig.SelectedIndex <> -1 And cmbIndex_Statusfertig.Items.Count > 1 Then
If Me._selectedProfil IsNot Nothing Then
Me._selectedProfil.finalerIndex = cmbIndex_Statusfertig.SelectedItem
If Not Me._selectedProfil.finalerIndex = Me._selectedProfil.OriginalfinalerIndex Then
Me._selectedProfil.setChanged()
End If
End If
End If
End Sub
Private Sub rbTables_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbTables.CheckedChanged
End Sub
Private Sub btnfolder_Click(sender As System.Object, e As System.EventArgs) Handles btnxmlchooseFile.Click
If Me.OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Me.txtxml_Beispieldatei.Text = Me.OpenFileDialog1.FileName
End If
End Sub
Private Sub txtOrdnerDateien_TextChanged(sender As System.Object, e As System.EventArgs) Handles txtxml_Beispieldatei.TextChanged
If _formloaded = True Then
If Me.txtxml_Beispieldatei.Text <> String.Empty Then
If Me._selectedProfil IsNot Nothing Then
Me._selectedProfil.xmlFolder = txtxml_Beispieldatei.Text
If Not Me._selectedProfil.xmlFolder = Me._selectedProfil.OriginalxmlFolder Then
Me._selectedProfil.setChanged()
End If
End If
If IO.File.Exists(txtxml_Beispieldatei.Text) Then
If txtxml_Beispieldatei.Text.EndsWith(".xffres") Or txtxml_Beispieldatei.Text.EndsWith(".xfres") Then
XML_getTagsxffres(txtxml_Beispieldatei.Text)
ElseIf txtxml_Beispieldatei.Text.EndsWith(".xml") And _selectedProfil.xmlEnd = "xml" Then
XML_Regular(txtxml_Beispieldatei.Text)
ElseIf txtxml_Beispieldatei.Text.EndsWith(".xml") And _selectedProfil.xmlEnd = "xml (ZugFerd)" Then
XML_ZugFerd(txtxml_Beispieldatei.Text)
End If
End If
''die erste Datei auswählen
'Dim f As New IO.DirectoryInfo(txtxml_Beispieldatei.Text)
'If f.Exists = True Then
' Dim diPfad As New IO.DirectoryInfo(txtxml_Beispieldatei.Text)
' Dim Progress As Integer = 0
' For Each file As IO.FileInfo In diPfad.GetFiles()
' If file.Name.EndsWith(".xffres") Or file.Name.EndsWith(".xfres") Then
' XML_getTagsxffres(file.FullName)
' Exit For
' End If
' Next
'End If
End If
End If
End Sub
Sub XML_getTagsxffres(ByVal filename As String)
Dim _xmlDoc As New XmlDocument
_xmlDoc.Load(filename)
Dim tvwKnoten As TreeNode
Dim index As Integer = 0
Dim nodeklassi, nodeformresults As String
If filename.EndsWith("xffres") Then
nodeklassi = "FreeFormResult/FormDesignName"
ElseIf filename.EndsWith("xfres") Then
nodeklassi = "FormResult/FormDesignName"
End If
If filename.EndsWith("xffres") Then
nodeformresults = "FreeFormFieldResultBase"
ElseIf filename.EndsWith("xfres") Then
nodeformresults = "FieldResult"
End If
Dim nodeKlassifizierung As XmlNode = _xmlDoc.SelectSingleNode(nodeklassi)
If nodeKlassifizierung Is Nothing = False Then
tvwKnoten = Me.trvwxml.Nodes.Add(nodeKlassifizierung.Name)
tvwKnoten.Nodes.Add(nodeklassi)
tvwKnoten.Nodes.Add(nodeKlassifizierung.InnerText)
Me.trvwxml.Nodes(index).Nodes(0).ForeColor = Color.DarkOrange
Me.trvwxml.Nodes(index).Nodes(1).ForeColor = Color.Red
index = index + 1
End If
' Den Freiform-Ergebnis Knoten auswählen
Dim child_nodes As XmlNodeList = _xmlDoc.GetElementsByTagName(nodeformresults)
Dim formResultName, formResultErgebnis As String
' Process the children.
For Each child As XmlNode In child_nodes
Dim nodeName = child.SelectSingleNode("Name")
formResultName = nodeName.InnerText
' MsgBox(nodeName.InnerText)
If child.HasChildNodes Then
Dim REC_VALUE As String
If child.InnerXml.Contains("TextValue") Then
formResultName = "TEXTVALUE|" & formResultName
REC_VALUE = "FieldValues/FieldValue/String"
ElseIf child.InnerXml.Contains("CheckmarkValue") Then
formResultName = "CHECKMARK|" & formResultName
REC_VALUE = "FieldValues/FieldValue/Checked"
End If
Dim nodeErgebnis = child.SelectSingleNode(REC_VALUE)
formResultErgebnis = nodeErgebnis.InnerText
'MsgBox(nodeErgebnis.InnerText)
End If
tvwKnoten = Me.trvwxml.Nodes.Add(formResultName)
' tvwKnoten.Nodes.Add("FreeFormResult/FieldResults/FreeFormFieldResultBase/FieldValues/FieldValue/String")
tvwKnoten.Nodes.Add("Ergebnis: " & formResultErgebnis)
'For Each xmlKD In child
' MsgBox(xmlKD.InnerText)
'Next xmlKD
'MsgBox(child.Attributes("Name").InnerXml)
Next child
'Dim nodeWert As XmlNode = _xmlDoc.SelectSingleNode("FreeFormResult/FieldResults/FreeFormFieldResultBase/FieldValues/FieldValue/String")
'If nodeWert Is Nothing = False Then
' tvwKnoten = Me.trvwxml.Nodes.Add(nodeWert.Name)
' tvwKnoten.Nodes.Add("FreeFormResult/FieldResults/FreeFormFieldResultBase/FieldValues/FieldValue/String")
' tvwKnoten.Nodes.Add(nodeWert.InnerText)
' Me.trvwxml.Nodes(index).Nodes(0).ForeColor = Color.DarkOrange
' Me.trvwxml.Nodes(index).Nodes(1).ForeColor = Color.Red
'End If
End Sub
Sub XML_Regular(ByVal filename As String)
Dim xmldoc As New XmlDataDocument()
Dim xmlnode As XmlNode
Dim fs As New FileStream(filename, FileMode.Open, FileAccess.Read)
xmldoc.Load(fs)
xmlnode = xmldoc.ChildNodes(1)
trvwxml.Nodes.Clear()
trvwxml.Nodes.Add(New TreeNode(xmldoc.DocumentElement.Name))
Dim tNode As TreeNode
tNode = trvwxml.Nodes(0)
AddNode(xmlnode, tNode)
End Sub
Private Sub AddNode(ByVal inXmlNode As XmlNode, ByVal inTreeNode As TreeNode)
Dim xNode As XmlNode
Dim tNode As TreeNode
Dim nodeList As XmlNodeList
Dim i As Integer
If inXmlNode.HasChildNodes Then
nodeList = inXmlNode.ChildNodes
For i = 0 To nodeList.Count - 1
xNode = inXmlNode.ChildNodes(i)
inTreeNode.Nodes.Add(New TreeNode(xNode.Name))
tNode = inTreeNode.Nodes(i)
AddNode(xNode, tNode)
Next
Else
inTreeNode.Text = inXmlNode.InnerText.ToString
End If
End Sub
Sub XML_ZugFerd(ByVal filename As String)
Dim _xmlDoc As New XmlDocument
_xmlDoc.Load(filename)
Dim xml As New Xml.XmlTextReader(filename)
While xml.Read
If xml.NodeType = XmlNodeType.Element Then
Console.WriteLine(xml.Name)
End If
End While
trvwxml.Nodes.Clear() ' Clear any existing items
trvwxml.BeginUpdate() ' Begin updating the treeview
Dim TreeNode As TreeNode
TreeNode = trvwxml.Nodes.Add("SellerTradeParty")
Dim elemList As XmlNodeList = _xmlDoc.GetElementsByTagName("ram:SellerTradeParty")
Dim i As Integer
For i = 0 To elemList.Count - 1
' Console.WriteLine(elemList(i).InnerXml)
For Each Xml_Node As XmlNode In elemList
Dim z As Integer
For z = 0 To Xml_Node.ChildNodes.Count - 1
If Xml_Node.ChildNodes(z).Name = "ram:Name" Then
Dim xmlvalue = Xml_Node.ChildNodes(z).InnerText
If xmlvalue.Contains(vbLf&) Then
xmlvalue = xmlvalue.Replace(vbLf&, "")
End If
If xmlvalue.Contains(Chr(13)) Then
Dim arr As String() = xmlvalue.Split(Chr(13))
End If
Dim newNode As TreeNode = New TreeNode(xmlvalue)
newNode.Tag = "SellerTradeParty:Name"
TreeNode.Nodes.Add(newNode)
ElseIf Xml_Node.ChildNodes(z).Name = "ram:SpecifiedTaxRegistration" Then
Dim newNode As TreeNode = New TreeNode(Xml_Node.ChildNodes(z).InnerText)
newNode.Tag = "SpecifiedTaxRegistration"
TreeNode.Nodes.Add(newNode)
End If
Next z
Next
Next i
Dim TreeNode1 As TreeNode
TreeNode1 = trvwxml.Nodes.Add("MonetarySummation")
Dim elemList1 As XmlNodeList = _xmlDoc.GetElementsByTagName("ram:SpecifiedTradeSettlementMonetarySummation")
For i = 0 To elemList1.Count - 1
' Console.WriteLine(elemList(i).InnerXml)
For Each Xml_Node As XmlNode In elemList1
Dim z As Integer
For z = 0 To Xml_Node.ChildNodes.Count - 1
If Xml_Node.ChildNodes(z).Name = "ram:GrandTotalAmount" Then
Dim xmlvalue = Xml_Node.ChildNodes(z).InnerText
Dim newNode As TreeNode = New TreeNode(xmlvalue)
newNode.Tag = "GrandTotalAmount"
TreeNode1.Nodes.Add(newNode)
End If
Next z
Next
Next i
trvwxml.EndUpdate()
trvwxml.Refresh()
' foreach(XmlNode xmlnode In baseNodeList)
'// loop through all base <folder> nodes
'{
' String title = XmlNode.Attributes["title"].Value;
' TreeNode = treeViewMenu.Nodes.Add(title); // add it To the tree
' populateChildNodes(XmlNode, TreeNode); // Get the children
'}
'treeViewMenu.EndUpdate(); // Stop updating the tree
'treeViewMenu.Refresh(); // refresh the treeview display
End Sub
Private Sub frmNIVerknuepfungen_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown
_formloaded = True
End Sub
Private Sub btnIndexSQL_einfuegen_Click(sender As System.Object, e As System.EventArgs) Handles btnIndexSQL_einfuegen.Click
Dim Index As String
If Me.txteindeutigerIndex.Text <> "" Then
Index = txteindeutigerIndex.Text
Else
MsgBox("Definieren Sie einen eindeutigen deskriptiven Index!", MsgBoxStyle.Critical, "Achtung")
End If
If Index <> "" Then
Dim text As String = " '[%" & Index & "]' "
Dim altePosition As Integer = Me.txtCheckIndexSQL.SelectionStart()
Me.txtCheckIndexSQL.Text = Me.txtCheckIndexSQL.Text.Insert(altePosition, text)
Me.txtCheckIndexSQL.SelectionStart = altePosition + text.Length
End If
End Sub
Private Sub btnSpalteIndexSQLeinfuegen_Click(sender As System.Object, e As System.EventArgs) Handles btnSpalteIndexSQLeinfuegen.Click
If Not Me.cmbSpalten_indexSQL.SelectedItem = "" Then
Dim text As String = " " & Me.cmbSpalten_indexSQL.SelectedItem.ToString.ToUpper & " ="
Dim altePosition As Integer = Me.txtCheckIndexSQL.SelectionStart()
Me.txtCheckIndexSQL.Text = Me.txtCheckIndexSQL.Text.Insert(altePosition, text)
Me.txtCheckIndexSQL.SelectionStart = altePosition + text.Length
End If
End Sub
'Private Sub txtCheckIndexSQL_LostFocus(sender As Object, e As System.EventArgs) Handles txtCheckIndexSQL.LostFocus
' If Me.txtCheckIndexSQL.Text <> "" Then
' Try
' ' die Änderungen speichern
' If Me._selectedProfil.Save(True, "profile") = True Then ' wenn das Speichern erfolgreich war
' ' den Speichern-Button deaktivieren
' Else
' MsgBox("Das Profil konnte nicht erfolgreich gespeichert werden.", MsgBoxStyle.Exclamation, "Fehler beim Speichern eines Profils")
' End If
' Catch ex As Exception
' MsgBox("Fehler beim Speichern des SQL-Befehles." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Speichern eines SQL-Befehls.")
' End Try
' End If
'End Sub
Private Sub SaveProfile()
If Me.txtCheckIndexSQL.Text <> "" Then
Try
' die Änderungen speichern
If Me._selectedProfil.Save(True, "profile") = True Then
Me._selectedProfil.setSaved()
Me.btnSaveAll.Enabled = False
Else
MsgBox("Das Profil konnte nicht erfolgreich gespeichert werden.", MsgBoxStyle.Exclamation, "Fehler beim Speichern eines Profils")
End If
Catch ex As Exception
MsgBox("Fehler beim Speichern des SQL-Befehles." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Speichern eines SQL-Befehls.")
End Try
End If
End Sub
Private Sub txtCheckIndexSQL_TextChanged(sender As System.Object, e As System.EventArgs) Handles txtCheckIndexSQL.TextChanged
If Me._selectedProfil IsNot Nothing Then
Me._selectedProfil.checkIndexsql = txtCheckIndexSQL.Text
If Not Me._selectedProfil.checkIndexsql = Me._selectedProfil.OriginalcheckIndexsql Then
btnSaveAll.Enabled = True
Me._selectedProfil.setChanged()
End If
End If
End Sub
Private Sub txteindeutigerIndex_TextChanged(sender As System.Object, e As System.EventArgs) Handles txteindeutigerIndex.TextChanged
If Me.txteindeutigerIndex.Text <> "" Then
Me.lblIndextestSQL.Text = "Testwert für Index: " & txteindeutigerIndex.Text
End If
End Sub
Private Sub btntest_checkIndexsql_Click(sender As System.Object, e As System.EventArgs) Handles btntest_checkIndexsql.Click
Try
If Me.txtCheckIndexSQL.Text = "" Then
MsgBox("Bitte geben Sie eine Select-Anweisung ein!", MsgBoxStyle.Exclamation, "Select-Anweisung fehlt:")
Me.txtTestwert.BackColor = Drawing.Color.Lime
Me.txtTestwert.Focus()
Exit Sub
End If
If Me.txtTestwert_checkindex.Text = "" Then
MsgBox("Bitte geben Sie einen Testwert für den eindeutigen Startwert ein!", MsgBoxStyle.Exclamation, "Testparameter fehlt:")
Me.txtTestwert_checkindex.BackColor = Drawing.Color.Lime
Me.txtTestwert_checkindex.Focus()
Exit Sub
End If
Dim sql As String = Me.txtCheckIndexSQL.Text
vSQL = sql.Replace("[%" & Me.txteindeutigerIndex.Text & "]", txtTestwert_checkindex.Text)
If _selectedProfil.DbArt = "Oracle" Then
Dim ergebnis As Integer = database.CheckIndex_oracle(vSQL, _selectedProfil.DataSource, _selectedProfil.InitialCatalog, _selectedProfil.UserId, _selectedProfil.Password)
If ergebnis = 1 Then
MsgBox("Der ausgeführte SQL-Befehl ist gültig: " & vbNewLine &
vSQL & vbNewLine & vbNewLine &
"Zurückgelieferter Wert: (muß = 1 sein) " & vbNewLine &
ergebnis, MsgBoxStyle.Information, "Erfolgsmeldung:")
Else
If ergebnis > 1 Then
MsgBox("Der ausgeführte SQL-Befehl liefert mehr als 1 zurück!" & vbNewLine &
"Bitte überprüfen sie Ihr SQL oder den Testwert!" & vbNewLine &
"Ist der zugeordnete index wirklich eindeutig?", MsgBoxStyle.Exclamation, "SQL/Index-Überprüfen:")
Else
MsgBox("Der ausgeführte SQL-Befehl liefert 0 zurück!" & vbNewLine &
"Bitte überprüfen sie Ihr SQL oder den Testwert!", MsgBoxStyle.Exclamation, "SQL-Überprüfen:")
End If
End If
ElseIf _selectedProfil.DbArt = "MS-SQL" Then
Dim ergebnis As Integer = database.CheckIndex_MSSSQL(_selectedProfil.Profilname, vSQL, _selectedProfil.DataSource, _selectedProfil.UserId, _selectedProfil.Password, _selectedProfil.InitialCatalog)
If ergebnis = 1 Then
MsgBox("Der ausgeführte SQL-Befehl ist gültig: " & vbNewLine &
vSQL & vbNewLine & vbNewLine &
"Zurückgelieferter Wert: (muß = 1 sein) " & vbNewLine &
ergebnis, MsgBoxStyle.Information, "Erfolgsmeldung:")
Else
If ergebnis > 1 Then
MsgBox("Der ausgeführte SQL-Befehl liefert mehr als 1 zurück!" & vbNewLine &
"Bitte überprüfen sie Ihr SQL oder den Testwert!" & vbNewLine &
"Ist der zugeordnete index wirklich eindeutig?", MsgBoxStyle.Exclamation, "SQL/Index-Überprüfen:")
Else
MsgBox("Der ausgeführte SQL-Befehl liefert 0 zurück!" & vbNewLine &
"Bitte überprüfen sie Ihr SQL oder den Testwert!", MsgBoxStyle.Exclamation, "SQL-Überprüfen:")
End If
End If
ElseIf _selectedProfil.DbArt = "ODBC" Then
Dim ergebnis As Integer = database.CheckIndex_ODBC(_selectedProfil.Profilname, vSQL, _selectedProfil.DataSource, _selectedProfil.UserId, _selectedProfil.Password)
If ergebnis = 1 Then
MsgBox("Der ausgeführte SQL-Befehl ist gültig: " & vbNewLine &
vSQL & vbNewLine & vbNewLine &
"Zurückgelieferter Wert: (muß = 1 sein) " & vbNewLine &
ergebnis, MsgBoxStyle.Information, "Erfolgsmeldung:")
Else
If ergebnis > 1 Then
MsgBox("Der ausgeführte SQL-Befehl liefert mehr als 1 zurück!" & vbNewLine &
"Bitte überprüfen sie Ihr SQL oder den Testwert!" & vbNewLine &
"Ist der zugeordnete index wirklich eindeutig?", MsgBoxStyle.Exclamation, "SQL/Index-Überprüfen:")
Else
MsgBox("Der ausgeführte SQL-Befehl liefert 0 zurück!" & vbNewLine &
"Bitte überprüfen sie Ihr SQL oder den Testwert!", MsgBoxStyle.Exclamation, "SQL-Überprüfen:")
End If
End If
End If
Me.txtTestwert_checkindex.BackColor = Drawing.Color.White
Me.txtTestwert_checkindex.Text = ""
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Abrufen des Wertes für den eindeutigen Index:")
End Try
End Sub
Private Sub txtManIndexwert_TextChanged(sender As System.Object, e As System.EventArgs) Handles txtManIndexwert.TextChanged
If Me.txtManIndexwert.Text <> "" Then
grbFilterDB.Enabled = False
Else
grbFilterDB.Enabled = True
End If
End Sub
Private Sub txtGrundgeruest_check_Click(sender As System.Object, e As System.EventArgs) Handles txtGrundgeruest_check.Click
Me.txtCheckIndexSQL.Text = "SELECT COUNT(*) FROM [%view] WHERE "
Me.txtCheckIndexSQL.SelectionStart = Me.txtCheckIndexSQL.Text.Length
End Sub
Private Sub tsbtnFirstProfil_Click(sender As System.Object, e As System.EventArgs) Handles tsbtnfirst.Click
If Me._selectedProfil IsNot Nothing Then
If _selectedProfil.HasChanges Then
Me._selectedProfil.Save(True, "profile")
End If
Else
'Noch kein Profil geladen also das erste laden
If arrProfile.GetUpperBound(0) >= 0 Then
_pos = 0
LoadSelectedProfile(arrProfile(0, 0))
End If
Exit Sub
End If
If arrProfile.GetUpperBound(0) >= 0 Then
LoadSelectedProfile(arrProfile(arrProfile.GetLowerBound(0), 0))
_pos = arrProfile.GetLowerBound(0)
End If
End Sub
Private Sub tsbtnpreviousProfil_Click(sender As System.Object, e As System.EventArgs) Handles tsbtnprevious.Click
If Me._selectedProfil IsNot Nothing Then
If _selectedProfil.HasChanges Then
Me._selectedProfil.Save(True, "profile")
End If
Else
'Noch kein Profil geladen also das erste laden
If arrProfile.GetUpperBound(0) >= 0 Then
_pos = 0
LoadSelectedProfile(arrProfile(0, 0))
End If
Exit Sub
End If
'Eine Position niedriger
_pos = _pos - 1
If arrProfile.GetLowerBound(0) <= _pos Then
For i = 0 To arrProfile.GetUpperBound(0)
If arrProfile(i, 1) = _pos Then
LoadSelectedProfile(arrProfile(i, 0))
End If
Next
Else
'Erste Position
_pos = arrProfile.GetLowerBound(0)
MsgBox("Dies ist das erste Profil", MsgBoxStyle.Information, "Hinweis:")
End If
End Sub
Private Sub tsbtnnextProfil_Click(sender As System.Object, e As System.EventArgs) Handles tsbtnnext.Click
If Me._selectedProfil IsNot Nothing Then
If _selectedProfil.HasChanges Then
Me._selectedProfil.Save(True, "profile")
End If
Else
'Noh kein Profil geladen also das erste laden
If arrProfile.GetUpperBound(0) > 0 Then
_pos = 0
LoadSelectedProfile(arrProfile(0, 0))
End If
Exit Sub
End If
'Eine Position höher
_pos = _pos + 1
'MsgBox(_pos & vbNewLine & "AnzahL: " & arrProfile.GetUpperBound(0))
If arrProfile.GetUpperBound(0) >= _pos Then
For i = 0 To arrProfile.GetUpperBound(0)
If arrProfile(i, 1) = _pos Then
LoadSelectedProfile(arrProfile(i, 0))
End If
Next
Else
'MsgBox("letztes")
_pos = arrProfile.GetUpperBound(0)
MsgBox("Dies ist das letzte Profil", MsgBoxStyle.Information, "Hinweis:")
End If
End Sub
Private Sub tsbtnLastProfil_Click(sender As System.Object, e As System.EventArgs) Handles tsbtnlast.Click
If Me._selectedProfil IsNot Nothing Then
If _selectedProfil.HasChanges Then
Me._selectedProfil.Save(True, "profile")
End If
Else
'Noch kein Profil geladen also das erste laden
If arrProfile.GetUpperBound(0) >= 0 Then
_pos = arrProfile.GetUpperBound(0)
LoadSelectedProfile(arrProfile(arrProfile.GetUpperBound(0), 0))
End If
Exit Sub
End If
If arrProfile.GetUpperBound(0) >= 0 Then
LoadSelectedProfile(arrProfile(arrProfile.GetUpperBound(0), 0))
_pos = arrProfile.GetUpperBound(0)
End If
End Sub
Private Sub btnRegExtest_Click(sender As System.Object, e As System.EventArgs) Handles btnRegExtest.Click
If txtregex.Text <> "" And RichTextBox_RegEx.Text <> String.Empty Then
'Die Leerzeichen entfernen
If Me.chkboxWhitespace.Checked And RichTextBox_RegEx.Text.Contains("") Then
RichTextBox_RegEx.Text = RichTextBox_RegEx.Text.Replace(" ", "")
End If
Dim pos_von, pos_bis As Integer
If chkbxFT_Position.Checked And txtFT_Posvon.Text <> "" Then
pos_von = txtFT_Posvon.Text
If txtFT_Posbis.Text <> "" Then
pos_bis = txtFT_Posbis.Text
End If
Else
pos_von = 10000
End If
Volltext_indexer(txtregex.Text, RichTextBox_RegEx.Text, pos_von, pos_bis, chkboxWhitespace.Checked)
RichTextBox_RegEx.ScrollBars = RichTextBoxScrollBars.ForcedBoth
End If
End Sub
Dim Index As Integer
Private Function Volltext_indexer(_regexpr As String, fulltext As String, Pos_From As Integer, Pos_To As Integer, ignwhitespace As Boolean)
Try
' MsgBox(fulltext)
fulltext = fulltext.Replace(vbCrLf, "")
Index = 0
If ignwhitespace = True Then
fulltext = fulltext.Replace(" ", "")
End If
Dim Ergebnis As String()
' einen Regulären Ausdruck laden
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(_regexpr)
' die Vorkommen im SQL-String auslesen
Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(fulltext)
' alle Vorkommen der windream-Indexe im SQL-String durchlaufen
Dim MatchedElements As Integer = 0
Dim Exit_For = False
For Each element As System.Text.RegularExpressions.Match In elemente
MatchedElements += 1
Index += 1
'MsgBox(element.ToString)
'filling the row with values. Item property is used to set the field value.
If Pos_From <> 10000 Then
If Pos_To <> 0 And Pos_From >= Pos_From Then
findTextAndHighlight(element.ToString, Color.Orange)
' den übergebenen/gefundenen IndexWert, eintragen
ReDim Preserve Ergebnis(MatchedElements - 1)
Ergebnis(MatchedElements - 1) = Convert.ToString(element.ToString)
'Das Ende ist erreicht - Ausstieg
If Pos_To = MatchedElements Then
Exit_For = True
End If
Else
'Es gibt nur From, also auch nur einen Wert
If Pos_From <> MatchedElements Then
ReDim Preserve Ergebnis(0)
Ergebnis(0) = Convert.ToString(element.ToString)
findTextAndHighlight(element.ToString, Color.Yellow)
ElseIf Pos_From = MatchedElements Then
findTextAndHighlight(element.ToString, Color.OrangeRed)
'Das Ende ist erreicht - Ausstieg
ReDim Preserve Ergebnis(0)
Ergebnis(0) = Convert.ToString(element.ToString)
Exit_For = True
End If
End If
Else
findTextAndHighlight(element.ToString, Color.Yellow)
ReDim Preserve Ergebnis(MatchedElements - 1)
' den übergebenen/gefundenen IndexWert, eintragen
Ergebnis(MatchedElements - 1) = Convert.ToString(element.ToString)
End If
If Exit_For = True Then
Exit For
End If
Next ' zum nächsten Vorkommen
Dim Meldung As String
If Pos_From <> 10000 Then
If Pos_To <> 0 Then
Else
End If
End If
If MatchedElements > 0 Then
If Ergebnis.Length > 1 Then
'If Pos_From <> 10000 And Pos_To <> 0 Then
' Meldung = "Es konnten " & Anzahl & " Vorkommen/Werte gelesen/ausgewertet werden!" & vbNewLine & "Bitte achten Sie darauf einen VEKTOR-INDEX als Ziel zu wählen" & vbNewLine & "Die Ergebnisse wurden gehighlighted!"
'Else
Meldung = "Es konnten " & MatchedElements & " Vorkommen/Werte gelesen/ausgewertet werden!" & vbNewLine & "Bitte achten Sie darauf einen VEKTOR-INDEX als Ziel zu wählen" & vbNewLine & "Die Ergebnisse wurden gehighlighted!"
'End If
ElseIf Ergebnis.Length = 1 Then
Meldung = "Es konnte genau 1 Wert gelesen/ausgewertet werden!" & vbNewLine & "Es handelte sich um das " & MatchedElements & ". Vorkommen im Text!" & vbNewLine & "ALLE bisherigen Ergebnisse wurden gehighlighted!"
End If
MsgBox(Meldung, MsgBoxStyle.Information, "Erfolgsmeldung:")
Else
MsgBox("Keine Vorkommen für diese Regular Expression gefunden!", MsgBoxStyle.Exclamation, "Achtung:")
End If
Return Ergebnis
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in RegEx")
Return Nothing
End Try
End Function
Dim RTB_startindex As Integer = 0
Dim indexOfSearchText As Integer = 0
Sub findTextAndHighlight(ByVal searchtext As String, col As Color)
Try
'Dim startindex As Integer = 0
'startindex = FindMyText(searchtext.Trim(), start, RichTextBox_RegEx.Text.Length)
'' If string was found in the RichTextBox, highlight it
'If startindex >= 0 Then
' ' Set the highlight color as red
' RichTextBox_RegEx.SelectionColor = Color.Red
' RichTextBox_RegEx.SelectionBackColor = col
' ' Find the end index. End Index = number of characters in textbox
' Dim endindex As Integer = searchtext.Length
' ' Highlight the search string
' RichTextBox_RegEx.Select(startindex, endindex)
' ' mark the start position after the position of
' ' last search string
' start = startindex + endindex
'End If
Dim textEnd As Integer = RichTextBox_RegEx.TextLength
Dim fnt As Font = New Font(RichTextBox_RegEx.Font, FontStyle.Bold)
Dim lastIndex As Integer = RichTextBox_RegEx.Text.LastIndexOf(searchtext)
' If (Index < lastIndex) Then
Dim indexOfSearchText = RichTextBox_RegEx.Find(searchtext, RTB_startindex, textEnd, RichTextBoxFinds.None)
If indexOfSearchText = -1 Then
indexOfSearchText = RichTextBox_RegEx.Find(searchtext, RTB_startindex, textEnd, RichTextBoxFinds.WholeWord)
End If
RichTextBox_RegEx.SelectionColor = Color.Red
RichTextBox_RegEx.SelectionBackColor = col
RichTextBox_RegEx.SelectionFont = fnt
RichTextBox_RegEx.Select(indexOfSearchText, searchtext.Length)
'
If indexOfSearchText <> -1 Then
' mark the start position after the position of
' last search string
RTB_startindex = indexOfSearchText + searchtext.Length
End If
Catch ex As Exception
MsgBox("Fehler in Highlighting:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Function FindMyText(ByVal txtToSearch As String, ByVal searchStart As Integer, ByVal searchEnd As Integer) As Integer
'' Unselect the previously searched string
'If searchStart > 0 AndAlso searchEnd > 0 AndAlso indexOfSearchText >= 0 Then
' RichTextBox_RegEx.Undo()
'End If
' Set the return value to -1 by default.
Dim retVal As Integer = -1
' A valid starting index should be specified.
' if indexOfSearchText = -1, the end of search
If searchStart >= 0 AndAlso indexOfSearchText >= 0 Then
' A valid ending index
If searchEnd > searchStart OrElse searchEnd = -1 Then
' Find the position of search string in RichTextBox
indexOfSearchText = RichTextBox_RegEx.Find(txtToSearch, searchStart, searchEnd, RichTextBoxFinds.WholeWord)
If indexOfSearchText = -1 Then
indexOfSearchText = RichTextBox_RegEx.Find(txtToSearch, searchStart, searchEnd, RichTextBoxFinds.None)
End If
If indexOfSearchText = -1 Then
indexOfSearchText = RichTextBox_RegEx.Find(txtToSearch)
End If
' Determine whether the text was found in richTextBox1.
If indexOfSearchText <> -1 Then
' Return the index to the specified search text.
retVal = indexOfSearchText
End If
End If
End If
Return retVal
End Function
Private Sub RadioButton1_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbFT_single.CheckedChanged
If rbFT_single.Checked = True Then
Me.lblFT_Posvon.Text = "Position 1-xx:"
lblFT_Posvon.Visible = True
txtFT_Posvon.Visible = True
Me.lblFT_Posbis.Visible = False
Me.txtFT_Posbis.Visible = False
Me.lblFT_Vorkommen.Visible = False
Else
Me.lblFT_Posvon.Text = "vom"
lblFT_Posvon.Visible = True
txtFT_Posvon.Visible = True
Me.lblFT_Posbis.Visible = True
Me.txtFT_Posbis.Visible = True
Me.lblFT_Vorkommen.Visible = True
End If
End Sub
Private Sub ChkBoxFT_Position_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkbxFT_Position.CheckedChanged
If chkbxFT_Position.Checked Then
grpbxFT_Vorkommen.Visible = True
rbFT_single.Visible = True
rbFT_Position.Visible = True
rbFT_single.Checked = True
Me.txtFT_Posbis.Text = ""
Me.txtFT_Posvon.Text = ""
Else
rbFT_Position.Visible = False
rbFT_single.Visible = False
grpbxFT_Vorkommen.Visible = False
check_changes_ftArea()
End If
End Sub
Private Sub chkboxWhitespace_CheckedChanged(sender As Object, e As EventArgs) Handles chkboxWhitespace.CheckedChanged
If chkboxWhitespace.Checked Then
RichTextBox_RegEx.Text = RichTextBox_RegEx.Text.Replace(" ", "")
End If
check_changes_ftArea()
End Sub
Private Sub btnLDAP_test_Click(sender As Object, e As EventArgs) Handles btnLDAP_test.Click
If txtLDAP_EinschrUserGroup.Text.Contains("[%Windream-INDEX]") Then
MsgBox("Bitte bestimmen Sie noch in welchem Windream-Index der Eintrag für das Filterkriterium gespeichert ist!" & vbNewLine & "[%Windream-INDEX] muss ersetzt werden!", MsgBoxStyle.Exclamation)
cmbLDAP_WDIndexSelect.DroppedDown = True
Exit Sub
End If
Try
If lvwVerknuepfungen.SelectedItems.Count > 0 Then
If Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(2).Text = "AD" Then
If Me.txtLDAPTestwert.Text = "" Then
MsgBox("Bitte geben Sie einen Testwert ein!", MsgBoxStyle.Exclamation, "Testparameter fehlt:")
Me.txtLDAPTestwert.BackColor = Drawing.Color.Red
Me.txtLDAPTestwert.Focus()
Exit Sub
End If
Dim ADFilter As String = Me.txtLDAPTestwert.Text
If LDAP_Return_Regex(Me.txtLDAP_EinschrUserGroup.Text) <> ">1" Then
Dim Attribut2Load As String = Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text
Dim filter As String = txtLDAP_EinschrUserGroup.Text.Replace(LDAP_Return_Regex(Me.txtLDAP_EinschrUserGroup.Text), ADFilter)
Dim Ergebnis As String = ClassActiveDirectory.GetAD_Attribut(filter, Attribut2Load, _selectedProfil.DataSource, _selectedProfil.UserId, _selectedProfil.Password)
If Ergebnis = ">1" Then
Dim msg As String
For Each Str As String In ClassActiveDirectory.ErgebnisAD
msg = msg & Str & vbNewLine
Next
MsgBox("Es wurde mehr als 1 Wert ausgelesen! Entweder ist der AD-Filter nicht eindeutig oder ein anderer Fehler ist aufgetreten." & vbNewLine & "Ergebnis der AD-Suche:" & vbNewLine & msg & vbNewLine &
"AD-Filter: '" & filter & "'", MsgBoxStyle.Exclamation)
ElseIf Ergebnis = "99" Then
MsgBox("Es konnte kein eindeutiger Wert ausgelesen werden! Grund hierfür könnnen eine fehlerhafte Anmeldung an LDAP, o.Ä. sein!" & vbNewLine &
"AD-Filter: '" & filter & "'", MsgBoxStyle.Exclamation)
Else
If Ergebnis.Contains("-Suchfilter ist ungültig") Then
MsgBox(Ergebnis, MsgBoxStyle.Exclamation)
Else
MsgBox("Für den Testwert '" & Me.txtLDAPTestwert.Text & "' wurde für das Attribut '" & Attribut2Load & "'" & vbNewLine & "das Ergebnis '" & Ergebnis & "' ausgelesen!" & vbNewLine &
"AD-Filter: '" & filter & "'", MsgBoxStyle.Information)
End If
End If
Me.txtLDAPTestwert.BackColor = Drawing.Color.White
Me.txtLDAPTestwert.Text = ""
Else
MsgBox("Achtung mehr als 1 RegEx in Einschränkung Active Directory erkannt!", MsgBoxStyle.Critical)
End If
Else
MsgBox("Ein manueller Wert kann nicht getestet werden!", MsgBoxStyle.Exclamation)
End If
Else
MsgBox("Bitte eine Verknüpfung auswählen!", MsgBoxStyle.Exclamation)
End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Test LDAP:")
End Try
End Sub
' form a filter string for the search in LDAP format
Private Function FormFilter(objectCategory As String, filter As String)
Dim result As String
result = String.Format("(&(objectCategory={0})(name={1}))", objectCategory, filter)
Return result
End Function
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles btnLDAP_IndexAdd.Click
If Not Me.cmbLDAP_WDIndexSelect.SelectedItem = "" Then
Dim text As String
If txtLDAP_EinschrUserGroup.Text.Contains("[%Windream-INDEX]") Then
text = txtLDAP_EinschrUserGroup.Text.Replace("[%Windream-INDEX]", "[%" & Me.cmbLDAP_WDIndexSelect.SelectedItem & "]")
txtLDAP_EinschrUserGroup.Text = text
lblLDAP_Testwert.Text = "Testwert für [%" & Me.cmbLDAP_WDIndexSelect.SelectedItem & "]"
Else
MsgBox("Bitte wählen Sie zuerst noch einmal ein Attribut als Filterkriterium aus!", MsgBoxStyle.Exclamation)
End If
End If
End Sub
Private Sub btnLDAP_AttributAdd_Click(sender As Object, e As EventArgs) Handles btnLDAP_AttributAdd.Click
If Not Me.cmbLDAP_Attribut.SelectedItem = "" Then
txtLDAP_EinschrUserGroup.Text = "(" & cmbLDAP_Attribut.SelectedItem.ToString.Trim & "=[%Windream-INDEX])"
lblLDAP_Testwert.Text = "Testwert für [%Windream-INDEX]"
End If
End Sub
Private Sub btnSaveLDAP_Click(sender As Object, e As EventArgs) Handles btnSaveLDAP.Click
If txtLDAP_EinschrUserGroup.Text.Contains("[%Windream-INDEX]") Then
MsgBox("Bitte bestimmen Sie noch in welchem Windream-Index der Eintrag für das Filterkriterium gespeichert ist!" & vbNewLine & "[%Windream-INDEX] muss ersetzt werden!", MsgBoxStyle.Exclamation)
cmbLDAP_WDIndexSelect.DroppedDown = True
Else
SaveLDAP()
End If
End Sub
Sub SaveLDAP()
Try
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
If Me._selectedProfil.GetSaved = False Then
Me._selectedProfil.Save(True, "profile")
Me._selectedProfil._links.selectedLink.SaveLink(Me._selectedProfil.Profilname, Me._selectedProfil.Ni_Art)
With btnSaveLDAP
.Enabled = False
.ForeColor = Drawing.Color.Black
End With
End If
End If
Catch ex As Exception
MsgBox("Fehler beim Speichern der LDAP-Verknüpfung." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler beim Speichern einer Verknüpfung")
End Try
End Sub
Private Sub txtLDAP_EinschrUserGroup_TextChanged(sender As Object, e As EventArgs) Handles txtLDAP_EinschrUserGroup.TextChanged
Try
' wenn im ListView eine Zeile selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' Überprüfen ob eingegebener Wert gepeichert werden muß?
' MsgBox(Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).getSelectAnweisung())
Dim Original As String = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).getSelectAnweisung().ToString
If Original <> Me.txtLDAP_EinschrUserGroup.Text Then
With btnSaveLDAP
.Enabled = True
.ForeColor = Drawing.Color.Red
End With
End If
' die Informationen der selektierten Verknüpfung auslesen
Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).setSelectAnweisung(Me.txtLDAP_EinschrUserGroup.Text)
' das Profil auf den Status 'geändert' setzen
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
'Jetzt den Startwert bestimmen
'MsgBox("[%" & Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text & "]")
End If
Catch ex As Exception
MsgBox("Die Verknüpfung LDAP konnte nicht angelegt werden." & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Exclamation, "Fehler beim Anlegen einer Verknüpfung")
End Try
End Sub
Private Function LDAP_Return_Regex(stringWert As String)
' Regulären Ausdruck zum Auslesen der windream-Indexe definieren
Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
' SQL-String für aktuelle Verknüpfung laden
Dim Zeichenfolge As String = stringWert
'Erstzen des Dateinamens - für CURSOR NachindexierungPr
' einen Regulären Ausdruck laden
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg)
' die Vorkommen im SQL-String auslesen
Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(Zeichenfolge)
' alle Vorkommen der windream-Indexe im SQL-String durchlaufen
Dim i As Integer = 0
Dim result As String
For Each element As System.Text.RegularExpressions.Match In elemente
result = element.ToString
i += 1
Next
If i = 1 Then
Return result
Else
Return ">1"
End If
End Function
Dim change As Boolean = False
Private Sub chkbxXml_Always_Write_CheckedChanged(sender As Object, e As EventArgs) Handles chkbxXml_Always_Write.CheckedChanged
If change = False Then
If chkbxXml_Always_Write.Checked Then
' wenn eine Zeile im ListView ausgewählt wurde
If (Me.lvwVerknuepfungen.SelectedItems.Count > 0) Then
' den Link aus dem aktuellen Profil entfernen
Me._selectedProfil._links.RemoveLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, "")
' dem Profil den neuen Link anhängen
Me._selectedProfil._links.AddLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, "", "WRITE_ALWAYS")
End If
Me._selectedProfil.setChanged()
Else
' wenn eine Zeile im ListView ausgewählt wurde
If (Me.lvwVerknuepfungen.SelectedItems.Count > 0) Then
' den Link aus dem aktuellen Profil entfernen
Me._selectedProfil._links.RemoveLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, "")
' dem Profil den neuen Link anhängen
Me._selectedProfil._links.AddLink(Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems.Item(0).SubItems(1).Text, "", "")
End If
Me._selectedProfil.setChanged()
End If
End If
End Sub
Private Sub btnAddNI_Objekt_Click(sender As Object, e As EventArgs) Handles btnAddNI_Objekt.Click
If Not Me.cmbNI_Objekte.SelectedItem = "" Then
Dim text As String
'Dokument -Dateiname.Endung
'Dokument -Pfad
'Dokument -Pfad \ Dateiname.Endung
'Datum -heute
Select Case cmbNI_Objekte.SelectedItem
Case "Dokument - Dateiname.Endung"
text = " '[%DOCFilename]' "
Case "Dokument - Dateiname"
text = " '[%DOCFilenameoE]' "
Case "Dokument - Pfad"
text = " '[%DOCPath]' "
Case "Dokument - Pfad\Dateiname.Endung"
text = " '[%DOCFULLPATH]' "
Case "Datum - heute"
text = " '[%DATENow]' "
End Select
Dim altePosition As Integer = Me.txtSelectAnweisung.SelectionStart()
Me.txtSelectAnweisung.Text = Me.txtSelectAnweisung.Text.Insert(altePosition, text)
Me.txtSelectAnweisung.SelectionStart = altePosition + text.Length
End If
End Sub
Private Sub RadioButton1_CheckedChanged_1(sender As Object, e As EventArgs) Handles RadioButton1.CheckedChanged
If RadioButton1.Checked Then
Me.txtSUBSTR_bis.Enabled = True
Me.txtSubstr_von.Enabled = True
Me.txtSubstr_von.Focus()
btbSubstradd.Enabled = True
Else
Me.txtSUBSTR_bis.Enabled = False
Me.txtSubstr_von.Enabled = False
btbSubstradd.Enabled = False
txtSubstr_von.Text = ""
txtSUBSTR_bis.Text = ""
Me.txtSubstr_von.Focus()
End If
End Sub
Private Sub txtSubstradd_Click(sender As Object, e As EventArgs) Handles btbSubstradd.Click
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
If txtSubstr_von.Text <> "" And txtSUBSTR_bis.Text <> "" Then
Me.txtLDAP_EinschrUserGroup.Text = "(" & Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text & "=SUBSTR[" &
LDAP_Return_Regex(Me.txtLDAP_EinschrUserGroup.Text) & "," & txtSubstr_von.Text & "," & txtSUBSTR_bis.Text & "])"
End If
If txtSubstr_von.Text <> "" And txtSUBSTR_bis.Text = "" Then
Me.txtLDAP_EinschrUserGroup.Text = "(" & Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text & "=SUBSTR[" &
LDAP_Return_Regex(Me.txtLDAP_EinschrUserGroup.Text) & "," & txtSubstr_von.Text & "])"
End If
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Me.RichTextBox_RegEx.Text = ""
End Sub
Private Sub btnzuruecksetzen_checksql_Click(sender As Object, e As EventArgs) Handles btnzuruecksetzen_checksql.Click
Try
Me.txtCheckIndexSQL.Text = Me._selectedProfil.OriginalcheckIndexsql
Catch ex As Exception
MsgBox("Die Check SELECT-Anweisung konnte nicht auf ihren Ursprungswert zurückgesetzt werden." & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub btnSave_FulltextLinks_Click(sender As Object, e As EventArgs) Handles btnSave_FulltextLinks.Click
Try
If Me._selectedProfil._links.selectedLink IsNot Nothing Then
If Me._selectedProfil.GetSaved = False Then
Me._selectedProfil.Save(False, "FTLink")
If Me._selectedProfil._links.selectedLink.SaveLink(Me._selectedProfil.Profilname, Me._selectedProfil.Ni_Art) = True Then
MsgBox("Speichern erfolgreich!", MsgBoxStyle.Information)
End If
If Me._selectedProfil.Ni_Art <> "fulltext" Then
Dim vktState = Getvktinsert_State()
Me._selectedProfil._links.RenewLinks(Me.lvwVerknuepfungen, vktState)
End If
With btnSave_FulltextLinks
.Enabled = False
.ForeColor = Drawing.Color.Black
End With
End If
End If
Catch ex As Exception
MsgBox("Fehler beim Speichern der Fulltext-Verknüpfung." & vbNewLine & vbNewLine & "Fehlernachricht:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub txtregex_TextChanged(sender As Object, e As EventArgs) Handles txtregex.TextChanged
' Try
' wenn im ListView eine Zeile selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' Überprüfen ob eingegebener Wert gepeichert werden muß?
Dim original As String = Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text
If original <> Me.txtregex.Text Then
lblFT_Meldung.Visible = True
Else
lblFT_Meldung.Visible = False
End If
End If
'Catch ex As Exception
' MsgBox("Fehler bei Check Änderung Regex:" & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
'End Try
End Sub
Sub check_changes_ftArea()
Dim ftarea As String
If chkbxFT_Position.Checked Then
If rbFT_Position.Checked Then
If txtFT_Posvon.Text <> "" And txtFT_Posbis.Text <> "" Then
ftarea = txtFT_Posvon.Text & ";" & txtFT_Posbis.Text
End If
Else
If txtFT_Posvon.Text <> "" Then
ftarea = txtFT_Posvon.Text & ";0"
End If
End If
Else
ftarea = "10000;0"
End If
If chkboxWhitespace.Checked Then
ftarea = ftarea & ";" & "True"
Else
ftarea = ftarea & ";" & "False"
End If
Try
' wenn im ListView eine Zeile selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' Überprüfen ob eingegebener Wert gepeichert werden muß?
Dim original As String = Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
"ft").getSelectAnweisung().ToString
If original <> ftarea Then
With btnSave_FulltextLinks
.Enabled = True
.ForeColor = Drawing.Color.Red
End With
End If
' die Informationen der selektierten Verknüpfung auslesen
Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
"ft").setSelectAnweisung(ftarea)
' das Profil auf den Status 'geändert' setzen
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
End If
Catch ex As Exception
MsgBox("Fehler bei Check Änderung Regex Area:" & vbNewLine & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Private Sub txtFT_Posvon_TextChanged(sender As Object, e As EventArgs) Handles txtFT_Posvon.TextChanged
check_changes_ftArea()
End Sub
Private Sub txtFT_Posbis_TextChanged(sender As Object, e As EventArgs) Handles txtFT_Posbis.TextChanged
check_changes_ftArea()
End Sub
Private Sub lbxIndex_SelectedIndexChanged(sender As Object, e As EventArgs) Handles lbxWMIndex.SelectedIndexChanged
Select Case Me._selectedProfil.Ni_Art
Case "fulltext"
' wenn im ListView ein Element selektiert wurde
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
' ListView deselektieren
Me.lvwVerknuepfungen.SelectedItems.Item(0).Selected = False
End If
Me.chkboxWhitespace.Checked = False
Me.txtregex.Text = ""
End Select
selectedIndex_Type = _windreamNI.GetIndex_Type(lbxWMIndex.SelectedItem)
If selectedIndex_Type Is Nothing = False Then
visinvisible_Vektor_ins_State()
End If
End Sub
Sub visinvisible_Vektor_ins_State()
If selectedIndex_Type.StartsWith("Vektor") Then
Me.rbvkt_add.Visible = True
Me.rbvkt_overwrite.Visible = True
Me.chkvkt_Dublette.Visible = True
Else
Me.rbvkt_add.Visible = False
Me.rbvkt_overwrite.Visible = False
Me.chkvkt_Dublette.Visible = False
End If
End Sub
Private Sub RichTextBox_RegEx_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox_RegEx.TextChanged
RTB_startindex = 0
End Sub
Private Sub rbvkt_overwrite_CheckedChanged(sender As Object, e As EventArgs) Handles rbvkt_overwrite.CheckedChanged
If Changeinaction = False Then
If Me.rbvkt_overwrite.Checked Then
Me.chkvkt_Dublette.Checked = False
Me.chkvkt_Dublette.Visible = False
End If
Check_Save_VktInsState()
End If
End Sub
Dim Changeinaction As Boolean = False
Private Sub rbvkt_add_CheckedChanged(sender As Object, e As EventArgs) Handles rbvkt_add.CheckedChanged
If Changeinaction = False Then
If rbvkt_add.Checked Then
Me.chkvkt_Dublette.Checked = False
Me.chkvkt_Dublette.Visible = True
End If
Check_Save_VktInsState()
End If
End Sub
Private Sub chkvkt_Dublette_CheckedChanged(sender As Object, e As EventArgs) Handles chkvkt_Dublette.CheckedChanged
If Changeinaction = False Then
Check_Save_VktInsState()
End If
End Sub
Sub Check_Save_VktInsState()
If Me.lvwVerknuepfungen.SelectedItems.Count > 0 Then
Dim par1 = Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text
Dim par2 = Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text
Dim par3 = Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text
Dim origstate = Me._selectedProfil._links.getLinkByValues(par1, par2, par3).getvktInsState
Dim vktState = Getvktinsert_State()
If vktState <> origstate Then
Changeinaction = True
Me._selectedProfil._links.getLinkByValues(Me.lvwVerknuepfungen.SelectedItems(0).SubItems(0).Text, Me.lvwVerknuepfungen.SelectedItems(0).SubItems(1).Text,
Me.lvwVerknuepfungen.SelectedItems(0).SubItems(2).Text).setvktIns(vktState)
Me._selectedProfil.setChanged()
Me._selectedProfil._links.setLinksChanged()
If Me._selectedProfil._links.selectedLink.SaveLink(Me._selectedProfil.Profilname, Me._selectedProfil.Ni_Art) = True Then
Me.lblsave.Visible = True
Me.lblsave.Text = "Gespeichert - " & Now.ToString
Else
Me.lblsave.Visible = False
End If
Changeinaction = False
End If
End If
End Sub
Private Sub trvwxml_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles trvwxml.AfterSelect
End Sub
Private Sub tabctrlbottom_SelectedIndexChanged(sender As Object, e As EventArgs) Handles tabctrlbottom.SelectedIndexChanged
Select Case tabctrlbottom.SelectedIndex
Case 0
If Me._selectedProfil.checkIndexsql <> "" Then
Me.txtCheckIndexSQL.Text = Me._selectedProfil.checkIndexsql
End If
Case 1
lblsaveSQLAnweisung.Text = ""
Me.txtfinalSkriptUpdate.Text = ""
If Me._selectedProfil.SQL_Anweisung <> "" Then
Me.txtfinalSkriptUpdate.Text = Me._selectedProfil.SQL_Anweisung
End If
Case 2
If Me._selectedProfil IsNot Nothing Then
chbxStatusfertig.Checked = True
End If
End Select
End Sub
Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click
Dim text As String = "[%ddvFULLFILENAME]"
Dim altePosition As Integer = Me.txtfinalSkriptUpdate.SelectionStart()
Me.txtfinalSkriptUpdate.Text = Me.txtfinalSkriptUpdate.Text.Insert(altePosition, text)
Me.txtfinalSkriptUpdate.SelectionStart = altePosition + text.Length
Me._selectedProfil.SQL_Anweisung = Me.txtfinalSkriptUpdate.Text
If Not Me._selectedProfil.SQL_Anweisung = Me._selectedProfil.OriginalSQL_Anweisung Then
Me._selectedProfil.setChanged()
If Me._selectedProfil.Save(True, "profile") = True Then
Me.lblsaveSQLAnweisung.Text = "Data saved - " & Now.ToString
End If
End If
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim text As String = "[%ddvFOLDERNAME]"
Dim altePosition As Integer = Me.txtfinalSkriptUpdate.SelectionStart()
Me.txtfinalSkriptUpdate.Text = Me.txtfinalSkriptUpdate.Text.Insert(altePosition, text)
Me.txtfinalSkriptUpdate.SelectionStart = altePosition + text.Length
Me._selectedProfil.SQL_Anweisung = Me.txtfinalSkriptUpdate.Text
If Not Me._selectedProfil.SQL_Anweisung = Me._selectedProfil.OriginalSQL_Anweisung Then
Me._selectedProfil.setChanged()
If Me._selectedProfil.Save(True, "profile") = True Then
Me.lblsaveSQLAnweisung.Text = "Data saved - " & Now.ToString
End If
End If
End Sub
Private Sub lblsaveSQLAnweisung_TextChanged(sender As Object, e As EventArgs) Handles lblsaveSQLAnweisung.TextChanged
If lblsaveSQLAnweisung.Text <> String.Empty Then
lblsaveSQLAnweisung.Visible = True
Else
lblsaveSQLAnweisung.Visible = False
End If
End Sub
Private Sub rbFunctionsSc_CheckedChanged(sender As Object, e As EventArgs) Handles rbFunctionsSc.CheckedChanged
If Not _flagIgnoreCheckedChanged Then
If Me._selectedProfil Is Nothing = False Then
Me.cmbDataviews.Items.Clear()
' View- oder Tabellenliste
Dim dataviews() As String = Nothing
If Me._selectedProfil.DbArt = "MS-SQL" Then
dataviews = Me.GetMsSqlFunctions("FN")
'ElseIf Me._selectedProfil.DbArt = "ODBC" Then
' dataviews = Me.GetOdbcDataviews(Me.rbViews.Checked)
'ElseIf Me._selectedProfil.DbArt = "OLE (Access)" Then
' dataviews = Me.GetOleDataviews(Me.rbViews.Checked)
Else
MsgBox("Der gewählte Datenbanktyp ist nicht für Funktionen unterstützt.", MsgBoxStyle.Critical, "Unbekannter Datenbanktyp")
End If
If dataviews IsNot Nothing Then
For Each dataview As String In dataviews
Me.cmbDataviews.Items.Add(dataview)
Next
End If
Me.txtSelectAnweisung.Text = ""
Else
MsgBox("Bitte wählen Sie ein Profil aus!", MsgBoxStyle.Information, "Achtung:")
End If
End If
End Sub
Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
End Sub
Private Sub btnSaveAll_Click(sender As Object, e As EventArgs) Handles btnSaveAll.Click
SaveLinks()
SaveProfile()
End Sub
Private Sub btnSaveAllAndClose_Click(sender As Object, e As EventArgs) Handles btnSaveAllAndClose.Click
Me.Close()
End Sub
Private Sub btnCancelAllAndClose_Click(sender As Object, e As EventArgs) Handles btnCancelAllAndClose.Click
Me.Close()
End Sub
End Class