Initial
This commit is contained in:
522
EDOKA/Utils/ApplicationFileWatcher.vb
Normal file
522
EDOKA/Utils/ApplicationFileWatcher.vb
Normal file
@@ -0,0 +1,522 @@
|
||||
Imports System
|
||||
Imports System.Text
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Threading
|
||||
Imports System.IO
|
||||
|
||||
Public Class ApplicationFileWatcher_X
|
||||
|
||||
#Region "Deklarationen"
|
||||
Private m_isActive As Boolean
|
||||
Public Event DocumentClosed()
|
||||
|
||||
Private m_Filename As String
|
||||
Property Filename() As String
|
||||
Get
|
||||
Return m_Filename
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_Filename = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Private m_ApplicationType As Integer
|
||||
Property ApplicationType()
|
||||
Get
|
||||
Return m_ApplicationType
|
||||
End Get
|
||||
Set(ByVal Value)
|
||||
m_ApplicationType = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Private m_Applicationname As String
|
||||
Property Appname() As String
|
||||
Get
|
||||
Return m_Applicationname
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_Applicationname = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Private m_WindowNameDC As String
|
||||
Property WindowNameDC() As String
|
||||
Get
|
||||
Return m_WindowNameDC
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_WindowNameDC = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
|
||||
Private m_WindowName As String
|
||||
Property WindowName() As String
|
||||
Get
|
||||
Return m_WindowName
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_WindowName = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
'Rel. Office 2010
|
||||
Private m_WindowNameKomp As String
|
||||
Property WindowNameKompatibilitaet() As String
|
||||
Get
|
||||
Return m_WindowNameKomp
|
||||
End Get
|
||||
Set(ByVal value As String)
|
||||
m_WindowNameKomp = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Private m_WindowNamePreview As String
|
||||
Property WindowNamePreview() As String
|
||||
Get
|
||||
Return m_WindowNamePreview
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_WindowNamePreview = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_processid As Long
|
||||
Property ProcessID As Long
|
||||
Get
|
||||
Return m_processid
|
||||
End Get
|
||||
Set(value As Long)
|
||||
m_processid = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_dokumentid As String
|
||||
Property Dokumentid As String
|
||||
Get
|
||||
Return m_dokumentid
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_dokumentid = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Const STRING_BUFFER_LENGTH As Integer = 255
|
||||
Dim WindowArray As New ArrayList()
|
||||
Dim WithEvents MyTimer As New System.Timers.Timer(1000)
|
||||
|
||||
Dim Office2016Names As New List(Of String)
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Öffentliche Methoden"
|
||||
Public Sub New()
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal typ As Integer, ByVal DocFileName As String)
|
||||
MyBase.New()
|
||||
End Sub
|
||||
|
||||
Public Sub Dispose()
|
||||
Me.WindowArray = Nothing
|
||||
End Sub
|
||||
|
||||
Public Sub Start()
|
||||
AddHandler MyTimer.Elapsed, AddressOf TimerFired
|
||||
SetWindowName()
|
||||
MyTimer.Start()
|
||||
End Sub
|
||||
|
||||
Public Sub Stopp()
|
||||
Me.MyTimer.Stop()
|
||||
End Sub
|
||||
|
||||
Public Sub BringWindowToTop()
|
||||
Dim i As Integer
|
||||
SetWindowName()
|
||||
i = Win32API.FindWindow(vbNullString, Me.WindowName)
|
||||
|
||||
If i <> 0 Then
|
||||
i = Win32API.SetForegroundWindow(i)
|
||||
i = Win32API.ShowWindow(i, Win32API.SW_RESTORE)
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Function doc_is_active() As Boolean
|
||||
|
||||
Dim Docfound As Boolean = False
|
||||
Try
|
||||
Dim p As Process = Process.GetProcessById(Me.ProcessID)
|
||||
If p.Id = Me.ProcessID Then
|
||||
If GetHandle(Me.Dokumentid) <> 0 Then Docfound = True
|
||||
If p.Id = 0 Then Docfound = False
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Docfound = False
|
||||
End Try
|
||||
Return Docfound
|
||||
Exit Function
|
||||
|
||||
'Dim I As Integer
|
||||
'Search_List()
|
||||
'For I = 0 To Me.WindowArray.Count - 1
|
||||
' If Me.WindowArray.Item(I) = Me.WindowName Then doc_is_active = True
|
||||
'Next
|
||||
Dim I As Integer
|
||||
'20200901 - Clear WindowWarray
|
||||
Me.WindowArray.Clear()
|
||||
Search_List()
|
||||
If Globals.UseOffice2016 = False Then
|
||||
For I = 0 To Me.WindowArray.Count - 1
|
||||
If Me.WindowArray.Item(I) = Me.WindowName Then doc_is_active = True
|
||||
Next
|
||||
End If
|
||||
If Globals.UseOffice2016 = True Then
|
||||
For I = 0 To Me.WindowArray.Count - 1
|
||||
For x As Integer = 0 To Me.Office2016Names.Count - 1
|
||||
If Me.WindowArray.Item(I).ToString <> "" And Me.WindowArray.Item(I) = Me.Office2016Names.Item(x) Then
|
||||
doc_is_active = True
|
||||
Try
|
||||
If Globals.Office2016Debug = True Then
|
||||
FileOpen(7, "h:\office2016Windowlist.txt", OpenMode.Append)
|
||||
WriteLine(7, "--->Is Active:" + Me.WindowArray.Item(I).ToString + "/" + Me.Office2016Names.Item(x))
|
||||
FileClose(7)
|
||||
End If
|
||||
Catch EX As Exception
|
||||
End Try
|
||||
End If
|
||||
|
||||
Next
|
||||
Next
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Private Methoden"
|
||||
|
||||
Public Function GetHandle(ByVal caption As String) As String
|
||||
Try
|
||||
For i As Integer = 1 To Globals.try_count_search
|
||||
If ApplicationType = 1 Then
|
||||
For Each p As Process In Process.GetProcessesByName("winword")
|
||||
If p.MainWindowTitle.IndexOf(caption) > -1 Then
|
||||
Return p.Id.ToString
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
If ApplicationType = 2 Then
|
||||
For Each p As Process In Process.GetProcessesByName("excel")
|
||||
If p.MainWindowTitle.IndexOf(caption) > -1 Then
|
||||
Return p.Id.ToString
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
If Me.ApplicationType <> 1 And Me.ApplicationType <> 2 Then
|
||||
For Each p As Process In Process.GetProcesses
|
||||
If p.MainWindowTitle.IndexOf(caption) > -1 Then
|
||||
Return p.Id.ToString
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Next
|
||||
End If
|
||||
Thread.Sleep(500)
|
||||
Next i
|
||||
|
||||
Return 0
|
||||
Catch ex As Exception
|
||||
PerfMon.force_insert_entry(Me.Dokumentid + ": Prozess-ID konnte nicht ermittelt werden: " + ex.Message)
|
||||
End Try
|
||||
|
||||
End Function
|
||||
|
||||
Public Sub SetWindowName()
|
||||
'Select Case Me.ApplicationType
|
||||
' Case 1 'Word
|
||||
' Me.WindowName = Me.Filename + " - Microsoft Word"
|
||||
' Me.WindowNameKompatibilitaet = Me.Filename + " [Kompatibilitätsmodus] - Microsoft Word"
|
||||
' Me.WindowNamePreview = Me.Filename + " (Seitenansicht) - Microsoft Word"
|
||||
' Me.WindowNameDC = Me.Filename + " - DC"
|
||||
' Case 2 'Excel
|
||||
' Me.WindowName = "Microsoft Excel - " & Me.Filename
|
||||
' Me.WindowNameKompatibilitaet = "Microsoft Excel - " & Me.Filename + " [Kompatibilitätsmodus]"
|
||||
' Me.WindowNamePreview = "Microsoft Excel - " & Me.Filename
|
||||
' Me.WindowNameDC = Me.Filename + ""
|
||||
' Case 3
|
||||
' Me.WindowName = Me.Filename + " - Adobe Reader"
|
||||
' Me.WindowNameKompatibilitaet = Me.Filename + " - Adobe Reader"
|
||||
' Me.WindowNamePreview = Me.Filename + " - Adobe Reader"
|
||||
' Me.WindowNameDC = Me.Filename + ""
|
||||
' Case 4
|
||||
' Me.WindowName = Me.WindowName
|
||||
' Me.WindowNamePreview = Me.WindowNamePreview
|
||||
' Me.WindowNameDC = Me.Filename + ""
|
||||
' Case Else
|
||||
' 'MsgBox("Hallo")
|
||||
'End Select
|
||||
If Globals.Office2010WatchFIles.Rows.Count = 0 Then
|
||||
DivFnkt.Get_Office2016_Params()
|
||||
End If
|
||||
If Globals.UseOffice2016 = False Then
|
||||
Select Case Me.ApplicationType
|
||||
Case 1 'Word
|
||||
Me.WindowName = Me.Filename + " - Microsoft Word"
|
||||
Me.WindowNameKompatibilitaet = Me.Filename + " [Kompatibilitätsmodus] - Microsoft Word"
|
||||
Me.WindowNamePreview = Me.Filename + " (Seitenansicht) - Microsoft Word"
|
||||
Me.WindowNameDC = Me.Filename + " - DC"
|
||||
Case 2 'Excel
|
||||
Me.WindowName = "Microsoft Excel - " & Me.Filename
|
||||
Me.WindowNameKompatibilitaet = "Microsoft Excel - " & Me.Filename + " [Kompatibilitätsmodus]"
|
||||
Me.WindowNameKompatibilitaet = Me.Filename + " [Kompatibilitätsmodus] - Excel"
|
||||
Me.WindowNamePreview = "Microsoft Excel - " & Me.Filename
|
||||
Me.WindowNameDC = Me.Filename + ""
|
||||
Case 3
|
||||
Me.WindowName = Me.Filename + " - Adobe Reader"
|
||||
Me.WindowNameKompatibilitaet = Me.Filename + " - Adobe Reader"
|
||||
Me.WindowNamePreview = Me.Filename + " - Adobe Reader"
|
||||
Me.WindowNameDC = Me.Filename + ""
|
||||
Case 4
|
||||
Me.WindowName = Me.WindowName
|
||||
Me.WindowNamePreview = Me.WindowNamePreview
|
||||
Me.WindowNameDC = Me.Filename + ""
|
||||
Case Else
|
||||
'MsgBox("Hallo")
|
||||
End Select
|
||||
End If
|
||||
If Globals.UseOffice2016 = True Then
|
||||
For Each r As DataRow In Globals.Office2010WatchFIles.Rows
|
||||
Select Case ApplicationType
|
||||
Case 1 'word
|
||||
If r("applikation") = "Word" Then
|
||||
If r.Item(0) = 1 Then Me.WindowName = r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename)
|
||||
Me.Office2016Names.Add(r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename))
|
||||
End If
|
||||
Case 2 'Excel
|
||||
If r("applikation") = "Excel" Then
|
||||
If r.Item(0) = 10 Then Me.WindowName = r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename)
|
||||
Me.Office2016Names.Add(r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename))
|
||||
End If
|
||||
Case 3 'Acrobat
|
||||
If r("applikation") = "Adobe" Then
|
||||
If r.Item(0) = 20 Then Me.WindowName = r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename)
|
||||
Me.Office2016Names.Add(r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename))
|
||||
End If
|
||||
Case Else
|
||||
Me.Office2016Names.Add(r.Item("WindowName").ToString.Replace("[Filename]", Me.Filename))
|
||||
End Select
|
||||
|
||||
Next
|
||||
End If
|
||||
|
||||
End Sub
|
||||
Public Function getWindowName() As String
|
||||
Return Me.WindowName
|
||||
End Function
|
||||
|
||||
'Public Sub TimerFired(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles MyTimer.Elapsed
|
||||
' MyTimer.Stop()
|
||||
' 'Dim sW As New StreamWriter("D:\TRACE.LOG", True)
|
||||
' 'sW.WriteLine(Now)
|
||||
' Dim DocFound As Boolean = False
|
||||
' Dim i As Integer
|
||||
' Dim zz As Integer = 0
|
||||
' 'While zz < 3 And DocFound = False
|
||||
' Me.WindowArray.Clear()
|
||||
' Search_List()
|
||||
' For i = 0 To Me.WindowArray.Count - 1
|
||||
' 'sW.WriteLine(Me.WindowName + ":" + Me.WindowArray.Item(i))
|
||||
' 'If Me.WindowArray.Item(i) = Me.WindowName Then MsgBox("Ist aktiv")
|
||||
' If Me.WindowArray.Item(i) = Me.WindowName Then DocFound = True
|
||||
' If Me.WindowArray.Item(i) = Me.WindowNamePreview Then DocFound = True
|
||||
' If Me.WindowArray.Item(i) = Me.WindowNameDC Then DocFound = True
|
||||
' If Me.WindowArray.Item(i) = Me.WindowNameKompatibilitaet Then DocFound = True
|
||||
' Next
|
||||
' 'zz = zz + 1
|
||||
' ' Thread.Sleep(300)
|
||||
' ' 'End While
|
||||
' ' Thread.Sleep(300)
|
||||
' If Not DocFound Then
|
||||
' Dim fn As String = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "~$" + Microsoft.VisualBasic.Right(Me.Filename, Len(Me.Filename) - 2)
|
||||
' Dim fc As New FileInfo(fn)
|
||||
' If fc.Exists Then DocFound = True
|
||||
' If Not DocFound Then
|
||||
' ' sW.WriteLine("Stop:" + Me.WindowName)
|
||||
' MyTimer.Stop()
|
||||
' RaiseEvent DocumentClosed()
|
||||
' Else
|
||||
' MyTimer.Start()
|
||||
' End If
|
||||
' Else
|
||||
' MyTimer.Start()
|
||||
' End If
|
||||
' DocFound = Nothing
|
||||
' ' sW.WriteLine(Now)
|
||||
' ' sW.Flush()
|
||||
' ' sW.Close()
|
||||
'End Sub
|
||||
|
||||
'Public Sub TimerFired1(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles MyTimer.Elapsed
|
||||
' MyTimer.Stop()
|
||||
' Dim DocFound As Boolean = False
|
||||
' Dim i As Integer
|
||||
' Dim zz As Integer = 0
|
||||
' Me.WindowArray.Clear()
|
||||
' Search_List()
|
||||
|
||||
' Try
|
||||
' If Globals.Office2016Debug = True Then FileOpen(7, "h:\office2016Windowlist.txt", OpenMode.Append)
|
||||
' Catch EX As Exception
|
||||
' End Try
|
||||
|
||||
' Try
|
||||
' For i = 0 To Me.WindowArray.Count - 1
|
||||
' If Globals.UseOffice2016 = False Then
|
||||
' If Me.WindowArray.Item(i) = Me.WindowName Then DocFound = True
|
||||
' If Me.WindowArray.Item(i) = Me.WindowNamePreview Then DocFound = True
|
||||
' If Me.WindowArray.Item(i) = Me.WindowNameDC Then DocFound = True
|
||||
' If Me.WindowArray.Item(i) = Me.WindowNameKompatibilitaet Then DocFound = True
|
||||
' End If
|
||||
' If Globals.Office2016Debug = True Then
|
||||
' WriteLine(7, "EDOKA:-----------------------------------------------")
|
||||
' End If
|
||||
|
||||
' If Globals.UseOffice2016 = True Then
|
||||
' For x As Integer = 0 To Me.Office2016Names.Count - 1
|
||||
' If Globals.Office2016Debug = True Then
|
||||
' WriteLine(7, "EDOKA:" + Me.Office2016Names.Item(x).ToString + " - " + Me.Office2016Names.Count.ToString)
|
||||
' End If
|
||||
' If Me.WindowArray.Item(i).ToString <> "" And Me.WindowArray.Item(i) = Me.Office2016Names.Item(x) Then
|
||||
' DocFound = True
|
||||
' If Globals.Office2016Debug = True Then
|
||||
' WriteLine(7, "--->DocFound:" + Me.WindowArray.Item(i).ToString + "/" + Me.Office2016Names.Item(x))
|
||||
' End If
|
||||
' Exit For
|
||||
' End If
|
||||
' Next
|
||||
' If DocFound Then Exit For
|
||||
' End If
|
||||
' Try
|
||||
' If Globals.Office2016Debug = True Then
|
||||
' WriteLine(7, Me.WindowArray.Item(i))
|
||||
' End If
|
||||
' Catch
|
||||
' End Try
|
||||
' Next
|
||||
' Catch ex As Exception
|
||||
' End Try
|
||||
|
||||
' If Globals.Office2016Debug = True Then
|
||||
' Try
|
||||
' For i = 1 To 100000
|
||||
' Application.DoEvents()
|
||||
' Next
|
||||
' FileClose(7)
|
||||
' Catch
|
||||
' End Try
|
||||
|
||||
' End If
|
||||
' If Not DocFound Then
|
||||
' Dim fn As String = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "~$" + Microsoft.VisualBasic.Right(Me.Filename, Len(Me.Filename) - 2)
|
||||
' Dim fc As New FileInfo(fn)
|
||||
' If fc.Exists Then DocFound = True
|
||||
' If Not DocFound Then
|
||||
' ' sW.WriteLine("Stop:" + Me.WindowName)
|
||||
' MyTimer.Stop()
|
||||
' GC.Collect()
|
||||
' GC.WaitForPendingFinalizers()
|
||||
' GC.Collect()
|
||||
|
||||
' GC.WaitForPendingFinalizers()
|
||||
' RaiseEvent DocumentClosed()
|
||||
' Else
|
||||
' MyTimer.Start()
|
||||
' End If
|
||||
' Else
|
||||
' MyTimer.Start()
|
||||
' End If
|
||||
' DocFound = Nothing
|
||||
'End Sub
|
||||
|
||||
Public Sub TimerFired(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles MyTimer.Elapsed
|
||||
MyTimer.Stop()
|
||||
Dim DocFound As Boolean = False
|
||||
|
||||
Dim i As Integer = 0
|
||||
|
||||
Try
|
||||
Dim p As Process = Process.GetProcessById(Me.ProcessID)
|
||||
If p.Id = Me.ProcessID Then DocFound = True
|
||||
Catch ex As Exception
|
||||
DocFound = False
|
||||
End Try
|
||||
|
||||
|
||||
If ApplicationType = 3 Then
|
||||
If GetHandle(Me.Dokumentid) > 0 Then DocFound = True Else DocFound = False
|
||||
End If
|
||||
|
||||
If Not DocFound Then
|
||||
GC.Collect()
|
||||
GC.WaitForPendingFinalizers()
|
||||
GC.Collect()
|
||||
|
||||
GC.WaitForPendingFinalizers()
|
||||
RaiseEvent DocumentClosed()
|
||||
Else
|
||||
MyTimer.Start()
|
||||
End If
|
||||
DocFound = Nothing
|
||||
End Sub
|
||||
Private Sub Search_List()
|
||||
Win32API.EnumWindowsDllImport(New Win32API.EnumWindowsCallback(AddressOf _
|
||||
FillActiveWindowsList), 0)
|
||||
'20200901 - Wait afrer Fill
|
||||
Thread.Sleep(Globals.wait_after_searchlist)
|
||||
End Sub
|
||||
|
||||
Function FillActiveWindowsList(ByVal hWnd As Integer, ByVal lParam As Integer) As Boolean
|
||||
Dim windowText As New StringBuilder(STRING_BUFFER_LENGTH)
|
||||
Win32API.GetWindowText(hWnd, windowText, STRING_BUFFER_LENGTH)
|
||||
If ProcessIsActiveWindow(hWnd) Then
|
||||
Me.WindowArray.Add(windowText.ToString)
|
||||
End If
|
||||
Return True
|
||||
End Function
|
||||
|
||||
Function ProcessIsActiveWindow(ByVal hWnd As Integer) As Boolean
|
||||
Dim windowText As New StringBuilder(STRING_BUFFER_LENGTH)
|
||||
Dim windowIsOwned As Boolean
|
||||
Dim windowStyle As Integer
|
||||
Win32API.GetWindowText(hWnd, windowText, STRING_BUFFER_LENGTH)
|
||||
windowIsOwned = Win32API.GetWindow(hWnd, Win32API.GW_OWNER) <> 0
|
||||
windowStyle = Win32API.GetWindowLong(hWnd, Win32API.GWL_EXSTYLE)
|
||||
Return True
|
||||
|
||||
If Not Win32API.IsWindowVisible(hWnd) Then
|
||||
Return False
|
||||
End If
|
||||
If windowText.ToString.Equals("") Then
|
||||
Return False
|
||||
End If
|
||||
If Win32API.GetParent(hWnd) <> 0 Then
|
||||
Return False
|
||||
End If
|
||||
If (windowStyle And Win32API.WS_EX_TOOLWINDOW) <> 0 And Not windowIsOwned Then
|
||||
Return False
|
||||
End If
|
||||
If (windowStyle And Win32API.WS_EX_APPWINDOW) = 0 And windowIsOwned Then
|
||||
Return False
|
||||
End If
|
||||
Return True
|
||||
End Function
|
||||
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
1056
EDOKA/Utils/Archivfnkt.vb
Normal file
1056
EDOKA/Utils/Archivfnkt.vb
Normal file
File diff suppressed because it is too large
Load Diff
28
EDOKA/Utils/AvaloqDokumentWert.vb
Normal file
28
EDOKA/Utils/AvaloqDokumentWert.vb
Normal file
@@ -0,0 +1,28 @@
|
||||
<Serializable()> _
|
||||
Public Class AvaloqDokumentWert
|
||||
Private strName As String
|
||||
Private strValue As String
|
||||
|
||||
Public Sub New(ByVal name As String, ByVal value As String)
|
||||
Me.name = name
|
||||
Me.value = value
|
||||
|
||||
End Sub
|
||||
|
||||
Public Property name() As String
|
||||
Get
|
||||
Return strName
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
strName = Value
|
||||
End Set
|
||||
End Property
|
||||
Public Property value() As String
|
||||
Get
|
||||
Return strValue
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
strValue = Value
|
||||
End Set
|
||||
End Property
|
||||
End Class
|
||||
431
EDOKA/Utils/AvaloqDokumentWerte.vb
Normal file
431
EDOKA/Utils/AvaloqDokumentWerte.vb
Normal file
@@ -0,0 +1,431 @@
|
||||
Imports System.IO
|
||||
Imports System.Xml
|
||||
Imports System.Xml.Schema
|
||||
<Serializable()> _
|
||||
Public Class AvaloqDokumentWerte
|
||||
|
||||
Dim m_Partnernr As Integer
|
||||
Property Partnernr As Integer
|
||||
Get
|
||||
Return m_Partnernr
|
||||
End Get
|
||||
Set(value As Integer)
|
||||
m_Partnernr = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Personnr As Integer
|
||||
Property PersonNr As Integer
|
||||
Get
|
||||
Return m_Personnr
|
||||
End Get
|
||||
Set(value As Integer)
|
||||
m_Personnr = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_fanummer3 As String
|
||||
Property FANummer3 As String
|
||||
Get
|
||||
Return m_fanummer3
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_fanummer3 = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_ordernr As String
|
||||
Property Ordernr As String
|
||||
Get
|
||||
Return m_ordernr
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_ordernr = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_dokumenttypnr As String
|
||||
Property Dokumenttypnr As String
|
||||
Get
|
||||
Return m_dokumenttypnr
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_dokumenttypnr = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_direkteErstellung As String
|
||||
Property Direkteerstellung As String
|
||||
Get
|
||||
Return m_direkteErstellung
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_direkteErstellung = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_dokumentpaket As String
|
||||
Property Dokumentpaket As String
|
||||
Get
|
||||
Return m_dokumentpaket
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_dokumentpaket = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Postzustellung As String
|
||||
Property Postzustellung As String
|
||||
Get
|
||||
Return m_Postzustellung
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_Postzustellung = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Zustaendig As String
|
||||
Property Zustaendig As String
|
||||
Get
|
||||
Return m_Zustaendig
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_Zustaendig = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_uslinks As String
|
||||
Property USLinks As String
|
||||
Get
|
||||
Return m_uslinks
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_uslinks = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_usrechts As String
|
||||
Property USRechts As String
|
||||
Get
|
||||
Return m_usrechts
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_usrechts = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_BCFrage As String
|
||||
Property BCFrage As String
|
||||
Get
|
||||
Return m_BCFrage
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_BCFrage = value
|
||||
End Set
|
||||
End Property
|
||||
Dim m_statuswechsel As String
|
||||
Property Statuswechsel As String
|
||||
Get
|
||||
Return m_statuswechsel
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_statuswechsel = value
|
||||
End Set
|
||||
End Property
|
||||
Dim m_dokumentdatum As String
|
||||
Property Dokumentdatum As String
|
||||
Get
|
||||
Return m_dokumentdatum
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_dokumentdatum = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Verantwortlich As String
|
||||
Property Verantwortlich As String
|
||||
Get
|
||||
Return m_Verantwortlich
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_Verantwortlich = value
|
||||
End Set
|
||||
End Property
|
||||
Dim m_adokumentwerte As ArrayList
|
||||
Property ADokumentwerte As ArrayList
|
||||
Get
|
||||
Return m_adokumentwerte
|
||||
End Get
|
||||
Set(value As ArrayList)
|
||||
m_adokumentwerte = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Dokumentid As String
|
||||
Property Dokumentid As String
|
||||
Get
|
||||
Return m_Dokumentid
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_Dokumentid = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Avq_auth_extl_ref1 As String
|
||||
Property Avq_auth_extl_ref1 As String
|
||||
Get
|
||||
Return m_Avq_auth_extl_ref1
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_Avq_auth_extl_ref1 = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Avq_auth_extl_ref2 As String
|
||||
Property Avq_auth_extl_ref2 As String
|
||||
Get
|
||||
Return m_Avq_auth_extl_ref2
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_Avq_auth_extl_ref2 = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_avq_auth_extl_ref_dt As New DataTable
|
||||
Property Avq_extl_ref_dt As DataTable
|
||||
Get
|
||||
Return m_avq_auth_extl_ref_dt
|
||||
End Get
|
||||
Set(value As DataTable)
|
||||
m_avq_auth_extl_ref_dt = value
|
||||
End Set
|
||||
End Property
|
||||
'Dim m_dsdokumentwerte As New DataSet
|
||||
'Property DS_Dokumentwerte As DataSet
|
||||
' Get
|
||||
' Return m_dsdokumentwerte
|
||||
' End Get
|
||||
' Set(value As DataSet)
|
||||
' m_dsdokumentwerte = value
|
||||
' End Set
|
||||
'End Property
|
||||
#Region "Members"
|
||||
Private arrDoukmentWerte As New ArrayList()
|
||||
Private objDokumentWert As AvaloqDokumentWert
|
||||
#End Region
|
||||
|
||||
#Region "Public methods"
|
||||
Public Function HeaderInfo(ByRef doc As XmlDocument, ByVal xmlfile As String)
|
||||
|
||||
For Each n As XmlNode In doc.ChildNodes
|
||||
' MsgBox(n.Name)
|
||||
For Each N1 As XmlNode In n.ChildNodes
|
||||
Select Case UCase(N1.Name)
|
||||
Case "ACTIONID"
|
||||
Case "CREATORTG"
|
||||
Case "PARTNERNR"
|
||||
Me.Partnernr = N1.InnerText
|
||||
Case "PERSONNR"
|
||||
Me.PersonNr = N1.InnerText
|
||||
Case "FANUMMER3"
|
||||
Me.FANummer3 = N1.InnerText
|
||||
Case "ORDERNR"
|
||||
Me.Ordernr = N1.InnerText.ToString
|
||||
Case "DOKUMENTTYPNR"
|
||||
Me.Dokumenttypnr = N1.InnerText
|
||||
Case "DIREKTEERSTELLUNG"
|
||||
Me.Direkteerstellung = N1.InnerText
|
||||
Case "DOKUMENTPAKET"
|
||||
Me.Dokumentpaket = N1.InnerText
|
||||
Case "POSTZUSTELLUNG"
|
||||
Me.Postzustellung = N1.InnerText
|
||||
Case "USLINKS"
|
||||
Me.USLinks = N1.InnerText
|
||||
Case "USRECHTS"
|
||||
Me.USRechts = N1.InnerText
|
||||
Case "ZUSTAENDIG"
|
||||
Me.Zustaendig = N1.InnerText
|
||||
Case "VERANTWORTLICH"
|
||||
Me.Verantwortlich = N1.InnerText
|
||||
|
||||
Case "DOKUMENTDATUM"
|
||||
Me.Dokumentdatum = N1.InnerText
|
||||
Case "BC"
|
||||
Me.BCFrage = N1.InnerText
|
||||
Case "STATUSWECHSEL"
|
||||
Me.Statuswechsel = N1.InnerText
|
||||
Case "DOKUMENTID"
|
||||
Me.Statuswechsel = N1.InnerText
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
End Function
|
||||
'''<summary>Lädt externes Xml file für automatisierte Aktionen</summary>
|
||||
'''<param name="xmlImportFile">Das Xml File mit den entsprechenden Parametern</param>
|
||||
Public Function init(ByVal xmlImportFile As FileInfo)
|
||||
Try
|
||||
|
||||
Dim doc As New XmlDocument()
|
||||
|
||||
doc.Load(xmlImportFile.FullName)
|
||||
HeaderInfo(doc, xmlImportFile.FullName)
|
||||
'read all parameter nodes
|
||||
Dim parameterNodes As XmlNodeList
|
||||
parameterNodes = doc.SelectNodes("action/dokwerte/parameter")
|
||||
|
||||
Me.Avq_extl_ref_dt.Rows.Clear()
|
||||
Me.Avq_extl_ref_dt.Columns.Clear()
|
||||
Me.Avq_extl_ref_dt.Columns.Add("Doktype")
|
||||
Me.Avq_extl_ref_dt.Columns.Add("RefNr")
|
||||
Me.Avq_extl_ref_dt.Columns.Add("avq_auth_extl_ref")
|
||||
|
||||
If parameterNodes.Count > 0 Then
|
||||
Dim node As XmlNode
|
||||
Dim name, value, dataType As String
|
||||
|
||||
Dim parameterCounter As Integer = 0
|
||||
|
||||
For Each node In parameterNodes
|
||||
'Read all Document specified Values
|
||||
'20080401 RGL zusätzliches TRY wenn node <parameter> leer geliefert wird kein Absturz
|
||||
Try
|
||||
name = node.SelectSingleNode("name").InnerText
|
||||
value = node.SelectSingleNode("value").InnerText
|
||||
objDokumentWert = New AvaloqDokumentWert(name, value)
|
||||
arrDoukmentWerte.Add(objDokumentWert)
|
||||
|
||||
Dim xname As String
|
||||
Dim doktyp As String
|
||||
xname = name
|
||||
doktyp = ""
|
||||
|
||||
If UCase(name).IndexOf("AVQ_AUTH_EXTL_REF_") > -1 Or UCase(name).IndexOf("AVQ_AUTH_EXTL_REF1_") > -1 Or UCase(name).IndexOf("AVQ_AUTH_EXTL_REF2_") > -1 Then
|
||||
If UCase(name).IndexOf("AVQ_AUTH_EXTL_REF_") > -1 Then
|
||||
xname = "AVQ_AUTH_EXTL_REF"
|
||||
doktyp = UCase(name).Substring(18, Len(name) - 18)
|
||||
End If
|
||||
If UCase(name).IndexOf("AVQ_AUTH_EXTL_REF1_") > -1 Then
|
||||
xname = "AVQ_AUTH_EXTL_REF1"
|
||||
doktyp = UCase(name).Substring(19, Len(name) - 19)
|
||||
End If
|
||||
If UCase(name).IndexOf("AVQ_AUTH_EXTL_REF2_") > -1 Then
|
||||
xname = "AVQ_AUTH_EXTL_REF2"
|
||||
doktyp = UCase(name).Substring(19, Len(name) - 19)
|
||||
End If
|
||||
|
||||
End If
|
||||
|
||||
Select Case UCase(xname)
|
||||
Case "AVQ_AUTH_EXTL_REF", "AVQ_AUTH_EXTL_REF1"
|
||||
Dim r As DataRow = Me.Avq_extl_ref_dt.NewRow
|
||||
r.Item(0) = doktyp
|
||||
r.Item(1) = 1
|
||||
r.Item(2) = value
|
||||
'Me.Avq_auth_extl_ref1 = value
|
||||
Me.Avq_extl_ref_dt.Rows.Add(r)
|
||||
Case "AVQ_AUTH_EXTL_REF2"
|
||||
Dim r As DataRow = Me.Avq_extl_ref_dt.NewRow
|
||||
r.Item(0) = doktyp
|
||||
r.Item(1) = 2
|
||||
r.Item(2) = value
|
||||
'Me.Avq_auth_extl_ref1 = value
|
||||
Me.Avq_extl_ref_dt.Rows.Add(r)
|
||||
End Select
|
||||
|
||||
'If UCase(name) = "AVQ_AUTH_EXTL_REF" Then
|
||||
' Dim r As DataRow = Me.Avq_extl_ref_dt.NewRow
|
||||
' r.Item(0) = ""
|
||||
' r.Item(1) = 1
|
||||
' r.Item(2) = value
|
||||
' Me.Avq_auth_extl_ref1 = value
|
||||
' Me.Avq_extl_ref_dt.Rows.Add(r)
|
||||
'End If
|
||||
|
||||
|
||||
'If UCase(name) = "AVQ_AUTH_EXTL_REF1" Then
|
||||
' Dim r As DataRow = Me.Avq_extl_ref_dt.NewRow
|
||||
' r.Item(0) = ""
|
||||
' r.Item(1) = 1
|
||||
' r.Item(2) = value
|
||||
' Me.Avq_auth_extl_ref1 = value
|
||||
' Me.Avq_extl_ref_dt.Rows.Add(r)
|
||||
'End If
|
||||
'If UCase(name) = "AVQ_AUTH_EXTL_REF2" Then
|
||||
' Dim r As DataRow = Me.Avq_extl_ref_dt.NewRow
|
||||
' r.Item(0) = ""
|
||||
' r.Item(1) = 2
|
||||
' r.Item(2) = value
|
||||
' Me.Avq_auth_extl_ref1 = value
|
||||
' Me.Avq_extl_ref_dt.Rows.Add(r)
|
||||
'End If
|
||||
|
||||
|
||||
|
||||
Catch ex As Exception
|
||||
TKBLib.Errorhandling.TraceHelper.Msg("EdokaLib.Common.Action.Load", ex.Message & ex.StackTrace, TraceLevel.Error)
|
||||
End Try
|
||||
parameterCounter = parameterCounter + 1
|
||||
|
||||
Next
|
||||
Me.ADokumentwerte = arrDoukmentWerte
|
||||
End If
|
||||
|
||||
'Dim ds As New DataSet
|
||||
'ds.ReadXml(xmlImportFile.FullName)
|
||||
'For Each dt As DataTable In ds.Tables
|
||||
' If UCase(dt.TableName) = "DOKUMENT" Then
|
||||
' Me.DS_Dokumentwerte.Tables.Add(dt.Copy)
|
||||
' End If
|
||||
' If UCase(dt.TableName) = "PARAMETER" Then
|
||||
' Me.DS_Dokumentwerte.Tables.Add(dt.Copy)
|
||||
' End If
|
||||
|
||||
'Next
|
||||
'ds.Dispose()
|
||||
Catch ex As Exception
|
||||
|
||||
TKBLib.Errorhandling.TraceHelper.Msg("EdokaLib.Common.Action.Load", ex.Message & ex.StackTrace, TraceLevel.Error)
|
||||
Throw ex
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function getAvaloqDokumentWertByName(ByVal name As String) As AvaloqDokumentWert
|
||||
Dim objRet As AvaloqDokumentWert = Nothing
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To arrDoukmentWerte.Count - 1
|
||||
If arrDoukmentWerte(i).name = name Then
|
||||
objRet = arrDoukmentWerte(i)
|
||||
End If
|
||||
Next
|
||||
Return objRet
|
||||
End Function
|
||||
|
||||
Public Function getAvaloqDokumentWertByName(ByVal aDokumentwerte As ArrayList, ByVal name As String, ByVal Techname As String) As AvaloqDokumentWert
|
||||
Dim objRet As AvaloqDokumentWert = Nothing
|
||||
Dim x As AvaloqDokumentWert
|
||||
Dim i As Integer
|
||||
Try
|
||||
For i = 0 To aDokumentwerte.Count - 1
|
||||
x = aDokumentwerte(i)
|
||||
If aDokumentwerte(i).name = name Or aDokumentwerte(i).name = Techname Then
|
||||
Return x
|
||||
objRet.name = x.name
|
||||
objRet.value = x.value
|
||||
End If
|
||||
Next
|
||||
Return objRet
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
'20080401 RGL Funktion zum Löschen der Werte, damit nicht 2x abgefüllt (auch bei manuellem Erstellen)
|
||||
Public Sub clearAvaloqDokumentWerte()
|
||||
arrDoukmentWerte.Clear()
|
||||
End Sub
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
34
EDOKA/Utils/Crypto.vb
Normal file
34
EDOKA/Utils/Crypto.vb
Normal file
@@ -0,0 +1,34 @@
|
||||
Module Crypto
|
||||
Public Function EncryptText(ByVal strText As String, ByVal strPwd As String)
|
||||
Dim i As Integer, c As Integer
|
||||
Dim strBuff As String
|
||||
|
||||
strPwd = UCase$(strPwd)
|
||||
If Len(strPwd) Then
|
||||
For i = 1 To Len(strText)
|
||||
c = Asc(Mid$(strText, i, 1))
|
||||
c = c + Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
|
||||
strBuff = strBuff & Chr(c And &HFF)
|
||||
Next i
|
||||
Else
|
||||
strBuff = strText
|
||||
End If
|
||||
EncryptText = strBuff
|
||||
End Function
|
||||
|
||||
Public Function DecryptText(ByVal strText As String, ByVal strPwd As String)
|
||||
Dim i As Integer, c As Integer
|
||||
Dim strBuff As String
|
||||
strPwd = UCase$(strPwd)
|
||||
If Len(strPwd) Then
|
||||
For i = 1 To Len(strText)
|
||||
c = Asc(Mid$(strText, i, 1))
|
||||
c = c - Asc(Mid$(strPwd, (i Mod Len(strPwd)) + 1, 1))
|
||||
strBuff = strBuff & Chr(c And &HFF)
|
||||
Next i
|
||||
Else
|
||||
strBuff = strText
|
||||
End If
|
||||
DecryptText = strBuff
|
||||
End Function
|
||||
End Module
|
||||
3033
EDOKA/Utils/DivFnkt.vb
Normal file
3033
EDOKA/Utils/DivFnkt.vb
Normal file
File diff suppressed because it is too large
Load Diff
673
EDOKA/Utils/DocMgmt.vb
Normal file
673
EDOKA/Utils/DocMgmt.vb
Normal file
@@ -0,0 +1,673 @@
|
||||
'DocMgmt Klasse
|
||||
'Autor: Stefan Hutter, Unternehmensberatung
|
||||
'
|
||||
'01.04.2003
|
||||
'
|
||||
Imports System
|
||||
Imports System.IO
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.ComponentModel
|
||||
Imports UtilityLibrary.Win32
|
||||
|
||||
Public Class DocMgmt
|
||||
|
||||
#Region "Deklarationen"
|
||||
Dim m_dokumentname As String
|
||||
Dim m_dokumentid As String
|
||||
|
||||
Property Dokumentname() As String
|
||||
Get
|
||||
Return m_dokumentname
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_dokumentname = Value
|
||||
End Set
|
||||
End Property
|
||||
Property DokumentID() As String
|
||||
Get
|
||||
Return m_dokumentid
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_dokumentid = Value
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
|
||||
#Region "Save"
|
||||
Public Function Save_To_DB(ByVal sDokumentID As String, ByVal sDokumentName As String) As Boolean
|
||||
Try
|
||||
Me.DokumentID = sDokumentID
|
||||
Me.Dokumentname = sDokumentName
|
||||
|
||||
Dim Connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select * from doks where dokumentid='" + Me.DokumentID + "'", Connection)
|
||||
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim fs As New FileStream(Me.Dokumentname, FileMode.Open, FileAccess.Read)
|
||||
Dim mydata(fs.Length) As Byte
|
||||
Try
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Dokument von Filesystem lesen")
|
||||
fs.Read(mydata, 0, fs.Length)
|
||||
fs.Close()
|
||||
Connection.ConnectionString = Globals.sConnectionString
|
||||
Connection.Open()
|
||||
DA.Fill(ds, "docs")
|
||||
Dim myRow As DataRow
|
||||
If ds.Tables(0).Rows.Count = 0 Then
|
||||
' Neues Dokument speichern
|
||||
myRow = ds.Tables(0).NewRow
|
||||
myRow.Item(0) = Me.DokumentID
|
||||
myRow.Item(1) = mydata
|
||||
'Release Office 2010
|
||||
'Try
|
||||
' Dim fi As New FileInfo(Me.Dokumentname)
|
||||
' myRow.Item(2) = fi.Extension
|
||||
' fi = Nothing
|
||||
'Catch ex As Exception
|
||||
|
||||
'End Try
|
||||
ds.Tables(0).Rows.Add(myRow)
|
||||
DA.Update(ds, "docs")
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Neues Dokument gespeichert")
|
||||
Else
|
||||
'Bestehendes Dokument sichenr
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
myRow.Item(1) = mydata
|
||||
'Try
|
||||
' Dim fi As New FileInfo(Me.Dokumentname)
|
||||
' myRow.Item(2) = fi.Extension
|
||||
' fi = Nothing
|
||||
'Catch ex As Exception
|
||||
|
||||
'End Try
|
||||
|
||||
DA.Update(ds, "docs")
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Bestehendes Dokument ersetzt")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Fehler bei der Dokumentspeicherung")
|
||||
MyMsg.show_standardmessage(86, MsgBoxStyle.Critical)
|
||||
' MsgBox(ex.Message)
|
||||
Return False
|
||||
End Try
|
||||
fs = Nothing
|
||||
cb = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
|
||||
Connection.Close()
|
||||
Connection = Nothing
|
||||
Return True
|
||||
Catch EX As Exception
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Fehler bei der Dokumentspeicherung")
|
||||
MyMsg.show_standardmessage(86, MsgBoxStyle.Critical)
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function Save_Layout_DB(ByVal profilnr As Integer, ByVal sDokumentName As String) As Boolean
|
||||
Dim Connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select * from profillayout where profilnr=" + Str(profilnr), Connection)
|
||||
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim fs As New FileStream(sDokumentName, FileMode.OpenOrCreate, FileAccess.Read)
|
||||
Dim mydata(fs.Length) As Byte
|
||||
fs.Read(mydata, 0, fs.Length)
|
||||
fs.Close()
|
||||
Try
|
||||
Connection.ConnectionString = Globals.sConnectionString
|
||||
Connection.Open()
|
||||
DA.Fill(ds, "profil")
|
||||
Dim myRow As DataRow
|
||||
If ds.Tables(0).Rows.Count = 0 Then
|
||||
' Neues Dokument speichern
|
||||
myRow = ds.Tables(0).NewRow
|
||||
myRow.Item(0) = profilnr
|
||||
'***********************************
|
||||
'Je nach Layoutfile, Daten aus entsprechendem Feld lesen
|
||||
'29.7.2004 / SHU
|
||||
'***********************************
|
||||
Select Case UCase(Right(sDokumentName, 5))
|
||||
Case "T.LYT"
|
||||
myRow.Item(2) = mydata
|
||||
Case "M.LYT"
|
||||
myRow.Item(3) = mydata
|
||||
Case "V.LYT"
|
||||
myRow.Item(4) = mydata
|
||||
Case Else
|
||||
myRow.Item(1) = mydata
|
||||
End Select
|
||||
ds.Tables(0).Rows.Add(myRow)
|
||||
DA.Update(ds, "profil")
|
||||
Else
|
||||
'Bestehendes Dokument sichern
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
'***********************************
|
||||
'Je nach Layoutfile, Daten aus entsprechendem Feld lesen
|
||||
'29.7.2004 / SHU
|
||||
'***********************************
|
||||
Select Case UCase(Right(sDokumentName, 5))
|
||||
Case "T.LYT"
|
||||
myRow.Item(2) = mydata
|
||||
Case "M.LYT"
|
||||
myRow.Item(3) = mydata
|
||||
Case "V.LYT"
|
||||
myRow.Item(4) = mydata
|
||||
Case Else
|
||||
myRow.Item(1) = mydata
|
||||
End Select
|
||||
DA.Update(ds, "profil")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Return False
|
||||
End Try
|
||||
fs = Nothing
|
||||
cb = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
|
||||
Connection.Close()
|
||||
Connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
Public Function Save_SuchLayout_DB(ByVal profilnr As Integer, ByVal sDokumentName As String) As Boolean
|
||||
Dim Connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select * from suchprofillayout where suchprofilnr=" + Str(profilnr), Connection)
|
||||
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim fs As New FileStream(sDokumentName, FileMode.OpenOrCreate, FileAccess.Read)
|
||||
Dim mydata(fs.Length) As Byte
|
||||
fs.Read(mydata, 0, fs.Length)
|
||||
fs.Close()
|
||||
Try
|
||||
Connection.ConnectionString = Globals.sConnectionString
|
||||
Connection.Open()
|
||||
DA.Fill(ds, "profil")
|
||||
Dim myRow As DataRow
|
||||
If ds.Tables(0).Rows.Count = 0 Then
|
||||
' Neues Dokument speichern
|
||||
myRow = ds.Tables(0).NewRow
|
||||
myRow.Item(0) = profilnr
|
||||
'***********************************
|
||||
'Je nach Layoutfile, Daten aus entsprechendem Feld lesen
|
||||
'29.7.2004 / SHU
|
||||
'***********************************
|
||||
Select Case UCase(Right(sDokumentName, 6))
|
||||
Case "TS.LYT"
|
||||
myRow.Item(2) = mydata
|
||||
Case "MS.LYT"
|
||||
myRow.Item(3) = mydata
|
||||
Case "VS.LYT"
|
||||
myRow.Item(4) = mydata
|
||||
Case Else
|
||||
myRow.Item(1) = mydata
|
||||
End Select
|
||||
ds.Tables(0).Rows.Add(myRow)
|
||||
DA.Update(ds, "profil")
|
||||
Else
|
||||
'Bestehendes Dokument sichern
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
'***********************************
|
||||
'Je nach Layoutfile, Daten aus entsprechendem Feld lesen
|
||||
'29.7.2004 / SHU
|
||||
'***********************************
|
||||
Select Case UCase(Right(sDokumentName, 6))
|
||||
Case "TS.LYT"
|
||||
myRow.Item(2) = mydata
|
||||
Case "MS.LYT"
|
||||
myRow.Item(3) = mydata
|
||||
Case "VS.LYT"
|
||||
myRow.Item(4) = mydata
|
||||
Case Else
|
||||
myRow.Item(1) = mydata
|
||||
End Select
|
||||
DA.Update(ds, "profil")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Return False
|
||||
End Try
|
||||
fs = Nothing
|
||||
cb = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
|
||||
Connection.Close()
|
||||
Connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Get"
|
||||
Public Function Get_From_DB(ByVal sDokumentID As String, ByVal sDokumentName As String, Optional ByRef DokType As String = "") As Boolean
|
||||
Me.DokumentID = sDokumentID
|
||||
Me.Dokumentname = sDokumentName
|
||||
|
||||
Dim connection As New SqlConnection()
|
||||
Dim da As New SqlDataAdapter("Select * From doks where DokumentID='" + Me.DokumentID + "'", connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
|
||||
Dim ds As New DataSet()
|
||||
|
||||
Try
|
||||
'Connectionstring zur Datenbank
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
da.Fill(ds, "docs")
|
||||
|
||||
'Versuchen, ob es sich um ein EDKIMP-Dokument handelt - Rel. 3.73 SHU
|
||||
If ds.Tables(0).Rows.Count = 0 Then
|
||||
da.SelectCommand.CommandText = "Select * from doks where dokumentid='" + "EDKIMP" + Microsoft.VisualBasic.Right(Me.DokumentID, Len(Me.DokumentID) - 6) + "'"
|
||||
da.Fill(ds, "Docs")
|
||||
End If
|
||||
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
MyData = myRow.Item(1)
|
||||
'If myRow.Item(2).ToString = "" Then DokType = ".doc" Else DokType = myRow.Item(2)
|
||||
Dim K As Long
|
||||
K = UBound(MyData)
|
||||
Dim fs As New FileStream(sDokumentName, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs.Write(MyData, 0, K)
|
||||
fs.Close()
|
||||
fs = Nothing
|
||||
Catch ex As Exception
|
||||
If Not DivFnkt.isbck(Me.DokumentID) And Not DivFnkt.BDR_Dokument(Me.DokumentID) Then
|
||||
MyMsg.show_standardmessage(93, MsgBoxStyle.Critical)
|
||||
End If
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
da = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
Public Function Get_layout_from_DB(ByVal profilnr As Integer, ByVal sdokumentname As String) As String
|
||||
Me.Dokumentname = LTrim(Str(profilnr)) + ".lyt"
|
||||
Dim connection As New SqlConnection()
|
||||
Dim da As New SqlDataAdapter("Select * From profillayout where profilnr=" + Str(profilnr), connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
|
||||
Dim ds As New DataSet()
|
||||
Try
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
da.Fill(ds, "docs")
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
'***********************************
|
||||
'Je nach Layoutfile, Daten aus entsprechendem Feld lesen
|
||||
'29.7.2004 / SHU
|
||||
'***********************************
|
||||
Select Case UCase(Right(sdokumentname, 5))
|
||||
Case "T.LYT"
|
||||
MyData = myRow.Item(2)
|
||||
Case "M.LYT"
|
||||
MyData = myRow.Item(3)
|
||||
Case "V.LYT"
|
||||
MyData = myRow.Item(4)
|
||||
Case Else
|
||||
MyData = myRow.Item(1)
|
||||
End Select
|
||||
|
||||
Dim K As Long
|
||||
K = UBound(MyData)
|
||||
Dim fs As New FileStream(sdokumentname, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs.Write(MyData, 0, K)
|
||||
fs.Close()
|
||||
fs = Nothing
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
da = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
Public Function Get_suchlayout_from_DB(ByVal profilnr As Integer, ByVal sdokumentname As String) As String
|
||||
Me.Dokumentname = LTrim(Str(profilnr)) + ".lyt"
|
||||
Dim connection As New SqlConnection()
|
||||
Dim da As New SqlDataAdapter("Select * From suchprofillayout where suchprofilnr=" + Str(profilnr), connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
|
||||
Dim ds As New DataSet()
|
||||
Try
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
da.Fill(ds, "docs")
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
'***********************************
|
||||
'Je nach Layoutfile, Daten aus entsprechendem Feld lesen
|
||||
'29.7.2004 / SHU
|
||||
'***********************************
|
||||
Select Case UCase(Right(sdokumentname, 6))
|
||||
Case "TS.LYT"
|
||||
MyData = myRow.Item(2)
|
||||
Case "MS.LYT"
|
||||
MyData = myRow.Item(3)
|
||||
Case "VS.LYT"
|
||||
MyData = myRow.Item(4)
|
||||
Case Else
|
||||
MyData = myRow.Item(1)
|
||||
End Select
|
||||
|
||||
|
||||
Dim K As Long
|
||||
K = UBound(MyData)
|
||||
Dim fs As New FileStream(sdokumentname, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs.Write(MyData, 0, K)
|
||||
fs.Close()
|
||||
fs = Nothing
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
da = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "CheckDoc"
|
||||
Public Function check_doc(ByVal fnkt As Integer) As DataTable
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_check_dok"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
|
||||
' scmCmdToExecute.Parameters.Add(New SqlParameter("@stationsname", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Environ("Computername")))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
Throw New Exception("Check_Doc::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
sdaAdapter.Dispose()
|
||||
scmCmdToExecute.Dispose()
|
||||
dtToReturn.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Office 2010"
|
||||
Public Function get_office_2010_XML_File(ByVal sdokumentname As String)
|
||||
Dim connection As New SqlConnection()
|
||||
Try
|
||||
If System.IO.File.Exists(sdokumentname) Then
|
||||
System.IO.File.Delete(sdokumentname)
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
|
||||
Dim da As New SqlDataAdapter("Select * From Office_2010_Params where nreintrag=1", connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
|
||||
Dim ds As New DataSet()
|
||||
Try
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
da.Fill(ds, "docs")
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
MyData = myRow.Item(2)
|
||||
|
||||
Dim K As Long
|
||||
K = UBound(MyData)
|
||||
Dim fs As New FileStream(sdokumentname, FileMode.Create, FileAccess.Write)
|
||||
fs.Write(MyData, 0, K)
|
||||
fs.Close()
|
||||
fs = Nothing
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
da = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "AVQ_Werte"
|
||||
Public Function save_avq_werte_to_db(ByVal filename As String, dpinszanz As Integer)
|
||||
Dim Connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select * from edex_dpinstanz_avqwerte where edex_dp_instanznr=" + Str(dpinszanz), Connection)
|
||||
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read)
|
||||
Dim mydata(fs.Length) As Byte
|
||||
fs.Read(mydata, 0, fs.Length)
|
||||
fs.Close()
|
||||
Try
|
||||
Connection.ConnectionString = Globals.sConnectionString
|
||||
Connection.Open()
|
||||
DA.Fill(ds, "profil")
|
||||
Dim myRow As DataRow
|
||||
If ds.Tables(0).Rows.Count = 0 Then
|
||||
myRow = ds.Tables(0).NewRow
|
||||
myRow.Item(0) = dpinszanz
|
||||
myRow.Item(1) = mydata
|
||||
ds.Tables(0).Rows.Add(myRow)
|
||||
DA.Update(ds, "profil")
|
||||
Else
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
myRow.Item(1) = mydata
|
||||
DA.Update(ds, "profil")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Return False
|
||||
End Try
|
||||
fs = Nothing
|
||||
cb = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
|
||||
Connection.Close()
|
||||
Connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
Public Function Get_avq_werte_from_db(ByVal filename As String, ByVal dpinstanz As Integer) As Boolean
|
||||
Dim connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select * from edex_dpinstanz_avqwerte where edex_dp_instanznr=" + Str(dpinstanz), connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
|
||||
Try
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
DA.Fill(ds, "docs")
|
||||
If ds.Tables(0).Rows.Count < 1 Then Return False
|
||||
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
MyData = myRow.Item(1)
|
||||
'If myRow.Item(2).ToString = "" Then DokType = ".doc" Else DokType = myRow.Item(2)
|
||||
Dim K As Long
|
||||
K = UBound(MyData)
|
||||
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs.Write(MyData, 0, K)
|
||||
fs.Close()
|
||||
fs = Nothing
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "PDFCheck"
|
||||
Dim tmpkey As String = ""
|
||||
Public Function Check_PDF(filename As String) As Boolean
|
||||
If Save_PDF_To_DB(filename) = False Then
|
||||
Return False
|
||||
End If
|
||||
If Get_PDF_From_DB() = False Then
|
||||
Return False
|
||||
End If
|
||||
Dim i As Integer
|
||||
|
||||
Dim fn As String = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + tmpkey + ".pdf"
|
||||
Dim info As New System.IO.FileInfo(fn)
|
||||
i = info.Length
|
||||
Try
|
||||
File.Delete(fn)
|
||||
Delete_PDF_From_DB()
|
||||
|
||||
Catch ex As Exception
|
||||
|
||||
End Try
|
||||
If i < 1 Then Return False
|
||||
Return True
|
||||
|
||||
End Function
|
||||
Public Function Save_PDF_To_DB(ByVal sDokumentName As String) As Boolean
|
||||
Try
|
||||
Me.Dokumentname = sDokumentName
|
||||
tmpkey = Guid.NewGuid.ToString
|
||||
Dim Connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select top 1 * from tmpdok where tmpkey='" + tmpkey + "'", Connection)
|
||||
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim fs As New FileStream(Me.Dokumentname, FileMode.Open, FileAccess.Read)
|
||||
Dim mydata(fs.Length) As Byte
|
||||
Try
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Dokument von Filesystem lesen")
|
||||
fs.Read(mydata, 0, fs.Length)
|
||||
fs.Close()
|
||||
Connection.ConnectionString = Globals.sConnectionString
|
||||
Connection.Open()
|
||||
DA.Fill(ds, "tmpdocs")
|
||||
Dim myRow As DataRow
|
||||
If ds.Tables(0).Rows.Count = 0 Then
|
||||
' Neues Dokument speichern
|
||||
myRow = ds.Tables(0).NewRow
|
||||
myRow.Item(0) = tmpkey
|
||||
myRow.Item(1) = mydata
|
||||
|
||||
ds.Tables(0).Rows.Add(myRow)
|
||||
DA.Update(ds, "tmpdocs")
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Neues Dokument gespeichert")
|
||||
Else
|
||||
'Bestehendes Dokument sichenr
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
myRow.Item(1) = mydata
|
||||
'Try
|
||||
' Dim fi As New FileInfo(Me.Dokumentname)
|
||||
' myRow.Item(2) = fi.Extension
|
||||
' fi = Nothing
|
||||
'Catch ex As Exception
|
||||
|
||||
'End Try
|
||||
|
||||
DA.Update(ds, "tmpdocs")
|
||||
Globals.PerfMon.insert_entry(Me.DokumentID + " ---- Bestehendes Dokument ersetzt")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
fs = Nothing
|
||||
cb = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
|
||||
Connection.Close()
|
||||
Connection = Nothing
|
||||
Return True
|
||||
Catch EX As Exception
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
Public Function Get_PDF_From_DB() As Boolean
|
||||
|
||||
Dim connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select top 1 * from tmpdok where tmpkey='" + tmpkey + "'", connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim filename As String = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + tmpkey + ".pdf"
|
||||
Try
|
||||
'Connectionstring zur Datenbank
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
DA.Fill(ds, "tmpdocs")
|
||||
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
MyData = myRow.Item(1)
|
||||
'If myRow.Item(2).ToString = "" Then DokType = ".doc" Else DokType = myRow.Item(2)
|
||||
Dim K As Long
|
||||
K = UBound(MyData)
|
||||
Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs.Write(MyData, 0, K)
|
||||
fs.Close()
|
||||
fs = Nothing
|
||||
Catch ex As Exception
|
||||
If Not DivFnkt.isbck(Me.DokumentID) And Not DivFnkt.BDR_Dokument(Me.DokumentID) Then
|
||||
MyMsg.show_standardmessage(93, MsgBoxStyle.Critical)
|
||||
End If
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
da = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
Public Function Delete_PDF_From_DB()
|
||||
Dim connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("delete from tmpdok where tmpkey='" + tmpkey + "'", connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Try
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
DA.Fill(ds, "tmpdocs")
|
||||
Catch ex As Exception
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
#End Region
|
||||
|
||||
|
||||
|
||||
End Class
|
||||
|
||||
37
EDOKA/Utils/DokumentPruefung.Designer.vb
generated
Normal file
37
EDOKA/Utils/DokumentPruefung.Designer.vb
generated
Normal file
@@ -0,0 +1,37 @@
|
||||
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
|
||||
Partial Class DokumentPruefung
|
||||
Inherits System.Windows.Forms.Form
|
||||
|
||||
'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen.
|
||||
<System.Diagnostics.DebuggerNonUserCode()> _
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
Try
|
||||
If disposing AndAlso components IsNot Nothing Then
|
||||
components.Dispose()
|
||||
End If
|
||||
Finally
|
||||
MyBase.Dispose(disposing)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'Wird vom Windows Form-Designer benötigt.
|
||||
Private components As System.ComponentModel.IContainer
|
||||
|
||||
'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich.
|
||||
'Das Bearbeiten ist mit dem Windows Form-Designer möglich.
|
||||
'Das Bearbeiten mit dem Code-Editor ist nicht möglich.
|
||||
<System.Diagnostics.DebuggerStepThrough()> _
|
||||
Private Sub InitializeComponent()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'DokumentPruefung
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(991, 325)
|
||||
Me.Name = "DokumentPruefung"
|
||||
Me.Text = "DokumentPruefung"
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
End Class
|
||||
120
EDOKA/Utils/DokumentPruefung.resx
Normal file
120
EDOKA/Utils/DokumentPruefung.resx
Normal file
@@ -0,0 +1,120 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<root>
|
||||
<!--
|
||||
Microsoft ResX Schema
|
||||
|
||||
Version 2.0
|
||||
|
||||
The primary goals of this format is to allow a simple XML format
|
||||
that is mostly human readable. The generation and parsing of the
|
||||
various data types are done through the TypeConverter classes
|
||||
associated with the data types.
|
||||
|
||||
Example:
|
||||
|
||||
... ado.net/XML headers & schema ...
|
||||
<resheader name="resmimetype">text/microsoft-resx</resheader>
|
||||
<resheader name="version">2.0</resheader>
|
||||
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
|
||||
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
|
||||
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
|
||||
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
|
||||
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
<value>[base64 mime encoded serialized .NET Framework object]</value>
|
||||
</data>
|
||||
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
|
||||
<comment>This is a comment</comment>
|
||||
</data>
|
||||
|
||||
There are any number of "resheader" rows that contain simple
|
||||
name/value pairs.
|
||||
|
||||
Each data row contains a name, and value. The row also contains a
|
||||
type or mimetype. Type corresponds to a .NET class that support
|
||||
text/value conversion through the TypeConverter architecture.
|
||||
Classes that don't support this are serialized and stored with the
|
||||
mimetype set.
|
||||
|
||||
The mimetype is used for serialized objects, and tells the
|
||||
ResXResourceReader how to depersist the object. This is currently not
|
||||
extensible. For a given mimetype the value must be set accordingly:
|
||||
|
||||
Note - application/x-microsoft.net.object.binary.base64 is the format
|
||||
that the ResXResourceWriter will generate, however the reader can
|
||||
read any of the formats listed below.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.binary.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.soap.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.bytearray.base64
|
||||
value : The object must be serialized into a byte array
|
||||
: using a System.ComponentModel.TypeConverter
|
||||
: and then encoded with base64 encoding.
|
||||
-->
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="metadata">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" use="required" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
<xsd:attribute ref="xml:space" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="assembly">
|
||||
<xsd:complexType>
|
||||
<xsd:attribute name="alias" type="xsd:string" />
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
|
||||
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
|
||||
<xsd:attribute ref="xml:space" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="resmimetype">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="version">
|
||||
<value>2.0</value>
|
||||
</resheader>
|
||||
<resheader name="reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
</root>
|
||||
90
EDOKA/Utils/DokumentPruefung.vb
Normal file
90
EDOKA/Utils/DokumentPruefung.vb
Normal file
@@ -0,0 +1,90 @@
|
||||
Public Class DokumentPruefung
|
||||
Private Sub DokumentPruefung_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
||||
|
||||
End Sub
|
||||
|
||||
Public Function Check_Olib()
|
||||
Dim Filepath As String = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente")
|
||||
|
||||
Dim Files() As String = System.IO.Directory.GetFiles(Filepath, "*.olib")
|
||||
For Each file As String In Files
|
||||
Get_Olib_Data(file)
|
||||
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Function Get_Olib_Data(ByVal Filename As String)
|
||||
Dim ds As New DataSet
|
||||
ds.ReadXml(Filename)
|
||||
restart_dokumentbearbeitung(ds, Filename)
|
||||
End Function
|
||||
|
||||
Public Sub Get_Olib_Table(ByRef olibdata As DataSet, ByRef Table As DataTable, ByRef Tablename As String)
|
||||
Try
|
||||
Table = olibdata.Tables(Tablename)
|
||||
If Table Is Nothing Then
|
||||
Dim d As New DataTable
|
||||
Table = d.Copy
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Dim d As New DataTable
|
||||
Table = d.Copy
|
||||
End Try
|
||||
End Sub
|
||||
Public Sub restart_dokumentbearbeitung(ByVal olibdata As DataSet, ByVal filename As String)
|
||||
If System.IO.File.Exists(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + olibdata.Tables("Save_Dokument").Rows(0).Item("dokumentname")) Then
|
||||
Else
|
||||
MsgBox("Das Office-Dokument ist nicht vorhanden")
|
||||
Exit Sub
|
||||
End If
|
||||
Dim wlib As New WordLib
|
||||
wlib.save_historystatus = olibdata.Tables("Allgemein").Rows(0).Item("save_historystatus")
|
||||
wlib.save_historystatusbr = olibdata.Tables("Allgemein").Rows(0).Item("save_historystatusbr")
|
||||
wlib.DokumentID = olibdata.Tables("Allgemein").Rows(0).Item("dokumentid")
|
||||
wlib.CreateDoc = olibdata.Tables("Allgemein").Rows(0).Item("CreateDoc")
|
||||
wlib.Dokumentidbr = olibdata.Tables("Allgemein").Rows(0).Item("Dokumentidbr")
|
||||
wlib.Dokumentcoldindex_Changed = olibdata.Tables("Allgemein").Rows(0).Item("Dokumentcoldindex_Changed")
|
||||
wlib.dokumentid_changed = olibdata.Tables("Allgemein").Rows(0).Item("dokumentid_changed")
|
||||
wlib.dokumentid_changed = olibdata.Tables("Allgemein").Rows(0).Item("dokumentid_changed")
|
||||
wlib.Dokumentcoldindex_changedbr = olibdata.Tables("Allgemein").Rows(0).Item("Dokumentcoldindex_Changedbr")
|
||||
wlib.dokumentid_changedbr = olibdata.Tables("Allgemein").Rows(0).Item("dokumentid_changedbr")
|
||||
|
||||
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokument, "Save_Dokument")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Notizen, "Save_Notizen")
|
||||
Get_Olib_Table(olibdata, wlib.Save_ColdIndex, "Save_Coldindex")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentwerte, "Save_Dokumentwerte")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentzuordnungen, "Save_Dokumentzuordnungen")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentinfomeldungen, "Save_Dokumentinfomeldung")
|
||||
Get_Olib_Table(olibdata, wlib.Save_DokumentFunktionen, "Save_Dokumentfunktionen")
|
||||
Get_Olib_Table(olibdata, wlib.save_dokumentersetzen, "Save_Dokumentersetzen")
|
||||
Get_Olib_Table(olibdata, wlib.save_dokumentcoldindex, "Save_Dokumentcoldindex")
|
||||
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentbr, "Save_Dokumentbr")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Notizenbr, "Save_Notizenbr")
|
||||
Get_Olib_Table(olibdata, wlib.Save_ColdIndexbr, "Save_Coldindexbr")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentwertebr, "Save_Dokumentwertebr")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentzuordnungenbr, "Save_Dokumentzuordnungenvr")
|
||||
Get_Olib_Table(olibdata, wlib.Save_Dokumentinfomeldungenbr, "Save_Dokumentinfomeldungenbr")
|
||||
Get_Olib_Table(olibdata, wlib.Save_DokumentFunktionenbr, "Save_Dokumentfunktionenbr")
|
||||
Get_Olib_Table(olibdata, wlib.save_dokumentersetzenbr, "Save_Dokumentersetzenbr")
|
||||
Get_Olib_Table(olibdata, wlib.save_dokumentcoldindexbr, "Save_Dokumentcoldindexbr")
|
||||
|
||||
Select Case olibdata.Tables("Allgemein").Rows(0).Item("Applicationtype")
|
||||
Case 1
|
||||
wlib.Dokumentfilename = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + olibdata.Tables("Save_Dokument").Rows(0).Item("dokumentname")
|
||||
wlib.StartWord()
|
||||
wlib.LoadWord(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + olibdata.Tables("Save_Dokument").Rows(0).Item("dokumentname"))
|
||||
System.IO.File.Delete(filename)
|
||||
Case 2
|
||||
wlib.Dokumentfilename = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + olibdata.Tables("Save_Dokument").Rows(0).Item("dokumentname")
|
||||
wlib.StartExcel()
|
||||
wlib.LoadExcel(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + olibdata.Tables("Save_Dokument").Rows(0).Item("dokumentname"))
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
152
EDOKA/Utils/EdokaUpdate.vb
Normal file
152
EDOKA/Utils/EdokaUpdate.vb
Normal file
@@ -0,0 +1,152 @@
|
||||
'DocMgmt Klasse
|
||||
'Autor: Stefan Hutter, Unternehmensberatung
|
||||
'
|
||||
'01.04.2003
|
||||
'
|
||||
Imports System
|
||||
Imports System.IO
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.ComponentModel
|
||||
Imports UtilityLibrary.Win32
|
||||
|
||||
Public Class EdokaUpd
|
||||
|
||||
#Region "Deklarationen"
|
||||
Dim m_FileToRun
|
||||
Property FileToRun()
|
||||
Get
|
||||
Return m_FileToRun
|
||||
End Get
|
||||
Set(ByVal Value)
|
||||
m_FileToRun = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_file1 As String
|
||||
Property File1() As String
|
||||
Get
|
||||
Return m_file1
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_file1 = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property m_file2() As String
|
||||
Get
|
||||
Return m_file2
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_file2 = Value
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
|
||||
#Region "Save"
|
||||
Public Function Save_To_DB(ByVal filename1 As String, ByVal filename2 As String, ByVal filetorun As String)
|
||||
|
||||
Dim Connection As New SqlConnection()
|
||||
Dim DA As New SqlDataAdapter("select * from edokaupdate", Connection)
|
||||
Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA)
|
||||
Dim ds As New DataSet()
|
||||
Dim fs1 As New FileStream(filename1, FileMode.OpenOrCreate, FileAccess.Read)
|
||||
Dim fs2 As New FileStream(filename2, FileMode.OpenOrCreate, FileAccess.Read)
|
||||
Dim mydata(fs1.Length) As Byte
|
||||
Dim mydata1(fs2.Length) As Byte
|
||||
|
||||
fs1.Read(mydata, 0, fs1.Length)
|
||||
fs1.Close()
|
||||
|
||||
fs2.Read(mydata1, 0, fs2.Length)
|
||||
fs2.Close()
|
||||
Try
|
||||
'Connectionstring zur Datenbank
|
||||
Connection.ConnectionString = Globals.sConnectionString
|
||||
Connection.Open()
|
||||
DA.Fill(ds, "edokaupdate")
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
myRow.Item(0) = mydata
|
||||
myRow.Item(1) = mydata1
|
||||
myRow.Item(2) = filetorun
|
||||
DA.Update(ds, "edokaupdate")
|
||||
Catch ex As Exception
|
||||
MsgBox("Automatischer Update von EDOKA kann nicht ausgeführt werden." & vbCrLf & ex.Message)
|
||||
Return False
|
||||
End Try
|
||||
fs1 = Nothing
|
||||
fs2 = Nothing
|
||||
cb = Nothing
|
||||
ds = Nothing
|
||||
DA = Nothing
|
||||
|
||||
Connection.Close()
|
||||
Connection = Nothing
|
||||
Return True
|
||||
End Function
|
||||
#End Region
|
||||
|
||||
#Region "Get"
|
||||
|
||||
Public Function Get_From_DB(ByVal filename1 As String, ByVal filename2 As String, ByVal filetorun As String) As String
|
||||
Dim connection As New SqlConnection()
|
||||
Dim da As New SqlDataAdapter("Select * From edokaupdate", connection)
|
||||
Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da)
|
||||
Dim ds As New DataSet()
|
||||
Get_From_DB = ""
|
||||
Try
|
||||
'Connectionstring zur Datenbank
|
||||
connection.ConnectionString = Globals.sConnectionString
|
||||
connection.Open()
|
||||
da.Fill(ds, "edokaupdate")
|
||||
Dim myRow As DataRow
|
||||
myRow = ds.Tables(0).Rows(0)
|
||||
Dim MyData() As Byte
|
||||
MyData = myRow.Item(0)
|
||||
Dim MyData1() As Byte
|
||||
MyData1 = myRow.Item(1)
|
||||
Dim K As Long
|
||||
Dim k1 As Long
|
||||
K = UBound(MyData)
|
||||
k1 = UBound(MyData1)
|
||||
|
||||
Dim fs1 As New FileStream(filename1, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs1.Write(MyData, 0, K)
|
||||
fs1.Close()
|
||||
fs1 = Nothing
|
||||
|
||||
Dim fs2 As New FileStream(filename2, FileMode.OpenOrCreate, FileAccess.Write)
|
||||
fs2.Write(MyData1, 0, k1)
|
||||
fs2.Close()
|
||||
fs2 = Nothing
|
||||
|
||||
Me.FileToRun = myRow.Item(2)
|
||||
Return Me.FileToRun
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
CB = Nothing
|
||||
ds = Nothing
|
||||
da = Nothing
|
||||
connection.Close()
|
||||
connection = Nothing
|
||||
Return True
|
||||
|
||||
End Function
|
||||
#End Region
|
||||
|
||||
#Region "Start"
|
||||
Public Function PrepareUpdate() As String
|
||||
Dim file1 As String
|
||||
Dim file2 As String
|
||||
Dim filetorun As String
|
||||
Me.Get_From_DB(DivFnkt.Get_Filename("EdokaUpdate.dat", ""), DivFnkt.Get_Filename("UpdateEdoka.cmd", ""), filetorun)
|
||||
Return Me.FileToRun
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
End Class
|
||||
11
EDOKA/Utils/GenericEventhandler.vb
Normal file
11
EDOKA/Utils/GenericEventhandler.vb
Normal file
@@ -0,0 +1,11 @@
|
||||
Public Class Generic_Event_Handler
|
||||
|
||||
Public Event Dokument_Dropend(parentid As Integer)
|
||||
|
||||
Public Function Fire_Dokument_Dropend(parentid As Integer)
|
||||
RaiseEvent Dokument_Dropend(parentid)
|
||||
End Function
|
||||
|
||||
End Class
|
||||
|
||||
|
||||
175
EDOKA/Utils/Globals.vb
Normal file
175
EDOKA/Utils/Globals.vb
Normal file
@@ -0,0 +1,175 @@
|
||||
'*
|
||||
' Modul Globals
|
||||
'
|
||||
' Dieses Modul beinhaltet Public Objekte und Variablen, welche während der gesamten
|
||||
' Luafzeit von EDOKA benötigt werden
|
||||
'
|
||||
' Autor: Stefan Hutter
|
||||
' Datum: 2.12.2002
|
||||
'
|
||||
Imports System.Runtime.Remoting.Metadata.W3cXsd2001
|
||||
|
||||
Module Globals
|
||||
'20201022
|
||||
|
||||
|
||||
|
||||
Public WithEvents Generic_Event_Handler As New Generic_Event_Handler
|
||||
'EDOKA-Version
|
||||
Public Version As String = "5.6"
|
||||
Public Versionsdatum As String = "03.05.2022"
|
||||
Public Force_Exit As Boolean = False
|
||||
'Datenbankvariablen
|
||||
Public sConnectionString As String
|
||||
Public Applikationsdaten As DataTable
|
||||
Public AppldataRow As Integer
|
||||
Public conn As New edokaDB.clsConnectionProvider()
|
||||
Public Mitarbeiter As New edokaDB.clsMyMitarbeiter()
|
||||
Public MyMsg As New EDOKA.MyMessage()
|
||||
Public MyTxt As New EDOKA.MyText()
|
||||
Public DivFnkt As New EDOKA.clsDivFnkt()
|
||||
Public Archivfnkt As New EDOKA.clsarchivfnkt()
|
||||
Public Spalten As New DataTable()
|
||||
'Mandanten-Definitionen
|
||||
Public MandantNr As Int32
|
||||
Public MandantText As String
|
||||
Public MitarbeiterNr As Long
|
||||
Public Sprache As Integer
|
||||
Public Words As New Collection()
|
||||
Public Apphandle As Int32
|
||||
Public bckdokument As Boolean
|
||||
Public EinzelDokument As Boolean
|
||||
Public StatusChanges_Dokumentid As String
|
||||
Public StatusChanges_Status As String
|
||||
Public DokumentID_New_Copy As String
|
||||
|
||||
Public CurrentMitarbeiterdata As New DataTable()
|
||||
Public profilnr As Integer
|
||||
Public TGNummer As String
|
||||
|
||||
Public general_dsbr As New DataSet()
|
||||
Public general_ds As New DataSet()
|
||||
Public Dokumentcoldindex_Changed As Boolean
|
||||
Public dokumentcoldindex_status As String
|
||||
Public dokumentid_changed As Boolean
|
||||
Public Dokumentidalt As String
|
||||
Public Ersetzte_Dokumente_Reaktivieren As Boolean
|
||||
|
||||
'Bedingte Retournierung
|
||||
Public DokumentColdIndex_ChangedBR As Boolean
|
||||
Public Dokumentcoldindex_statusbr As String
|
||||
Public dokumentid_changedbr As Boolean
|
||||
Public Dokumentidaltbr As String
|
||||
Public ersetzte_dokumente_reaktivierenbr As Boolean
|
||||
Public DokumentID_New_CopyBR As String
|
||||
|
||||
|
||||
Public WinPos As New WindowPositions()
|
||||
Public Vorlagendata As New DataTable()
|
||||
|
||||
' Dokumentart
|
||||
Public objTreeEntries As New edokaDB.TreeEntries()
|
||||
Public objTreeEntry As New edokaDB.TreeEntry()
|
||||
Public hasmessage As Integer
|
||||
Public Messagecount As Integer = 0
|
||||
|
||||
'Imagelisten
|
||||
Public DokumentartenImages As New ImageList()
|
||||
|
||||
Public SelectedDokumentID As String
|
||||
|
||||
Public ColdMeldung As String
|
||||
Public PerfMon As New clsPerformance()
|
||||
Public DoLog As Boolean = False
|
||||
|
||||
Public stv As Integer
|
||||
Public In_Bearbeitung As Boolean = False
|
||||
Public Vorlagenfilter As Integer = 0
|
||||
Public Save_Partnersuche As New DataTable()
|
||||
Public show_releasenotes As Boolean = False
|
||||
Public Bearbeitung_Problemdokumente As Boolean = False
|
||||
Public Global_ForceExit As Boolean = False
|
||||
|
||||
Public EDOKAMAIN_Statusbar As StatusBar
|
||||
Public EDOKAMAIN_WindowWidth As Integer
|
||||
Public EDOKAMAIN_WindowHeight As Integer
|
||||
|
||||
Public ConnectionFileName As String = ""
|
||||
Public g_bRun As Boolean 'Wird auf true gesetzt, wenn die Applikatin gestartet wird. Verhindert, dass zur Entwicklung der Code durchlaufen wird
|
||||
|
||||
Public HTMLHelp As New HHctrlapi()
|
||||
|
||||
' EDEX_Dokumentpakete
|
||||
Public Vorlagendata_Vollstaendig As New DataTable()
|
||||
Public DokumentPaket As Boolean = False
|
||||
Public Individuelles_Dokumentpaket As Boolean = False
|
||||
Public DP_Collection As New Collection()
|
||||
|
||||
Public DokAnKundeVersant As Boolean = False
|
||||
Public DokAnKundeVersantPruefen As Boolean = False
|
||||
|
||||
Public WordActive As Integer = 0
|
||||
''Public WordHandle As Long
|
||||
|
||||
' Avaloq Schnitstelle zu EDOKA
|
||||
Public objAvaloqDokumentWerte As New AvaloqDokumentWerte()
|
||||
Public objSpooler As frmAvaloqSpooler
|
||||
|
||||
Public CutOverDatum As Date
|
||||
Public SpoolerDir As String
|
||||
Public SpoolerTempDir As String
|
||||
Public DeleteSpoolerFile As Integer
|
||||
Public OutputDir_VorlagenExport As String
|
||||
'Rel. 4.03
|
||||
|
||||
'Office_2010
|
||||
Public Office_2010_Standard_Dokumentviewer As Boolean
|
||||
Public Office_2010_Word_Autoexec As Boolean
|
||||
Public Office_2010_Word_Start_Delay As Integer
|
||||
Public Office_2010_DocView_Nativ As Boolean
|
||||
Public Office_2010_Always_New_Word As Boolean
|
||||
Public Office_2010_Always_New_Excel As Boolean
|
||||
|
||||
Public TempParent As Object = Nothing
|
||||
|
||||
Public Dokument_Importfilename As String = ""
|
||||
|
||||
Public Reset_Printer_Duplex_Settings As Integer = 0
|
||||
Public Duplexmode As String
|
||||
|
||||
'20200901
|
||||
Public wait_after_searchlist As Integer = 0
|
||||
Public try_count_search As Integer = 0
|
||||
Public force_not_found As Boolean = False
|
||||
Public force_not_found_count As Integer = 0
|
||||
Public force_not_found_counter As Integer = 0
|
||||
Public Force_Watch_Message As Boolean = False
|
||||
Public UseOlibFile As Boolean = False
|
||||
Public ProblemDokumentZwingend As Boolean = False
|
||||
Public Wordlib_Sleep As Integer = 400
|
||||
Public Wordlib_Sleep_Savedata As Integer = 600
|
||||
Public Check_Doc_Timer As Integer = 1000
|
||||
Public NewFileWacher As New NewFileCheck
|
||||
#Region " Mehrfachdruck"
|
||||
|
||||
'Public fMehrfachdruck As New frmMehrfachdruck()
|
||||
Public fMehrfachdruck As frmMehrfachdruck
|
||||
Public iMerker As Integer = 0
|
||||
|
||||
Public _HashThreads As New Hashtable()
|
||||
Public _HashDruckanzeige As New Hashtable()
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Office 2016"
|
||||
Public Office2010WatchFIles As New DataTable
|
||||
Public UseOffice2016 As Boolean = False
|
||||
Public Office2016Debug As Boolean = False
|
||||
Public PDFWaitTime As Integer = 600
|
||||
#End Region
|
||||
|
||||
Public Printersettings As New clsprinter
|
||||
Public Connection_Overwritten As Boolean = False
|
||||
|
||||
|
||||
End Module
|
||||
82
EDOKA/Utils/HHctrlapi.vb
Normal file
82
EDOKA/Utils/HHctrlapi.vb
Normal file
@@ -0,0 +1,82 @@
|
||||
Public Class HHctrlapi
|
||||
|
||||
Dim DummyControl As New Control()
|
||||
Dim MyHelpProvider As New HelpProvider()
|
||||
|
||||
Const SW_MAXIMIZE As Integer = 3
|
||||
Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Int32, ByVal ByValnCmdShow As Int32) As Int32
|
||||
|
||||
|
||||
Public Sub New()
|
||||
MyHelpProvider.HelpNamespace = Application.StartupPath + "\EDOKA-Hilfe.chm"
|
||||
End Sub
|
||||
|
||||
Public Function ShowHelpTopic()
|
||||
Help.ShowHelp(DummyControl, MyHelpProvider.HelpNamespace)
|
||||
End Function
|
||||
|
||||
Public Function ShowHelpToc(ByVal context As String)
|
||||
Help.ShowHelp(DummyControl, MyHelpProvider.HelpNamespace, context + ".htm")
|
||||
End Function
|
||||
|
||||
Public Function ShowHelpIndex()
|
||||
Help.ShowHelpIndex(DummyControl, MyHelpProvider.HelpNamespace)
|
||||
End Function
|
||||
|
||||
|
||||
Public Function ShowSearch()
|
||||
Help.ShowHelp(DummyControl, MyHelpProvider.HelpNamespace, HelpNavigator.Find, "")
|
||||
End Function
|
||||
|
||||
'm_pszHelpFilePath = Application.StartupPath + "\benudok.chm"
|
||||
'Dim searchit As HH_FTS_QUERY
|
||||
'searchit.cbStruct = Len(searchit)
|
||||
'searchit.fUniCodeStrings = 0&
|
||||
'searchit.pszSearchQuery = ""
|
||||
'searchit.iProximity = 0&
|
||||
'searchit.fStemmedSearch = 0&
|
||||
'searchit.fTitleOnly = 0&
|
||||
'searchit.fExecute = 0&
|
||||
'searchit.pszWindow = ""
|
||||
'HTMLHelp_Search(0&, m_pszHelpFilePath, HH_DISPLAY_SEARCH, searchit)
|
||||
|
||||
|
||||
'Public Const HH_DISPLAY_TOPIC As Short = &H0 ' select last opened tab, [display a specified topic]
|
||||
'Public Const HH_DISPLAY_TOC As Short = &H1 ' select contents tab, [display a specified topic]
|
||||
'Public Const HH_DISPLAY_INDEX As Short = &H2 ' select index tab and searches for a keyword
|
||||
'Public Const HH_DISPLAY_SEARCH As Short = &H3 ' select search tab and perform a search
|
||||
'Public Const HH_HELP_CONTEXT As Short = &HF ' display mapped numeric value in dwData
|
||||
|
||||
|
||||
'Private Const HH_FTS_DEFAULT_PROXIMITY = (-1)
|
||||
'Public Structure HH_FTS_QUERY
|
||||
' Public cbStruct As Integer ' Sizeof structure in bytes.
|
||||
' Public fUniCodeStrings As Boolean ' TRUE if all strings areunicode.
|
||||
' Public pszSearchQuery As String ' String containing the search query.
|
||||
' Public iProximity As Long ' Word proximity.
|
||||
' Public fStemmedSearch As Boolean ' TRUE for StemmedSearch only.
|
||||
' Public fTitleOnly As Boolean ' TRUE for Title search only.
|
||||
' Public fExecute As Boolean ' TRUE to initiate the search.
|
||||
' Public pszWindow As String ' Window to display in
|
||||
'End Structure
|
||||
|
||||
'Private m_pszHelpFilePath As String
|
||||
|
||||
'<System.Runtime.InteropServices.DllImport("hhctrl.ocx", CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
|
||||
'Public Shared Function HtmlHelp(ByVal hwndCaller As System.Runtime.InteropServices.HandleRef, <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.LPTStr)> ByVal pszFile As String, ByVal uCommand As Int32, ByVal dwData As Int32) As Int32
|
||||
|
||||
'End Function
|
||||
|
||||
'Public Declare Function HTMLHelp_BaseCall Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hWnd As IntPtr, ByVal lpHelpFile As String, ByVal uCommand As Int32, ByVal dwData As Int32) As Int32
|
||||
|
||||
'Public Declare Function HTMLHelp_Search Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByRef dwData As HH_FTS_QUERY) As Int32
|
||||
|
||||
' HTMLHelp_BaseCall(IntPtr.Zero, Application.StartupPath + "\benudok.chm", HH_DISPLAY_TOPIC, 0)
|
||||
|
||||
|
||||
' HTMLHelp_BaseCall(IntPtr.Zero, Application.StartupPath + "\benudok.chm", HH_DISPLAY_INDEX, 0)
|
||||
|
||||
|
||||
|
||||
|
||||
End Class
|
||||
42
EDOKA/Utils/ImageCombobox.resx
Normal file
42
EDOKA/Utils/ImageCombobox.resx
Normal file
@@ -0,0 +1,42 @@
|
||||
<?xml version="1.0" encoding="utf-8" ?>
|
||||
<root>
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="ResMimeType">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="Version">
|
||||
<value>1.0.0.0</value>
|
||||
</resheader>
|
||||
<resheader name="Reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="Writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
</root>
|
||||
176
EDOKA/Utils/ImageCombobox.vb
Normal file
176
EDOKA/Utils/ImageCombobox.vb
Normal file
@@ -0,0 +1,176 @@
|
||||
|
||||
Public Class ImageComboBox
|
||||
Inherits ComboBox
|
||||
|
||||
'internal members for added properties
|
||||
Private _imageList As ImageList
|
||||
Private _imageindexmember As String
|
||||
|
||||
'imagelist to get the images from
|
||||
Public Property ImageList() As ImageList
|
||||
Get
|
||||
Return _imageList
|
||||
End Get
|
||||
Set(ByVal value As ImageList)
|
||||
_imageList = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
'property of the item object that holds the imageindex
|
||||
Public Property ImageIndexMember() As String
|
||||
Get
|
||||
Return _imageindexmember
|
||||
End Get
|
||||
Set(ByVal value As String)
|
||||
_imageindexmember = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Protected Overrides Sub OnDrawItem(ByVal ea As DrawItemEventArgs)
|
||||
'this replaces the normal drawing of the dropdown list
|
||||
ea.DrawBackground()
|
||||
ea.DrawFocusRectangle()
|
||||
|
||||
Dim imageSize As Size = ImageList.ImageSize
|
||||
Dim bounds As Rectangle = ea.Bounds
|
||||
|
||||
Try
|
||||
Dim imageindex As Integer
|
||||
Dim display As String
|
||||
If Items(ea.Index).GetType Is GetType(Data.DataRowView) Then
|
||||
'handle if datarow
|
||||
Dim d As Data.DataRowView = CType(Items(ea.Index), Data.DataRowView)
|
||||
imageindex = CType(d.Item(Me.ImageIndexMember), Integer)
|
||||
display = CType(d.Item(Me.DisplayMember), String)
|
||||
Else
|
||||
'get the imageindex member from the item object
|
||||
imageindex = Items(ea.Index).GetType.GetProperty(Me.ImageIndexMember).GetValue(Items(ea.Index), Nothing)
|
||||
'get the display member from the item object
|
||||
display = Items(ea.Index).GetType.GetProperty(Me.DisplayMember).GetValue(Items(ea.Index), Nothing)
|
||||
End If
|
||||
|
||||
If imageindex <> -1 Then
|
||||
'if the imageindex is set then draw the image
|
||||
ImageList.Draw(ea.Graphics, bounds.Left, bounds.Top, imageindex)
|
||||
ea.Graphics.DrawString(display, ea.Font, New SolidBrush(ea.ForeColor), bounds.Left + imageSize.Width, bounds.Top)
|
||||
Else
|
||||
'no image just do the text
|
||||
ea.Graphics.DrawString(display, ea.Font, New SolidBrush(ea.ForeColor), bounds.Left, bounds.Top)
|
||||
End If
|
||||
Catch e As Exception
|
||||
'handle things like the normal combo and don't use the display or imageindex member properties
|
||||
If ea.Index <> -1 Then
|
||||
ea.Graphics.DrawString(Items(ea.Index).ToString(), ea.Font, New SolidBrush(ea.ForeColor), bounds.Left, bounds.Top)
|
||||
Else
|
||||
ea.Graphics.DrawString(Me.Text, ea.Font, New SolidBrush(ea.ForeColor), bounds.Left, bounds.Top)
|
||||
End If
|
||||
Finally
|
||||
|
||||
MyBase.OnDrawItem(ea)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Public Sub New()
|
||||
'set to ownerdraw
|
||||
Me.DrawMode = DrawMode.OwnerDrawFixed
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByRef cbo As ComboBox)
|
||||
'assign all properties from cbo to me
|
||||
'Dim pi As Reflection.PropertyInfo
|
||||
'For Each pi In cbo.GetType.GetProperties
|
||||
' Dim s As String = pi.Attributes.ToString
|
||||
' If pi.CanWrite Then
|
||||
' 'On Error Resume Next 'just in case
|
||||
' Me.GetType.GetProperty(pi.Name).SetValue(Me, pi.GetValue(cbo, Nothing), Nothing)
|
||||
' End If
|
||||
'Next
|
||||
'TODO: have it consume ALL properties of original combo
|
||||
Me.Anchor = cbo.Anchor
|
||||
Me.BackColor = cbo.BackColor
|
||||
Me.BackgroundImage = cbo.BackgroundImage
|
||||
Me.CausesValidation = cbo.CausesValidation
|
||||
Me.ContextMenu = cbo.ContextMenu
|
||||
Me.DataSource = cbo.DataSource
|
||||
Me.DisplayMember = cbo.DisplayMember
|
||||
Me.Dock = cbo.Dock
|
||||
Me.DropDownStyle = cbo.DropDownStyle
|
||||
Me.DropDownWidth = cbo.DropDownWidth
|
||||
Me.Enabled = cbo.Enabled
|
||||
Me.Font = cbo.Font
|
||||
Me.ForeColor = cbo.ForeColor
|
||||
Me.IntegralHeight = cbo.IntegralHeight
|
||||
If cbo.Items.Count > 0 Then
|
||||
Dim tmp(cbo.Items.Count) As Object
|
||||
cbo.Items.CopyTo(tmp, 0)
|
||||
Me.Items.AddRange(tmp)
|
||||
End If
|
||||
Me.MaxDropDownItems = cbo.MaxDropDownItems
|
||||
Me.MaxLength = cbo.MaxLength
|
||||
Me.Sorted = cbo.Sorted
|
||||
Me.Text = cbo.Text
|
||||
Me.TabStop = cbo.TabStop
|
||||
Me.ValueMember = cbo.ValueMember
|
||||
Me.Visible = cbo.Visible
|
||||
Me.Location = cbo.Location
|
||||
Me.Size = cbo.Size
|
||||
Me.TabIndex = cbo.TabIndex
|
||||
'set to ownerdraw
|
||||
Me.DrawMode = DrawMode.OwnerDrawFixed
|
||||
'switch combos
|
||||
Dim parent As Object = cbo.Parent
|
||||
parent.Controls.Remove(cbo)
|
||||
parent.Controls.Add(Me)
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
'just a sample class to use for items in this example
|
||||
Public Class ImgGenericList
|
||||
Private _Display As String
|
||||
Private _ID As Integer
|
||||
Private _Index As Integer = -1
|
||||
|
||||
Public Property Display() As String
|
||||
Get
|
||||
Return _Display
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_Display = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property ID() As Integer
|
||||
Get
|
||||
Return _ID
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
_ID = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property Index() As Integer
|
||||
Get
|
||||
Return _Index
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
_Index = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Sub New()
|
||||
MyBase.new()
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal display As String, ByVal id As Integer)
|
||||
Me.Display = display
|
||||
Me.ID = id
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal display As String, ByVal id As Integer, ByVal index As Integer)
|
||||
Me.Display = display
|
||||
Me.ID = id
|
||||
Me.Index = index
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
6
EDOKA/Utils/ImageLibrary.vb
Normal file
6
EDOKA/Utils/ImageLibrary.vb
Normal file
@@ -0,0 +1,6 @@
|
||||
Public Class ImageLibrary
|
||||
|
||||
Public Function LoadFromFile()
|
||||
Globals.DokumentartenImages.Images.Item(1).FromFile("c:\edoka\images\tb.ico")
|
||||
End Function
|
||||
End Class
|
||||
42
EDOKA/Utils/MultiComboBox.resx
Normal file
42
EDOKA/Utils/MultiComboBox.resx
Normal file
@@ -0,0 +1,42 @@
|
||||
<?xml version="1.0" encoding="utf-8" ?>
|
||||
<root>
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="ResMimeType">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="Version">
|
||||
<value>1.0.0.0</value>
|
||||
</resheader>
|
||||
<resheader name="Reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="Writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
</root>
|
||||
735
EDOKA/Utils/MultiComboBox.vb
Normal file
735
EDOKA/Utils/MultiComboBox.vb
Normal file
@@ -0,0 +1,735 @@
|
||||
|
||||
Imports System.ComponentModel
|
||||
Imports System.Drawing
|
||||
Imports System.Windows.Forms
|
||||
|
||||
Public Class MultiComboBox
|
||||
Inherits Windows.Forms.ComboBox
|
||||
|
||||
#Region "Deklarationen"
|
||||
Private _imageList As ImageList
|
||||
Private _imageindexmember As String
|
||||
Private _columns As New ColumnCollection()
|
||||
Private _showColumns As Boolean = False
|
||||
Private _showColumnHeaders As Boolean = False
|
||||
Private _CheckNullValue As Boolean = False
|
||||
Private _NulLValueMessage As String = ""
|
||||
Private _DisplayColumnName As String
|
||||
Private _ValueColumnName As String
|
||||
Private _NoValue As Boolean
|
||||
|
||||
Public Property ImageList() As ImageList
|
||||
Get
|
||||
Return _imageList
|
||||
End Get
|
||||
Set(ByVal value As ImageList)
|
||||
_imageList = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property ImageIndexMember() As String
|
||||
Get
|
||||
Return _imageindexmember
|
||||
End Get
|
||||
Set(ByVal value As String)
|
||||
_imageindexmember = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public ReadOnly Property Columns() As ColumnCollection
|
||||
Get
|
||||
Return _columns
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Public Property ShowColumns() As Boolean
|
||||
Get
|
||||
Return _showColumns
|
||||
End Get
|
||||
Set(ByVal value As Boolean)
|
||||
_showColumns = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property ShowColumnHeader() As Boolean
|
||||
Get
|
||||
Return _showColumnHeaders
|
||||
End Get
|
||||
Set(ByVal value As Boolean)
|
||||
_showColumnHeaders = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property CheckNullValue() As Boolean
|
||||
Get
|
||||
Return _CheckNullValue
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
_CheckNullValue = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property NullValueMessage() As String
|
||||
Get
|
||||
Return _NulLValueMessage
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_NulLValueMessage = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property DisplayColumnName() As String
|
||||
Get
|
||||
Return _DisplayColumnName
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_DisplayColumnName = Value
|
||||
End Set
|
||||
End Property
|
||||
Property ValueColumnName() As String
|
||||
Get
|
||||
Return _ValueColumnName
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_ValueColumnName = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property NoValue() As Boolean
|
||||
Get
|
||||
Return _NoValue
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
_NoValue = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Methoden"
|
||||
|
||||
Protected Overrides Sub OnDrawItem(ByVal ea As DrawItemEventArgs)
|
||||
ea.DrawBackground()
|
||||
ea.DrawFocusRectangle()
|
||||
|
||||
Dim iwidth As Integer = 0
|
||||
|
||||
Try
|
||||
Dim imageindex As Integer = -1
|
||||
Dim imageSize As Size = ImageList.ImageSize
|
||||
imageindex = Items(ea.Index).GetType.GetProperty(Me.ImageIndexMember).GetValue(Items(ea.Index), Nothing)
|
||||
ImageList.Draw(ea.Graphics, ea.Bounds.Left, ea.Bounds.Top, imageindex)
|
||||
iwidth = imageSize.Width
|
||||
Catch exi As Exception
|
||||
End Try
|
||||
|
||||
Try
|
||||
If ea.Index <> -1 Then
|
||||
If _showColumns Then
|
||||
Dim col As Column
|
||||
Dim cnt As Integer
|
||||
For Each col In Me.Columns
|
||||
cnt += 1
|
||||
|
||||
Static prevWidth As Integer
|
||||
If cnt = 1 Then prevWidth = ea.Bounds.X
|
||||
Dim useX As Integer = ea.Bounds.X + col.Width
|
||||
Dim useY As Integer = ea.Bounds.Y + ea.Bounds.Height
|
||||
Dim display As String
|
||||
Try
|
||||
If Items(ea.Index).GetType Is GetType(Data.DataRowView) Then
|
||||
Dim d As Data.DataRowView = CType(Items(ea.Index), Data.DataRowView)
|
||||
display = CType(d.Item(col.ColumnMember), String)
|
||||
Else
|
||||
display = CType(Items(ea.Index).GetType.GetProperty(col.ColumnMember).GetValue(Items(ea.Index), Nothing), String)
|
||||
End If
|
||||
Catch ext As Exception
|
||||
display = Items(ea.Index).ToString()
|
||||
End Try
|
||||
Dim rectf As New RectangleF((ea.Bounds.X + prevWidth) + iwidth, ea.Bounds.Y, useX, ea.Bounds.Height)
|
||||
ea.Graphics.DrawString(display, ea.Font, New SolidBrush(ea.ForeColor), rectf)
|
||||
If cnt > 1 Then
|
||||
ea.Graphics.DrawLine(System.Drawing.Pens.LightGray, prevWidth + iwidth, ea.Bounds.Y, prevWidth + iwidth, useY)
|
||||
End If
|
||||
prevWidth += col.Width
|
||||
Next
|
||||
Else
|
||||
Dim display As String
|
||||
Try
|
||||
display = CType(Items(ea.Index).GetType.GetProperty(Me.DisplayMember).GetValue(Items(ea.Index), Nothing), String)
|
||||
Catch ext As Exception
|
||||
display = Items(ea.Index).ToString()
|
||||
End Try
|
||||
ea.Graphics.DrawString(display, ea.Font, New SolidBrush(ea.ForeColor), ea.Bounds.Left + iwidth, ea.Bounds.Top)
|
||||
End If
|
||||
Else
|
||||
ea.Graphics.DrawString(Me.Text, ea.Font, New SolidBrush(ea.ForeColor), Bounds.Left, Bounds.Top)
|
||||
End If
|
||||
Catch ex As Exception
|
||||
ea.Graphics.DrawString(Me.Text, ea.Font, New SolidBrush(ea.ForeColor), Bounds.Left, Bounds.Top)
|
||||
End Try
|
||||
|
||||
MyBase.OnDrawItem(ea)
|
||||
End Sub
|
||||
|
||||
Public Sub New()
|
||||
Me.DrawMode = DrawMode.OwnerDrawFixed
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByRef cbo As ComboBox)
|
||||
Me.Anchor = cbo.Anchor
|
||||
Me.BackColor = cbo.BackColor
|
||||
Me.BackgroundImage = cbo.BackgroundImage
|
||||
Me.CausesValidation = cbo.CausesValidation
|
||||
Me.ContextMenu = cbo.ContextMenu
|
||||
Me.DataSource = cbo.DataSource
|
||||
Me.DisplayMember = cbo.DisplayMember
|
||||
Me.Dock = cbo.Dock
|
||||
Me.DropDownStyle = cbo.DropDownStyle
|
||||
Me.DropDownWidth = cbo.DropDownWidth
|
||||
Me.Enabled = cbo.Enabled
|
||||
Me.Font = cbo.Font
|
||||
Me.ForeColor = cbo.ForeColor
|
||||
Me.IntegralHeight = cbo.IntegralHeight
|
||||
If cbo.Items.Count > 0 Then
|
||||
Dim tmp(cbo.Items.Count) As Object
|
||||
cbo.Items.CopyTo(tmp, 0)
|
||||
Me.Items.AddRange(tmp)
|
||||
End If
|
||||
Me.MaxDropDownItems = cbo.MaxDropDownItems
|
||||
Me.MaxLength = cbo.MaxLength
|
||||
Me.Sorted = cbo.Sorted
|
||||
Me.Text = cbo.Text
|
||||
Me.TabStop = cbo.TabStop
|
||||
Me.ValueMember = cbo.ValueMember
|
||||
Me.Visible = cbo.Visible
|
||||
Me.Location = cbo.Location
|
||||
Me.Size = cbo.Size
|
||||
Me.TabIndex = cbo.TabIndex
|
||||
Dim parent As Object = cbo.Parent
|
||||
parent.Controls.Remove(cbo)
|
||||
parent.Controls.Add(Me)
|
||||
Me.CheckNullValue = True
|
||||
'Rel. 4.03
|
||||
Me.NullValueMessage = "Das Feld darf nicht ohne Wert sein!"
|
||||
End Sub
|
||||
|
||||
Private Sub ComboBoxAutoComplete(ByVal combo As ComboBox, ByVal str As String)
|
||||
Dim index As Integer
|
||||
If str.Length = 0 Then
|
||||
combo.SelectedIndex = -1
|
||||
combo.Text = ""
|
||||
Else
|
||||
index = combo.FindString(str)
|
||||
If index <> -1 Then
|
||||
combo.SelectedIndex = index
|
||||
combo.SelectionStart = str.Length
|
||||
combo.SelectionLength = combo.Text.Length - combo.SelectionStart
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'Neue Methoden
|
||||
Dim pressedkey As Boolean = False
|
||||
Protected Overrides Sub OnKeyPress(ByVal e As System.Windows.Forms.KeyPressEventArgs)
|
||||
'AUTOCOMPLETE: we have to know when a key has been really pressed
|
||||
|
||||
If Me.DropDownStyle = ComboBoxStyle.DropDown Then
|
||||
pressedkey = True
|
||||
Else
|
||||
'ReadOnly AutoComplete Management
|
||||
Dim sTypedText As String
|
||||
Dim iFoundIndex As Integer
|
||||
Dim currentText As String
|
||||
Dim Start, selLength As Integer
|
||||
|
||||
If Asc(e.KeyChar) = 8 Then
|
||||
If Me.SelectedText = Me.Text Then
|
||||
pressedkey = True
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
If Me.SelectionLength > 0 Then
|
||||
Start = Me.SelectionStart
|
||||
selLength = Me.SelectionLength
|
||||
|
||||
'This is equivalent to Me.Text, but sometimes using Me.Text it doesn't work
|
||||
currentText = Me.Text
|
||||
|
||||
currentText = currentText.Remove(Start, selLength)
|
||||
currentText = currentText.Insert(Start, e.KeyChar)
|
||||
sTypedText = currentText
|
||||
Else
|
||||
Start = Me.SelectionStart
|
||||
sTypedText = Me.Text.Insert(Start, e.KeyChar)
|
||||
End If
|
||||
iFoundIndex = Me.FindString(sTypedText)
|
||||
If (iFoundIndex >= 0) Then
|
||||
pressedkey = True
|
||||
Else
|
||||
e.Handled = True
|
||||
End If
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Protected Overrides Sub OnKeyDown(ByVal e As System.Windows.Forms.KeyEventArgs)
|
||||
If Me.DropDownStyle = ComboBoxStyle.DropDownList AndAlso e.KeyCode = Keys.Delete Then
|
||||
If Me.Text <> Me.SelectedText Then
|
||||
e.Handled = True
|
||||
End If
|
||||
End If
|
||||
|
||||
MyBase.OnKeyDown(e)
|
||||
End Sub
|
||||
|
||||
Protected Overrides Sub OnKeyUp(ByVal e As System.Windows.Forms.KeyEventArgs)
|
||||
'AUTOCOMPLETING
|
||||
|
||||
'WARNING: With VB.Net 2003 there is a strange behaviour. This event is raised not just when any key is pressed
|
||||
'but also when the Me.Text property changes. Particularly, it happens when you write in a fast way (for example you
|
||||
'you press 2 keys and the event is raised 3 times). To manage this we have added a boolean variable PressedKey that
|
||||
'is set to true in the OnKeyPress Event
|
||||
|
||||
Dim sTypedText As String
|
||||
Dim iFoundIndex As Integer
|
||||
Dim oFoundItem As Object
|
||||
Dim sFoundText As String
|
||||
Dim sAppendText As String
|
||||
|
||||
If PressedKey Then
|
||||
'Ignoring alphanumeric chars
|
||||
Select Case e.KeyCode
|
||||
Case Keys.Back, Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down, Keys.End, Keys.Home
|
||||
Return
|
||||
End Select
|
||||
|
||||
'Get the Typed Text and Find it in the list
|
||||
sTypedText = Me.Text
|
||||
iFoundIndex = Me.FindString(sTypedText)
|
||||
|
||||
'If we found the Typed Text in the list then Autocomplete
|
||||
If iFoundIndex >= 0 Then
|
||||
|
||||
'Get the Item from the list (Return Type depends if Datasource was bound
|
||||
' or List Created)
|
||||
oFoundItem = Me.Items(iFoundIndex)
|
||||
|
||||
'Use the ListControl.GetItemText to resolve the Name in case the Combo
|
||||
' was Data bound
|
||||
sFoundText = Me.GetItemText(oFoundItem)
|
||||
|
||||
'Append then found text to the typed text to preserve case
|
||||
sAppendText = sFoundText.Substring(sTypedText.Length)
|
||||
Me.Text = sTypedText & sAppendText
|
||||
|
||||
'Select the Appended Text
|
||||
Me.SelectionStart = sTypedText.Length
|
||||
Me.SelectionLength = sAppendText.Length
|
||||
|
||||
If e.KeyCode = Keys.Enter Then
|
||||
iFoundIndex = Me.FindStringExact(Me.Text)
|
||||
Me.SelectedIndex = iFoundIndex
|
||||
SendKeys.Send(vbTab)
|
||||
e.Handled = True
|
||||
End If
|
||||
End If
|
||||
|
||||
End If
|
||||
pressedkey = False
|
||||
End Sub
|
||||
'Rell 4.03 7: OnLeave-Ereignis entfernt
|
||||
' Protected Overrides Sub OnLeave(ByVal e As System.EventArgs)
|
||||
'Selecting the item which text is showed in the text area of the ComboBox
|
||||
'Dim iFoundIndex As Integer
|
||||
'The Me.AccessibilityObject.Value is used instead of Me.Text to manage
|
||||
'the event when you write in the combobox text and the DropDownList
|
||||
'is open. In this case, if you click outside the combo, Me.Text mantains
|
||||
'the old value and not the current one
|
||||
' iFoundIndex = Me.FindStringExact(Me.Text)
|
||||
' Me.SelectedIndex = iFoundIndex
|
||||
'End Sub
|
||||
|
||||
|
||||
' Public Sub AutoCompleteCombo_KeyUp(ByVal cbo As ComboBox, ByVal e As KeyEventArgs) Handles MyBase.KeyUp
|
||||
'Public Sub AutoCompleteCombo_KeyUp(ByVal sender As Object, ByVal e As KeyEventArgs) Handles MyBase.KeyUp
|
||||
' Dim cbo As ComboBox
|
||||
' cbo = sender
|
||||
' Dim sTypedText As String
|
||||
' Dim iFoundIndex As Integer
|
||||
' Dim oFoundItem As Object
|
||||
' Dim sFoundText As String
|
||||
' Dim sAppendText As String
|
||||
' Select Case e.KeyCode
|
||||
' Case Keys.Back, Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down
|
||||
' Return
|
||||
' End Select
|
||||
' sTypedText = cbo.Text
|
||||
' iFoundIndex = cbo.FindString(sTypedText)
|
||||
' If iFoundIndex >= 0 Then
|
||||
' oFoundItem = cbo.Items(iFoundIndex)
|
||||
' sFoundText = cbo.GetItemText(oFoundItem)
|
||||
' sAppendText = sFoundText.Substring(sTypedText.Length)
|
||||
' cbo.Text = sTypedText & sAppendText
|
||||
' cbo.SelectionStart = sTypedText.Length
|
||||
' cbo.SelectionLength = sAppendText.Length
|
||||
' End If
|
||||
'End Sub
|
||||
|
||||
Public Sub AutoCompleteCombo_Leave(ByVal cbo As ComboBox)
|
||||
Dim iFoundIndex As Integer
|
||||
iFoundIndex = cbo.FindStringExact(cbo.Text)
|
||||
cbo.SelectedIndex = iFoundIndex
|
||||
End Sub
|
||||
|
||||
'hutter
|
||||
'Private Sub Me_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
|
||||
' Dim FindString As String
|
||||
' Dim ipos As Integer = Me.SelectionStart
|
||||
|
||||
' Select Case Asc(e.KeyChar)
|
||||
' Case Keys.Escape, Keys.Back
|
||||
' Me.SelectedIndex = -1
|
||||
' Me.Text = ""
|
||||
' Case Else
|
||||
' ComboBoxAutoComplete(Me, Me.Text.Substring(0, ipos) & e.KeyChar.ToString)
|
||||
' End Select
|
||||
' e.Handled = True
|
||||
|
||||
|
||||
' 'If Asc(e.KeyChar) = Keys.Escape Then
|
||||
' ' Me.SelectedIndex = -1
|
||||
' ' Me.Text = ""
|
||||
' 'ElseIf Asc(e.KeyChar) = Keys.Back Then
|
||||
' ' 'If Me.Text.Substring(0, ipos).Length > 0 Then
|
||||
' ' ' 'ComboBoxAutoComplete(Me, Me.Text.Remove(Me.Text.Length - 1, 1))
|
||||
' ' ' Me.Text = Me.Text.Substring(0, ipos - 1)
|
||||
' ' ' Me.SelectedIndex = -1
|
||||
' ' 'Else
|
||||
' ' Me.SelectedIndex = -1
|
||||
' ' Me.Text = ""
|
||||
' ' 'End If
|
||||
' 'Else
|
||||
' ' ComboBoxAutoComplete(Me, Me.Text.Substring(0, ipos) & e.KeyChar.ToString)
|
||||
' 'End If
|
||||
' 'e.Handled = True
|
||||
'End Sub
|
||||
|
||||
Private Sub Me_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp
|
||||
|
||||
'Dim FindString As String
|
||||
'Dim ipos As Integer = Me.SelectionStart
|
||||
'If e.KeyCode.ToString.Length > 1 And e.KeyCode <> Keys.Escape And e.KeyCode <> Keys.Back Then
|
||||
' e.Handled = True
|
||||
' Exit Sub
|
||||
'End If
|
||||
|
||||
'If e.KeyCode = Keys.Escape Then
|
||||
' Me.SelectedIndex = -1
|
||||
' Me.Text = ""
|
||||
'ElseIf e.KeyCode = Keys.Back Then
|
||||
' Me.SelectedIndex = -1
|
||||
' Me.Text = ""
|
||||
'Else
|
||||
' ComboBoxAutoComplete(Me, Me.Text.Substring(0, ipos))
|
||||
'End If
|
||||
'e.Handled = True
|
||||
End Sub
|
||||
|
||||
|
||||
Public Sub MultiComboBox_Leave(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Leave
|
||||
Dim swert As String
|
||||
swert = Me.SelectedValue
|
||||
If Me.CheckNullValue = True Then
|
||||
If swert = "" Or swert Is System.DBNull.Value Then
|
||||
MsgBox(Me.NullValueMessage, MsgBoxStyle.Exclamation)
|
||||
Me.Focus()
|
||||
Me.NoValue = True
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Me.NoValue = False
|
||||
End Sub
|
||||
|
||||
Public Sub Fill_Data(ByVal da As DataTable, ByVal addblankrow As Boolean)
|
||||
Dim al As New ArrayList()
|
||||
Dim xvalue As String
|
||||
Dim i As Integer
|
||||
If addblankrow Then
|
||||
al.Add(New GenericList("", "", 0, 0))
|
||||
End If
|
||||
If da.Rows.Count = 0 Then Exit Sub
|
||||
For i = 0 To da.Rows.Count - 1
|
||||
If da.Rows(i).Item(DisplayColumnName) Is System.DBNull.Value Then
|
||||
xvalue = ""
|
||||
Else
|
||||
xvalue = da.Rows(i).Item(DisplayColumnName)
|
||||
End If
|
||||
al.Add(New GenericList(xvalue, "", da.Rows(i).Item(ValueColumnName), i + 1))
|
||||
Next
|
||||
Me.DataSource = al
|
||||
Me.DisplayMember = "Display"
|
||||
Me.ValueMember = "ID"
|
||||
Me.Columns.Add(New MultiComboBox.Column(-1, "ID"))
|
||||
Me.Columns.Add(New MultiComboBox.Column(180, "Display"))
|
||||
Me.ShowColumns = True
|
||||
End Sub
|
||||
|
||||
Public Sub Fill_Data(ByVal da As DataTable, ByVal addblankrow As Boolean, ByVal blankrowtext As String)
|
||||
Dim al As New ArrayList()
|
||||
Dim xvalue As String
|
||||
Dim i As Integer
|
||||
If addblankrow Then
|
||||
al.Add(New GenericList(blankrowtext, blankrowtext, 0, 0))
|
||||
End If
|
||||
If da.Rows.Count = 0 Then Exit Sub
|
||||
For i = 0 To da.Rows.Count - 1
|
||||
If da.Rows(i).Item(DisplayColumnName) Is System.DBNull.Value Then
|
||||
xvalue = ""
|
||||
Else
|
||||
xvalue = da.Rows(i).Item(DisplayColumnName)
|
||||
End If
|
||||
al.Add(New GenericList(xvalue, "", da.Rows(i).Item(ValueColumnName), i + 1))
|
||||
Next
|
||||
Me.DataSource = al
|
||||
Me.DisplayMember = "Display"
|
||||
Me.ValueMember = "ID"
|
||||
Me.Columns.Add(New MultiComboBox.Column(-1, "ID"))
|
||||
Me.Columns.Add(New MultiComboBox.Column(180, "Display"))
|
||||
Me.ShowColumns = True
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Classes"
|
||||
|
||||
#Region "Column"
|
||||
Public Class Column
|
||||
|
||||
Private _Width As Integer
|
||||
Private _ColumnMember As String
|
||||
Private _Header As String
|
||||
|
||||
Public Property Width() As Integer
|
||||
Get
|
||||
Return _Width
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
_Width = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property ColumnMember() As String
|
||||
Get
|
||||
Return _ColumnMember
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_ColumnMember = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property Header() As String
|
||||
Get
|
||||
Return _Header
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_Header = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Sub New()
|
||||
MyBase.new()
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal width As Integer, ByVal columnmember As String)
|
||||
Me.New(width, columnmember, String.Empty)
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal width As Integer, ByVal columnmember As String, ByVal header As String)
|
||||
MyBase.new()
|
||||
Me.Width = width
|
||||
Me.ColumnMember = columnmember
|
||||
Me.Header = header
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "ColumnCollection"
|
||||
|
||||
Public Class ColumnCollection
|
||||
Implements IEnumerable
|
||||
|
||||
Private _Col As New Collection()
|
||||
|
||||
Public ReadOnly Property Count() As Integer
|
||||
Get
|
||||
Return _Col.Count
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Default Public ReadOnly Property Item(ByVal Key As String) As Column
|
||||
Get
|
||||
Return _Col(Key)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Default Public ReadOnly Property Item(ByVal Index As Integer) As Column
|
||||
Get
|
||||
Return _Col(Index)
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Public Function Add(ByVal NewItem As Column, Optional ByVal Key As String = Nothing) As Column
|
||||
If Key Is Nothing Then
|
||||
_Col.Add(NewItem)
|
||||
Else
|
||||
_Col.Add(NewItem, Key)
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Sub Remove(ByVal Key As String)
|
||||
_Col.Remove(Key)
|
||||
End Sub
|
||||
|
||||
Public Sub Remove(ByVal Index As Integer)
|
||||
_Col.Remove(Index)
|
||||
End Sub
|
||||
|
||||
Public Sub Clear()
|
||||
Dim cnt As Integer
|
||||
Dim cntMax As Integer
|
||||
|
||||
cntMax = _Col.Count
|
||||
For cnt = cntMax To 1 Step -1
|
||||
_Col.Remove(cnt)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
Public Function Contains(ByVal Key As String) As Boolean
|
||||
Try
|
||||
Dim obj As Object = _Col(Key)
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Sub New()
|
||||
MyBase.new()
|
||||
End Sub
|
||||
|
||||
Public Function GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
|
||||
Return _Col.GetEnumerator
|
||||
End Function
|
||||
End Class
|
||||
#End Region
|
||||
|
||||
#End Region
|
||||
|
||||
Protected Overrides Sub OnLostFocus(ByVal e As System.EventArgs)
|
||||
'Selecting the item which text is showed in the text area of the ComboBox
|
||||
Dim iFoundIndex As Integer
|
||||
'The Me.AccessibilityObject.Value is used instead of Me.Text to manage
|
||||
'the event when you write in the combobox text and the DropDownList
|
||||
'is open. In this case, if you click outside the combo, Me.Text mantains
|
||||
'the old value and not the current one
|
||||
iFoundIndex = Me.FindStringExact(Me.Text)
|
||||
Me.SelectedIndex = iFoundIndex
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub MultiComboBox_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.TextChanged
|
||||
'Selecting the item which text is showed in the text area of the ComboBox
|
||||
Dim iFoundIndex As Integer
|
||||
'The Me.AccessibilityObject.Value is used instead of Me.Text to manage
|
||||
'the event when you write in the combobox text and the DropDownList
|
||||
'is open. In this case, if you click outside the combo, Me.Text mantains
|
||||
'the old value and not the current one
|
||||
iFoundIndex = Me.FindStringExact(Me.Text)
|
||||
Me.SelectedIndex = iFoundIndex
|
||||
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
|
||||
#Region "GenericList"
|
||||
|
||||
|
||||
Public Class GenericList
|
||||
Private _Display As String
|
||||
Private _AlternateDisplay As String
|
||||
Private _ID As Integer
|
||||
Private _Index As Integer = -1
|
||||
|
||||
Public Property Display() As String
|
||||
Get
|
||||
Return _Display
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_Display = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property AlternateDisplay() As String
|
||||
Get
|
||||
Return _AlternateDisplay
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
_AlternateDisplay = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property ID() As Integer
|
||||
Get
|
||||
Return _ID
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
_ID = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Property Index() As Integer
|
||||
Get
|
||||
Return _Index
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
_Index = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Sub New()
|
||||
MyBase.new()
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal display As String, ByVal id As Integer)
|
||||
Me.Display = display
|
||||
Me.ID = id
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal display As String, ByVal altdisplay As String, ByVal id As Integer)
|
||||
Me.Display = display
|
||||
Me.AlternateDisplay = altdisplay
|
||||
Me.ID = id
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal display As String, ByVal id As Integer, ByVal index As Integer)
|
||||
Me.Display = display
|
||||
Me.ID = id
|
||||
Me.Index = index
|
||||
End Sub
|
||||
|
||||
Public Sub New(ByVal display As String, ByVal altdisplay As String, ByVal id As Integer, ByVal index As Integer)
|
||||
Me.Display = display
|
||||
Me.AlternateDisplay = altdisplay
|
||||
Me.ID = id
|
||||
Me.Index = index
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
#End Region
|
||||
|
||||
|
||||
|
||||
|
||||
181
EDOKA/Utils/MyMessage.vb
Normal file
181
EDOKA/Utils/MyMessage.vb
Normal file
@@ -0,0 +1,181 @@
|
||||
Imports UtilityLibrary
|
||||
Imports System.IO
|
||||
Imports C1.Win.C1TrueDBGrid
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.ComponentModel
|
||||
Imports UtilityLibrary.Win32
|
||||
|
||||
Namespace EDOKA
|
||||
Public Class MyMessage
|
||||
Private meldungstexte As New DataView()
|
||||
|
||||
Public Function Get_Meldungstext(ByVal i As Integer) As String
|
||||
Dim meldungen As New edokadb.clsMeldungstexte()
|
||||
Dim res As Integer
|
||||
meldungen.cpMainConnectionProvider = conn
|
||||
If Me.meldungstexte.Count = 0 Then
|
||||
Me.meldungstexte.Table = meldungen.SelectAll
|
||||
End If
|
||||
meldungstexte.Sort = "meldungstextnr"
|
||||
res = meldungstexte.Find(i)
|
||||
Try
|
||||
Get_Meldungstext = Me.meldungstexte(res).Item(2)
|
||||
Catch
|
||||
Get_Meldungstext = ""
|
||||
End Try
|
||||
meldungen.Dispose()
|
||||
End Function
|
||||
|
||||
Public Function show_standardmessage(ByVal i As Integer, ByVal typ As MsgBoxStyle) As Integer
|
||||
MsgBox(Get_Meldungstext(i), typ)
|
||||
End Function
|
||||
|
||||
Public Function Show_MessageYesNo(ByVal i As Integer) As MsgBoxResult
|
||||
Show_MessageYesNo = MsgBox(Get_Meldungstext(i), MsgBoxStyle.YesNo + MsgBoxStyle.Question)
|
||||
End Function
|
||||
Public Function Show_MessageOKCancel(ByVal i As Integer) As MsgBoxResult
|
||||
Show_MessageOKCancel = MsgBox(Get_Meldungstext(i), MsgBoxStyle.OkCancel + MsgBoxStyle.Information)
|
||||
End Function
|
||||
|
||||
|
||||
Public Function Show_MessageYesNoBL(ByVal i As Integer) As MsgBoxResult
|
||||
Show_MessageYesNoBL = MsgBox(Get_Meldungstext(i), MsgBoxStyle.YesNo + MsgBoxStyle.Question, "Banklagerndes Dokument")
|
||||
End Function
|
||||
|
||||
Public Function show_MessageYesNo_ReplaceText(ByVal i As Integer, ByVal Text1 As String, ByVal Text2 As String) As MsgBoxResult
|
||||
Dim s As String
|
||||
s = Get_Meldungstext(i)
|
||||
s = s.Replace("#1", Text1)
|
||||
s = s.Replace("#2", Text2)
|
||||
show_MessageYesNo_ReplaceText = MsgBox(s, MsgBoxStyle.YesNo + MsgBoxStyle.Question)
|
||||
End Function
|
||||
|
||||
'''<summary>Ersetzt in einem String die #1 und #2 durch Text1 und Text 2</summary>
|
||||
'''<param name="OrgText"></param>
|
||||
'''<param name="Text1"></param>
|
||||
'''<param name="Text2"></param>
|
||||
'''<author>Daniel Burren</author>
|
||||
'''<version>Release 3.6</version>
|
||||
Public Function ReplaceTextinMSG(ByVal OrgText As String, ByVal Text1 As String, ByVal Text2 As String) As String
|
||||
OrgText = OrgText.Replace("#1", Text1)
|
||||
OrgText = OrgText.Replace("#2", Text2)
|
||||
ReplaceTextinMSG = OrgText
|
||||
End Function
|
||||
|
||||
Public Function Show_MessageYesNoCancel(ByVal i As Integer) As MsgBoxResult
|
||||
Show_MessageYesNoCancel = MsgBox(Get_Meldungstext(i), MsgBoxStyle.YesNoCancel + MsgBoxStyle.Question)
|
||||
End Function
|
||||
|
||||
Public Function Show_HinweisMessage(ByVal profilnr As Integer, ByVal messagenr As Integer, ByVal MeldungsNummer As Integer, ByVal style As Integer) As Boolean
|
||||
If ShowMessage(profilnr, messagenr, 0, style) Then
|
||||
Dim f As New frmHinweismeldung()
|
||||
f.Label1.Text = MyMsg.Get_Meldungstext(MeldungsNummer)
|
||||
f.CheckBox1.Checked = False
|
||||
f.MsgBoxStyle = style
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then Show_HinweisMessage = True Else Show_HinweisMessage = False
|
||||
If f.CheckBox1.Checked Then
|
||||
ShowMessage(profilnr, messagenr, 1, style)
|
||||
End If
|
||||
f.Dispose()
|
||||
Else
|
||||
Show_HinweisMessage = True
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function Show_HinweisMessage(ByVal profilnr As Integer, ByVal messagenr As Integer, ByVal MeldungsNummer As Integer, ByVal style As Integer, ByVal formOnTop As Boolean) As Boolean
|
||||
If ShowMessage(profilnr, messagenr, 0, style) Then
|
||||
Dim f As New frmHinweismeldung()
|
||||
f.Label1.Text = MyMsg.Get_Meldungstext(MeldungsNummer)
|
||||
f.CheckBox1.Checked = False
|
||||
f.MsgBoxStyle = style
|
||||
If formOnTop = True Then f.TopMost = True
|
||||
f.ShowDialog()
|
||||
If f.DialogResult = DialogResult.OK Then Show_HinweisMessage = True Else Show_HinweisMessage = False
|
||||
If f.CheckBox1.Checked Then
|
||||
ShowMessage(profilnr, messagenr, 1, style)
|
||||
End If
|
||||
f.Dispose()
|
||||
Else
|
||||
Show_HinweisMessage = True
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function ShowMessage(ByVal profilnr As Integer, ByVal messagenr As Integer, ByVal fnkt As Integer, ByVal style As Integer) As Boolean
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_show_hinweismeldung"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@profilnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, profilnr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@hinweisnr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, messagenr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, fnkt))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@showit", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
i = scmCmdToExecute.Parameters.Item("@showit").Value
|
||||
If i <> 0 Then
|
||||
ShowMessage = True
|
||||
Else
|
||||
ShowMessage = False
|
||||
End If
|
||||
Catch ex As Exception
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
|
||||
Public Function show_standardmessage_ReplaceText(ByVal i As Integer, ByVal typ As MsgBoxStyle, ByVal Text1 As String, ByVal Text2 As String) As Integer
|
||||
Dim s As String
|
||||
s = Get_Meldungstext(i)
|
||||
s = s.Replace("#1", Text1)
|
||||
s = s.Replace("#2", Text2)
|
||||
MsgBox(s, typ)
|
||||
End Function
|
||||
|
||||
|
||||
Public Sub New()
|
||||
End Sub
|
||||
|
||||
Public Function show_bcmessage(ByVal dokumentid As String)
|
||||
Dim s As String
|
||||
s = Get_Meldungstext(88)
|
||||
s = parstext(s, dokumentid)
|
||||
MsgBox(s, MsgBoxStyle.Information)
|
||||
End Function
|
||||
|
||||
Public Function parstext(ByVal s As String, ByVal dokumentid As String) As String
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_get_archivinfo"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
s = s.Replace("&Archiv&", dtToReturn.Rows(0).Item("Archiv"))
|
||||
s = s.Replace("&ArchivKZ&", dtToReturn.Rows(0).Item("ArchivKZ"))
|
||||
Return s
|
||||
Catch ex As Exception
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
End Class
|
||||
End Namespace
|
||||
172
EDOKA/Utils/MySpalten.vb
Normal file
172
EDOKA/Utils/MySpalten.vb
Normal file
@@ -0,0 +1,172 @@
|
||||
'*
|
||||
' Object MyspaltenTitel
|
||||
'
|
||||
' Dieses Objekt liest die Daten aus der Tabelle Spalten und speichert diese in spaltendaten
|
||||
' Die Daten werden für die Spaltenbezeichnung der C1Datagrids verwendet
|
||||
'
|
||||
' Autor: Stefan Hutter
|
||||
' Datum: 2.12.2002
|
||||
'*
|
||||
Namespace EDOKA
|
||||
Public Class Tabellenspalte
|
||||
Private m_table As String
|
||||
Private m_field As String
|
||||
Private m_spaltenname As String
|
||||
Private m_locked As Boolean
|
||||
Private m_Width As Integer
|
||||
Private m_Order As Integer
|
||||
Private m_alsHacken As Boolean
|
||||
Private m_tiptext As String
|
||||
|
||||
Property ColWith() As Integer
|
||||
Get
|
||||
Return m_Width
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
m_Width = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Order() As Integer
|
||||
Get
|
||||
Return m_Order
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
m_Order = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Tabelle() As String
|
||||
Get
|
||||
Return m_table
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_table = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Feld() As String
|
||||
Get
|
||||
Return m_field
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_field = Value
|
||||
End Set
|
||||
End Property
|
||||
Property spaltenname() As String
|
||||
Get
|
||||
Return m_spaltenname
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_spaltenname = Value
|
||||
End Set
|
||||
End Property
|
||||
Property locked() As Boolean
|
||||
Get
|
||||
Return m_locked
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_locked = Value
|
||||
End Set
|
||||
End Property
|
||||
Property AlsHacken() As Boolean
|
||||
Get
|
||||
Return m_alsHacken
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_alsHacken = Value
|
||||
End Set
|
||||
End Property
|
||||
Property TipText() As String
|
||||
Get
|
||||
Return m_tiptext
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_tiptext = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
|
||||
|
||||
Public Function getspalte()
|
||||
Try
|
||||
Dim myspalten As New MySpaltenTitel()
|
||||
Me.spaltenname = myspalten.getspalte(Me.Tabelle, Me.Feld)
|
||||
Me.locked = myspalten.getlock(Me.Tabelle, Me.Feld)
|
||||
Me.ColWith = myspalten.getColWidth(Me.Tabelle, Me.Feld)
|
||||
Me.Order = myspalten.getOrder(Me.Tabelle, Me.Feld)
|
||||
Me.AlsHacken = myspalten.gethacken(Me.Tabelle, Me.Feld)
|
||||
Me.TipText = myspalten.gettiptext(Me.Tabelle, Me.Feld)
|
||||
Catch
|
||||
End Try
|
||||
End Function
|
||||
End Class
|
||||
|
||||
Public Class MySpaltenTitel
|
||||
|
||||
|
||||
Public Function getspalte(ByVal tabelle As String, ByVal feld As String) As String
|
||||
Dim i As Integer
|
||||
If Globals.Spalten.Rows.Count = 0 Then load_data()
|
||||
For i = 0 To Globals.Spalten.Rows.Count - 1
|
||||
If Globals.Spalten.Rows(i).Item(1) = tabelle And Globals.Spalten.Rows(i).Item(2) = feld Then
|
||||
getspalte = Globals.Spalten.Rows(i).Item(3)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Function getlock(ByVal tabelle As String, ByVal feld As String) As Boolean
|
||||
Dim i As Integer
|
||||
If Globals.Spalten.Rows.Count = 0 Then load_data()
|
||||
For i = 0 To Globals.Spalten.Rows.Count - 1
|
||||
If Globals.Spalten.Rows(i).Item(1) = tabelle And Globals.Spalten.Rows(i).Item(2) = feld Then
|
||||
getlock = Globals.Spalten.Rows(i).Item(4)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Function getColWidth(ByVal tabelle As String, ByVal feld As String) As Integer
|
||||
Dim i As Integer
|
||||
If Globals.Spalten.Rows.Count = 0 Then load_data()
|
||||
For i = 0 To Globals.Spalten.Rows.Count - 1
|
||||
If Globals.Spalten.Rows(i).Item(1) = tabelle And Globals.Spalten.Rows(i).Item(2) = feld Then
|
||||
getColWidth = Globals.Spalten.Rows(i).Item(6)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Function getOrder(ByVal tabelle As String, ByVal feld As String) As Integer
|
||||
Dim i As Integer
|
||||
If Globals.Spalten.Rows.Count = 0 Then load_data()
|
||||
For i = 0 To Globals.Spalten.Rows.Count - 1
|
||||
If Globals.Spalten.Rows(i).Item(1) = tabelle And Globals.Spalten.Rows(i).Item(2) = feld Then
|
||||
getOrder = Globals.Spalten.Rows(i).Item(7)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Function gethacken(ByVal tabelle As String, ByVal feld As String) As Integer
|
||||
Dim i As Integer
|
||||
If Globals.Spalten.Rows.Count = 0 Then load_data()
|
||||
For i = 0 To Globals.Spalten.Rows.Count - 1
|
||||
If Globals.Spalten.Rows(i).Item(1) = tabelle And Globals.Spalten.Rows(i).Item(2) = feld Then
|
||||
gethacken = Globals.Spalten.Rows(i).Item(5)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Function gettiptext(ByVal tabelle As String, ByVal feld As String) As String
|
||||
Dim i As Integer
|
||||
If Globals.Spalten.Rows.Count = 0 Then load_data()
|
||||
For i = 0 To Globals.Spalten.Rows.Count - 1
|
||||
If Globals.Spalten.Rows(i).Item(1) = tabelle And Globals.Spalten.Rows(i).Item(2) = feld Then
|
||||
gettiptext = Globals.Spalten.Rows(i).Item(8)
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Public Sub load_data()
|
||||
Dim spalten As New edokadb.clsSpalten()
|
||||
Globals.Spalten.Rows.Clear()
|
||||
spalten.cpMainConnectionProvider = conn
|
||||
Globals.Spalten = spalten.SelectAll
|
||||
End Sub
|
||||
End Class
|
||||
End Namespace
|
||||
11
EDOKA/Utils/MyText.vb
Normal file
11
EDOKA/Utils/MyText.vb
Normal file
@@ -0,0 +1,11 @@
|
||||
Namespace EDOKA
|
||||
Public Class MyText
|
||||
Inherits EDOKA.MyMessage
|
||||
|
||||
Public Function gettext(ByVal wert As Integer) As String
|
||||
gettext = Me.Get_Meldungstext(wert)
|
||||
|
||||
End Function
|
||||
|
||||
End Class
|
||||
End Namespace
|
||||
400
EDOKA/Utils/NewFileCheck.vb
Normal file
400
EDOKA/Utils/NewFileCheck.vb
Normal file
@@ -0,0 +1,400 @@
|
||||
Imports System
|
||||
Imports System.Text
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Threading
|
||||
|
||||
Imports System.IO
|
||||
|
||||
Imports System.Collections
|
||||
Imports System.Runtime.Serialization.Formatters.Binary
|
||||
Imports System.Runtime.Serialization
|
||||
Imports System.Xml.Serialization
|
||||
Imports System.Xml
|
||||
|
||||
|
||||
'20201022 - New Class
|
||||
Public Class NewFileCheck
|
||||
Public FilesToWatch As New Collection
|
||||
Dim ts As String
|
||||
Dim Filename As String
|
||||
Public Function AddToCollection(Apptype As Integer, dokumentid As String, wlib As WordLib) As Long
|
||||
|
||||
Dim ts As String = Now.ToString("yyyyMMddHHmmssFFF")
|
||||
Filename = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "\" + ts + "_" + wlib.DokumentID + ".olib"
|
||||
|
||||
Try
|
||||
If Globals.UseOlibFile = True Then Save_Wordlibdata(wlib, Apptype)
|
||||
Catch ex As Exception
|
||||
PerfMon.force_insert_entry(dokumentid + ": SaveWordlibdata fehlgeschlagen: " + ex.message)
|
||||
End Try
|
||||
|
||||
Dim pid As Long
|
||||
pid = GetHandle(dokumentid, Apptype, dokumentid)
|
||||
FilesToWatch.Add(New Wachfile(Apptype, dokumentid, pid, wlib, ts, Filename))
|
||||
If IntTimer.Enabled = False Then
|
||||
IntTimer.Enabled = True
|
||||
IntTimer.Start()
|
||||
End If
|
||||
|
||||
Return pid
|
||||
End Function
|
||||
|
||||
Sub Save_Wordlibdata(wlib As WordLib, apptype As Integer)
|
||||
|
||||
Dim ds As New DataSet
|
||||
Dim dt As New DataTable
|
||||
dt.Columns.Add("save_historystatus")
|
||||
dt.Columns.Add("save_historystatusbr")
|
||||
dt.Columns.Add("dokumentid")
|
||||
dt.Columns.Add("Save_DokumentFunktionen")
|
||||
dt.Columns.Add("CreateDoc")
|
||||
dt.Columns.Add("Save_Dokument")
|
||||
dt.Columns.Add("Dokumentidbr")
|
||||
dt.Columns.Add("Dokumentcoldindex_Changed")
|
||||
dt.Columns.Add("dokumentid_changed")
|
||||
dt.Columns.Add("Dokumentcoldindex_Changedbr")
|
||||
dt.Columns.Add("dokumentid_changedbr")
|
||||
dt.Columns.Add("Timestamp")
|
||||
dt.Columns.Add("Applicationtype")
|
||||
dt.Columns.Add("Dokumentfilename")
|
||||
dt.Columns.Add("Dokumentname")
|
||||
Dim dr As DataRow = dt.NewRow
|
||||
dr.Item(0) = wlib.save_historystatus
|
||||
dr.Item(1) = wlib.save_historystatusbr
|
||||
dr.Item(2) = wlib.DokumentID
|
||||
dr.Item(3) = wlib.Save_DokumentFunktionen
|
||||
dr.Item(4) = wlib.CreateDoc
|
||||
dr.Item(5) = wlib.Save_Dokument
|
||||
dr.Item(6) = wlib.Dokumentidbr
|
||||
dr.Item(7) = wlib.Dokumentcoldindex_Changed
|
||||
dr.Item(8) = wlib.dokumentid_changed
|
||||
dr.Item(9) = wlib.Dokumentcoldindex_changedbr
|
||||
dr.Item(10) = wlib.dokumentid_changedbr
|
||||
dr.Item(11) = ts
|
||||
dr.Item(12) = apptype
|
||||
dr.Item(13) = wlib.Dokumentfilename
|
||||
dr.Item(14) = wlib.DokumentName
|
||||
|
||||
dt.Rows.Add(dr)
|
||||
|
||||
Try
|
||||
dt.TableName = "Allgemein"
|
||||
ds.Tables.Add(dt.Copy)
|
||||
Catch
|
||||
End Try
|
||||
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokument.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokument"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Notizen.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Notizen"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_ColdIndex.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Coldindex"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentwerte.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentwerte"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentzuordnungen.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentzuordnungen"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentinfomeldungen.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentinfomeldung"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_DokumentFunktionen.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentfunktionen"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.save_dokumentersetzen.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentersetzen"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.save_dokumentcoldindex.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentcoldindex"
|
||||
Catch
|
||||
End Try
|
||||
|
||||
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentbr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Notizenbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Notizenbr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_ColdIndexbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Coldindexbr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentwertebr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentwertebr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentzuordnungenbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentzuordnungenvr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_Dokumentinfomeldungenbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentinfomeldungenbr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.Save_DokumentFunktionenbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentfunktionenbr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.save_dokumentersetzenbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentersetzenbr"
|
||||
Catch
|
||||
End Try
|
||||
Try
|
||||
ds.Tables.Add(wlib.save_dokumentcoldindexbr.Copy)
|
||||
ds.Tables(ds.Tables.Count - 1).TableName = "Save_Dokumentcoldindexbr"
|
||||
Catch
|
||||
End Try
|
||||
Dim files As String() = System.IO.Directory.GetFiles(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"), "*" + wlib.DokumentID + ".olib", System.IO.SearchOption.TopDirectoryOnly)
|
||||
If files.Length > 0 Then
|
||||
For Each filename As String In files
|
||||
System.IO.File.Delete(filename)
|
||||
Next
|
||||
End If
|
||||
|
||||
|
||||
ds.WriteXml(Filename)
|
||||
Dim fs As New FileStream(Filename, FileMode.Create)
|
||||
Dim sw As New StreamWriter(fs)
|
||||
sw.WriteLine("<?xml version=" + """1.0""" + " standalone=" + """yes""" + "?>")
|
||||
sw.WriteLine("<NewDataset>")
|
||||
For Each t As DataTable In ds.Tables
|
||||
For Each r As DataRow In t.Rows
|
||||
sw.WriteLine("<" + t.TableName + ">")
|
||||
For Each dc As DataColumn In t.Columns
|
||||
Dim s As String = ""
|
||||
Try
|
||||
If r.Item(dc.ColumnName) = System.DBNull.Value Then
|
||||
s = "<" + dc.ColumnName + ">System.DBNull.Value</" + dc.ColumnName + ">"
|
||||
Else
|
||||
s = "<" + dc.ColumnName + ">" + r.Item(dc.ColumnName).ToString + "</" + dc.ColumnName + ">"
|
||||
End If
|
||||
Catch
|
||||
s = "<" + dc.ColumnName + ">" + r.Item(dc.ColumnName).ToString + "</" + dc.ColumnName + ">"
|
||||
End Try
|
||||
|
||||
|
||||
sw.WriteLine(s)
|
||||
Next
|
||||
sw.WriteLine("</" + t.TableName + ">")
|
||||
Next
|
||||
Next
|
||||
sw.WriteLine("</NewDataset>")
|
||||
sw.Close()
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub New()
|
||||
IntTimer.Enabled = True
|
||||
End Sub
|
||||
|
||||
#Region "Timer"
|
||||
Dim WithEvents IntTimer As New System.Timers.Timer(Globals.Check_Doc_Timer)
|
||||
|
||||
Sub Check_Doks() Handles IntTimer.Elapsed
|
||||
For i As Integer = 1 To FilesToWatch.Count
|
||||
Dim fw As Wachfile = FilesToWatch(i)
|
||||
Dim pid As Long = -1
|
||||
For ic As Integer = 1 To Globals.try_count_search
|
||||
Try
|
||||
Dim p As Process = Process.GetProcessById(fw.Prozessid)
|
||||
pid = p.Id
|
||||
Exit For
|
||||
Catch ex As Exception
|
||||
pid = -1
|
||||
If ex.Message.IndexOf("Es wird kein Prozess mit der ID") = -1 Then
|
||||
PerfMon.force_insert_entry(fw.Dokumentid + ": Process-ID Check_Doks fehlgeschlagen (Counter:" + ic.ToString + "):" + ex.Message)
|
||||
End If
|
||||
|
||||
End Try
|
||||
System.Threading.Thread.Sleep(100)
|
||||
Next ic
|
||||
|
||||
If pid < 1 Then
|
||||
IntTimer.Stop()
|
||||
Dim wl As WordLib = fw.WLib
|
||||
Try
|
||||
If wl.Finishing() Then
|
||||
If File.Exists(fw.datafilename) Then
|
||||
File.Delete(fw.datafilename)
|
||||
End If
|
||||
Else
|
||||
PerfMon.force_insert_entry(fw.Dokumentid + ": Finishing return false " + fw.Prozessid.ToString)
|
||||
|
||||
End If
|
||||
|
||||
Catch ex As Exception
|
||||
If Globals.Force_Watch_Message Then
|
||||
PerfMon.force_insert_entry(fw.Dokumentid + ": Dokument Finishing Fehler: Prozess-ID: " + fw.Prozessid.ToString + ": " + ex.Message)
|
||||
End If
|
||||
End Try
|
||||
FilesToWatch.Remove(i)
|
||||
IntTimer.Start()
|
||||
Exit Sub
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Prozessbearbeitung"
|
||||
Public Function doc_is_active(processid As Long) As Boolean
|
||||
|
||||
Dim Docfound As Boolean = False
|
||||
Try
|
||||
Dim p As Process = Process.GetProcessById(processid)
|
||||
If p.Id = processid Then
|
||||
Docfound = True
|
||||
If p.Id = 0 Then Docfound = False
|
||||
End If
|
||||
Catch ex As Exception
|
||||
Docfound = False
|
||||
End Try
|
||||
Return Docfound
|
||||
Exit Function
|
||||
End Function
|
||||
Public Function GetHandle(ByVal caption As String, Applicationtype As Integer, ByVal dokumentid As String) As String
|
||||
Try
|
||||
For i As Integer = 1 To Globals.try_count_search
|
||||
If Applicationtype = 1 Then
|
||||
For Each p As Process In Process.GetProcessesByName("winword")
|
||||
If p.MainWindowTitle.IndexOf(caption) > -1 Then
|
||||
Return p.Id.ToString
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
If Applicationtype = 2 Then
|
||||
For Each p As Process In Process.GetProcessesByName("excel")
|
||||
If p.MainWindowTitle.IndexOf(caption) > -1 Then
|
||||
Return p.Id.ToString
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
If Applicationtype <> 1 And Applicationtype <> 2 Then
|
||||
For Each p As Process In Process.GetProcesses
|
||||
If p.MainWindowTitle.IndexOf(caption) > -1 Then
|
||||
Return p.Id.ToString
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Next
|
||||
End If
|
||||
Thread.Sleep(500)
|
||||
Next i
|
||||
|
||||
Return 0
|
||||
Catch ex As Exception
|
||||
PerfMon.force_insert_entry(dokumentid + ": Prozess-ID konnte nicht ermittelt werden: " + ex.Message)
|
||||
End Try
|
||||
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
|
||||
Public Class Wachfile
|
||||
Dim m_applicationtype As Integer
|
||||
Property Applicationtype As Integer
|
||||
Get
|
||||
Return m_applicationtype
|
||||
End Get
|
||||
Set(value As Integer)
|
||||
m_applicationtype = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_dokumentid As String
|
||||
Property Dokumentid As String
|
||||
Get
|
||||
Return m_dokumentid
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_dokumentid = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_Prozessid As Long
|
||||
Property Prozessid As Long
|
||||
Get
|
||||
Return m_Prozessid
|
||||
End Get
|
||||
Set(value As Long)
|
||||
m_Prozessid = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_wlib As WordLib
|
||||
Property WLib As WordLib
|
||||
Get
|
||||
Return m_wlib
|
||||
End Get
|
||||
Set(value As WordLib)
|
||||
m_wlib = value
|
||||
End Set
|
||||
End Property
|
||||
Dim m_ts As String
|
||||
Property TS As String
|
||||
Get
|
||||
Return m_ts
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_ts = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_datafilename As String
|
||||
Property datafilename As String
|
||||
Get
|
||||
Return m_datafilename
|
||||
End Get
|
||||
Set(value As String)
|
||||
m_datafilename = value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Sub New(Apptype As Integer, dokid As String, procid As Long, wlib As WordLib, ts As String, datafilename As String)
|
||||
Me.Applicationtype = Apptype
|
||||
Me.Dokumentid = dokid
|
||||
Me.Prozessid = procid
|
||||
Me.WLib = wlib
|
||||
Me.TS = ts
|
||||
Me.datafilename = datafilename
|
||||
End Sub
|
||||
|
||||
|
||||
End Class
|
||||
29
EDOKA/Utils/OleCommandTarget.vb
Normal file
29
EDOKA/Utils/OleCommandTarget.vb
Normal file
@@ -0,0 +1,29 @@
|
||||
Imports System.Runtime.InteropServices
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Public Structure OLECMDTEXT
|
||||
Public cmdtextf As UInt32
|
||||
Public cwActual As UInt32
|
||||
Public cwBuf As UInt32
|
||||
Public rgwz As Char
|
||||
End Structure
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Public Structure OLECMD
|
||||
Public cmdID As Long
|
||||
Public cmdf As UInt64
|
||||
End Structure
|
||||
|
||||
' Interop definition for IOleCommandTarget.
|
||||
<ComImport(), Guid("b722bccb-4e68-101b-a2bc-00aa00404770"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
|
||||
Public Interface IOleCommandTarget
|
||||
' IMPORTANT: The order of the methods is critical here. We're going to
|
||||
' perform early binding in most cases, so the order of the methods
|
||||
' here MUST match the order of their vtable layout (which is determined
|
||||
' by their layout in IDL). The interop calls key off the vtable ordering,
|
||||
' not the symbolic names, so if you switched these method declarations
|
||||
' and attempted to call Exec() on an IOleCommandTarget interface from your
|
||||
' app, it would translate into a call to QueryStatus() instead.
|
||||
Sub QueryStatus(ByRef pguidCmdGroup As Guid, ByVal cCmds As UInt32, <MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=1)> ByVal prgCmds As OLECMD, ByRef pCmdText As OLECMDTEXT)
|
||||
Sub Exec(ByRef pguidCmdGroup As Guid, ByVal nCmdId As Long, ByVal nCmdExecOpt As Long, ByRef pvaIn As Object, ByRef pvaOut As Object)
|
||||
End Interface
|
||||
200
EDOKA/Utils/OwnerMenu.vb
Normal file
200
EDOKA/Utils/OwnerMenu.vb
Normal file
@@ -0,0 +1,200 @@
|
||||
Imports System.Drawing
|
||||
Imports System.Windows.Forms
|
||||
|
||||
Public Class OwnerMenu
|
||||
'holds menu items
|
||||
Private _MenuItems As New ArrayList()
|
||||
'default font
|
||||
Private _Font As Font = SystemInformation.MenuFont
|
||||
'default text color
|
||||
Private _TextColor As Color = System.Drawing.SystemColors.MenuText
|
||||
'constants
|
||||
Private Const NORMALITEMHEIGHT As Integer = 20
|
||||
Private Const SEPITEMHEIGHT As Integer = 12
|
||||
Private Const EXTRAWIDTH As Integer = 30
|
||||
Private Const ICONSIZE16 As Integer = 16
|
||||
|
||||
'structure to hold menu items
|
||||
Private Structure LocalMenuItem
|
||||
Dim MenuItemNumber As Integer
|
||||
Dim MenuItem As Windows.Forms.MenuItem
|
||||
Dim Icon As System.Drawing.Icon
|
||||
Dim IconRectangle As System.Drawing.Rectangle
|
||||
Dim TextLeft As Integer
|
||||
Dim TextTopPosition As Integer
|
||||
Dim Font As System.Drawing.Font
|
||||
Dim TextColor As System.Drawing.Color
|
||||
Dim Height As Integer
|
||||
Dim Width As Integer
|
||||
Dim IsSeperator As Boolean
|
||||
End Structure
|
||||
|
||||
Public Sub New()
|
||||
'
|
||||
End Sub
|
||||
'various constructors for the class
|
||||
Public Sub New(ByVal Font As System.Drawing.Font)
|
||||
_Font = Font
|
||||
If _Font.Size > 12 Then
|
||||
_Font = New Font(_Font.Name, 12, _Font.Style)
|
||||
End If
|
||||
End Sub
|
||||
Public Sub New(ByVal TextColor As System.Drawing.Color)
|
||||
_TextColor = TextColor
|
||||
End Sub
|
||||
Public Sub New(ByVal Font As System.Drawing.Font, _
|
||||
ByVal TextColor As System.Drawing.Color)
|
||||
_TextColor = TextColor
|
||||
_Font = Font
|
||||
If _Font.Size > 12 Then
|
||||
_Font = New Font(_Font.Name, 12, _Font.Style)
|
||||
End If
|
||||
End Sub
|
||||
'various constructors for the add method
|
||||
Public Sub Add(ByVal MenuItem As Windows.Forms.MenuItem, _
|
||||
ByVal Icon As System.Drawing.Icon, _
|
||||
ByVal MenuItemNumber As Integer, _
|
||||
ByVal IsSeperator As Boolean)
|
||||
Me.Add(MenuItem, Icon, MenuItemNumber, IsSeperator, _Font, _TextColor)
|
||||
End Sub
|
||||
Public Sub Add(ByVal MenuItem As Windows.Forms.MenuItem, _
|
||||
ByVal Icon As System.Drawing.Icon, _
|
||||
ByVal MenuItemNumber As Integer, _
|
||||
ByVal IsSeperator As Boolean, _
|
||||
ByVal Font As System.Drawing.Font)
|
||||
Me.Add(MenuItem, Icon, MenuItemNumber, IsSeperator, Font, _TextColor)
|
||||
End Sub
|
||||
|
||||
Public Sub Add(ByVal MenuItem As Windows.Forms.MenuItem, _
|
||||
ByVal Bitmap As System.Drawing.Bitmap, _
|
||||
ByVal MenuItemNumber As Integer, _
|
||||
ByVal IsSeperator As Boolean)
|
||||
Dim Icon As Icon
|
||||
Dim intIndexOfImageIWant As Int16 = 1
|
||||
Icon = System.Drawing.Icon.FromHandle(Bitmap.GetHicon)
|
||||
Me.Add(MenuItem, Icon, MenuItemNumber, IsSeperator, _Font, _TextColor)
|
||||
End Sub
|
||||
|
||||
Public Sub Add(ByVal MenuItem As Windows.Forms.MenuItem, _
|
||||
ByVal Icon As System.Drawing.Icon, _
|
||||
ByVal MenuItemNumber As Integer, _
|
||||
ByVal IsSeperator As Boolean, _
|
||||
ByVal Font As System.Drawing.Font, _
|
||||
ByVal TextColor As System.Drawing.Color)
|
||||
'hold and save the last top and left position
|
||||
Static LastTopPosition As Integer
|
||||
Static LastLeftPosition As Integer
|
||||
Dim li As New LocalMenuItem()
|
||||
If MenuItemNumber = 0 Then
|
||||
LastLeftPosition = 2
|
||||
LastTopPosition = 0
|
||||
Else
|
||||
'calculate the new top position
|
||||
LastTopPosition = LastTopPosition + IIf(IsSeperator, _
|
||||
SEPITEMHEIGHT, NORMALITEMHEIGHT)
|
||||
LastLeftPosition = 2
|
||||
End If
|
||||
Const ICONWIDTH As Integer = ICONSIZE16
|
||||
Const ICONHEIGHT As Integer = ICONSIZE16
|
||||
Dim IconRect As Rectangle
|
||||
'calculate new drawing rectangle for icon
|
||||
If IsSeperator Then
|
||||
IconRect = New Rectangle(LastLeftPosition, LastTopPosition, _
|
||||
ICONWIDTH, ICONHEIGHT)
|
||||
Else
|
||||
IconRect = New Rectangle(LastLeftPosition, LastTopPosition + 2, _
|
||||
ICONWIDTH, ICONHEIGHT)
|
||||
End If
|
||||
'you don't need to set ownerdraw - the class does it for you
|
||||
MenuItem.OwnerDraw = True
|
||||
With li
|
||||
.MenuItemNumber = MenuItemNumber
|
||||
.Font = Font
|
||||
.MenuItem = MenuItem
|
||||
.Icon = Icon
|
||||
.TextLeft = LastLeftPosition + ICONWIDTH
|
||||
.TextTopPosition = LastTopPosition
|
||||
.IconRectangle = IconRect
|
||||
.TextColor = TextColor
|
||||
.IsSeperator = IsSeperator
|
||||
End With
|
||||
_MenuItems.Add(li)
|
||||
'set the handlers for the menuitems
|
||||
AddHandler MenuItem.DrawItem, AddressOf Me.DrawItemHandler
|
||||
AddHandler MenuItem.MeasureItem, AddressOf Me.MesaureItemHandler
|
||||
End Sub
|
||||
|
||||
Private Sub DoDraw(ByVal LI As LocalMenuItem, _
|
||||
ByRef e As System.Windows.Forms.DrawItemEventArgs)
|
||||
e.DrawBackground()
|
||||
Const LastLeftPosition As Integer = 2
|
||||
Const ICONWIDTH As Integer = ICONSIZE16
|
||||
Dim ThisMenuItem As MenuItem = LI.MenuItem
|
||||
Dim MenuItemGraphics As Graphics = e.Graphics
|
||||
Dim bBypassString As Boolean
|
||||
'set size and textpoint for our text
|
||||
Dim SizeF As SizeF = e.Graphics.MeasureString(LI.MenuItem.Text, _Font)
|
||||
Dim TextPoint As PointF = New PointF(LI.TextLeft, _
|
||||
LI.TextTopPosition + ((NORMALITEMHEIGHT - SizeF.Height) / 2))
|
||||
Dim RectHeight As Integer = SizeF.Height
|
||||
If Not LI.Icon Is Nothing Then
|
||||
'draw the icon
|
||||
MenuItemGraphics.DrawIcon(New Icon(LI.Icon, _
|
||||
ICONSIZE16, ICONSIZE16), LI.IconRectangle)
|
||||
ElseIf LI.IsSeperator Then
|
||||
'draw the separator
|
||||
MenuItemGraphics.DrawLine(New Pen(LI.TextColor, 1), _
|
||||
TextPoint.X, TextPoint.Y + 11, _
|
||||
TextPoint.X + LI.Width + EXTRAWIDTH, TextPoint.Y + 11)
|
||||
bBypassString = True
|
||||
End If
|
||||
If Not bBypassString Then
|
||||
'bypass string if separator
|
||||
'draw differently if enabled/dsabled
|
||||
If LI.MenuItem.Enabled Then
|
||||
MenuItemGraphics.DrawString(Replace(LI.MenuItem.Text, "&", ""), _
|
||||
LI.Font, New SolidBrush(LI.TextColor), TextPoint)
|
||||
Else
|
||||
MenuItemGraphics.DrawString(Replace(LI.MenuItem.Text, "&", ""), _
|
||||
LI.Font, New SolidBrush(Drawing.SystemColors.GrayText), TextPoint)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
Private Sub DoMeasure(ByVal LI As LocalMenuItem, _
|
||||
ByRef e As System.Windows.Forms.MeasureItemEventArgs)
|
||||
'calculate the size of the drawing area
|
||||
Dim ThisMenuItem_Strings As String() = LI.MenuItem.Text.Split(",")
|
||||
Dim TextSize As SizeF = e.Graphics.MeasureString( _
|
||||
ThisMenuItem_Strings(0).Replace("&", ""), LI.Font)
|
||||
e.ItemWidth = TextSize.Width + EXTRAWIDTH
|
||||
If LI.MenuItem.Text = "-" Then
|
||||
e.ItemHeight = SEPITEMHEIGHT
|
||||
Else
|
||||
e.ItemHeight = NORMALITEMHEIGHT
|
||||
End If
|
||||
LI.Height = e.ItemHeight
|
||||
LI.Width = e.ItemWidth
|
||||
End Sub
|
||||
Public Sub DrawItemHandler(ByVal sender As Object, _
|
||||
ByVal e As System.Windows.Forms.DrawItemEventArgs)
|
||||
'look through the items and find out which one we are drawing
|
||||
Dim li As LocalMenuItem
|
||||
For Each li In _MenuItems
|
||||
If li.MenuItem Is sender Then
|
||||
DoDraw(li, e)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
Public Sub MesaureItemHandler(ByVal sender As Object, _
|
||||
ByVal e As System.Windows.Forms.MeasureItemEventArgs)
|
||||
'look through the items and find out which one we are measuring
|
||||
Dim li As LocalMenuItem
|
||||
For Each li In _MenuItems
|
||||
If li.MenuItem Is sender Then
|
||||
DoMeasure(li, e)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
End Class
|
||||
42
EDOKA/Utils/RichTextBoxEx.resx
Normal file
42
EDOKA/Utils/RichTextBoxEx.resx
Normal file
@@ -0,0 +1,42 @@
|
||||
<?xml version="1.0" encoding="utf-8" ?>
|
||||
<root>
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="ResMimeType">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="Version">
|
||||
<value>1.0.0.0</value>
|
||||
</resheader>
|
||||
<resheader name="Reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="Writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
</root>
|
||||
308
EDOKA/Utils/RichTextBoxEx.vb
Normal file
308
EDOKA/Utils/RichTextBoxEx.vb
Normal file
@@ -0,0 +1,308 @@
|
||||
Imports System
|
||||
Imports System.Windows.Forms
|
||||
Imports System.Drawing
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Drawing.Printing
|
||||
|
||||
' An extension to RichTextBox suitable for printing
|
||||
Public Class RichTextBoxEx
|
||||
Inherits RichTextBox
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Private Structure STRUCT_RECT
|
||||
Public left As Int32
|
||||
Public top As Int32
|
||||
Public right As Int32
|
||||
Public bottom As Int32
|
||||
End Structure
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Private Structure STRUCT_CHARRANGE
|
||||
Public cpMin As Int32
|
||||
Public cpMax As Int32
|
||||
End Structure
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Private Structure STRUCT_FORMATRANGE
|
||||
Public hdc As IntPtr
|
||||
Public hdcTarget As IntPtr
|
||||
Public rc As STRUCT_RECT
|
||||
Public rcPage As STRUCT_RECT
|
||||
Public chrg As STRUCT_CHARRANGE
|
||||
End Structure
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Private Structure STRUCT_CHARFORMAT
|
||||
Public cbSize As Integer
|
||||
Public dwMask As UInt32
|
||||
Public dwEffects As UInt32
|
||||
Public yHeight As Int32
|
||||
Public yOffset As Int32
|
||||
Public crTextColor As Int32
|
||||
Public bCharSet As Byte
|
||||
Public bPitchAndFamily As Byte
|
||||
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> _
|
||||
Public szFaceName() As Char
|
||||
End Structure
|
||||
|
||||
<DllImport("user32.dll")> _
|
||||
Private Shared Function SendMessage(ByVal hWnd As IntPtr, _
|
||||
ByVal msg As Int32, _
|
||||
ByVal wParam As Int32, _
|
||||
ByVal lParam As IntPtr) As Int32
|
||||
End Function
|
||||
|
||||
' Windows Message defines
|
||||
Private Const WM_USER As Int32 = &H400&
|
||||
Private Const EM_FORMATRANGE As Int32 = WM_USER + 57
|
||||
Private Const EM_GETCHARFORMAT As Int32 = WM_USER + 58
|
||||
Private Const EM_SETCHARFORMAT As Int32 = WM_USER + 68
|
||||
|
||||
' Defines for EM_GETCHARFORMAT/EM_SETCHARFORMAT
|
||||
Private SCF_SELECTION As Int32 = &H1&
|
||||
Private SCF_WORD As Int32 = &H2&
|
||||
Private SCF_ALL As Int32 = &H4&
|
||||
|
||||
' Defines for STRUCT_CHARFORMAT member dwMask
|
||||
' (Long because UInt32 is not an intrinsic type)
|
||||
Private Const CFM_BOLD As Long = &H1&
|
||||
Private Const CFM_ITALIC As Long = &H2&
|
||||
Private Const CFM_UNDERLINE As Long = &H4&
|
||||
Private Const CFM_STRIKEOUT As Long = &H8&
|
||||
Private Const CFM_PROTECTED As Long = &H10&
|
||||
Private Const CFM_LINK As Long = &H20&
|
||||
Private Const CFM_SIZE As Long = &H80000000&
|
||||
Private Const CFM_COLOR As Long = &H40000000&
|
||||
Private Const CFM_FACE As Long = &H20000000&
|
||||
Private Const CFM_OFFSET As Long = &H10000000&
|
||||
Private Const CFM_CHARSET As Long = &H8000000&
|
||||
|
||||
' Defines for STRUCT_CHARFORMAT member dwEffects
|
||||
Private Const CFE_BOLD As Long = &H1&
|
||||
Private Const CFE_ITALIC As Long = &H2&
|
||||
Private Const CFE_UNDERLINE As Long = &H4&
|
||||
Private Const CFE_STRIKEOUT As Long = &H8&
|
||||
Private Const CFE_PROTECTED As Long = &H10&
|
||||
Private Const CFE_LINK As Long = &H20&
|
||||
Private Const CFE_AUTOCOLOR As Long = &H40000000&
|
||||
|
||||
' Calculate or render the contents of our RichTextBox for printing
|
||||
'
|
||||
' Parameter "measureOnly": If true, only the calculation is performed,
|
||||
' otherwise the text is rendered as well
|
||||
' Parameter "e": The PrintPageEventArgs object from the PrintPage event
|
||||
' Parameter "charFrom": Index of first character to be printed
|
||||
' Parameter "charTo": Index of last character to be printed
|
||||
' Return value: (Index of last character that fitted on the page) + 1
|
||||
Public Function FormatRange(ByVal measureOnly As Boolean, _
|
||||
ByVal e As PrintPageEventArgs, _
|
||||
ByVal charFrom As Integer, _
|
||||
ByVal charTo As Integer) As Integer
|
||||
' Specify which characters to print
|
||||
Dim cr As STRUCT_CHARRANGE
|
||||
cr.cpMin = charFrom
|
||||
cr.cpMax = charTo
|
||||
|
||||
' Specify the area inside page margins
|
||||
Dim rc As STRUCT_RECT
|
||||
rc.top = HundredthInchToTwips(e.MarginBounds.Top)
|
||||
rc.bottom = HundredthInchToTwips(e.MarginBounds.Bottom)
|
||||
rc.left = HundredthInchToTwips(e.MarginBounds.Left)
|
||||
rc.right = HundredthInchToTwips(e.MarginBounds.Right)
|
||||
|
||||
' Specify the page area
|
||||
Dim rcPage As STRUCT_RECT
|
||||
rcPage.top = HundredthInchToTwips(e.PageBounds.Top)
|
||||
rcPage.bottom = HundredthInchToTwips(e.PageBounds.Bottom)
|
||||
rcPage.left = HundredthInchToTwips(e.PageBounds.Left)
|
||||
rcPage.right = HundredthInchToTwips(e.PageBounds.Right)
|
||||
|
||||
' Get device context of output device
|
||||
Dim hdc As IntPtr
|
||||
hdc = e.Graphics.GetHdc()
|
||||
|
||||
' Fill in the FORMATRANGE structure
|
||||
Dim fr As STRUCT_FORMATRANGE
|
||||
fr.chrg = cr
|
||||
fr.hdc = hdc
|
||||
fr.hdcTarget = hdc
|
||||
fr.rc = rc
|
||||
fr.rcPage = rcPage
|
||||
|
||||
' Non-Zero wParam means render, Zero means measure
|
||||
Dim wParam As Int32
|
||||
If measureOnly Then
|
||||
wParam = 0
|
||||
Else
|
||||
wParam = 1
|
||||
End If
|
||||
|
||||
' Allocate memory for the FORMATRANGE struct and
|
||||
' copy the contents of our struct to this memory
|
||||
Dim lParam As IntPtr
|
||||
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(fr))
|
||||
Marshal.StructureToPtr(fr, lParam, False)
|
||||
|
||||
' Send the actual Win32 message
|
||||
Dim res As Integer
|
||||
res = SendMessage(Handle, EM_FORMATRANGE, wParam, lParam)
|
||||
|
||||
' Free allocated memory
|
||||
Marshal.FreeCoTaskMem(lParam)
|
||||
|
||||
' and release the device context
|
||||
e.Graphics.ReleaseHdc(hdc)
|
||||
|
||||
Return res
|
||||
End Function
|
||||
|
||||
' Convert between 1/100 inch (unit used by the .NET framework)
|
||||
' and twips (1/1440 inch, used by Win32 API calls)
|
||||
'
|
||||
' Parameter "n": Value in 1/100 inch
|
||||
' Return value: Value in twips
|
||||
Private Function HundredthInchToTwips(ByVal n As Integer) As Int32
|
||||
Return Convert.ToInt32(n * 14.4)
|
||||
End Function
|
||||
|
||||
' Free cached data from rich edit control after printing
|
||||
Public Sub FormatRangeDone()
|
||||
Dim lParam As New IntPtr(0)
|
||||
SendMessage(Handle, EM_FORMATRANGE, 0, lParam)
|
||||
End Sub
|
||||
|
||||
' Sets the font only for the selected part of the rich text box
|
||||
' without modifying the other properties like size or style
|
||||
' <param name="face">Name of the font to use</param>
|
||||
' <returns>true on success, false on failure</returns>
|
||||
Public Function SetSelectionFont(ByVal face as String) As Boolean
|
||||
Dim cf As New STRUCT_CHARFORMAT()
|
||||
cf.cbSize = Marshal.SizeOf(cf)
|
||||
cf.dwMask = Convert.ToUInt32(CFM_FACE)
|
||||
|
||||
' ReDim face name to relevant size
|
||||
ReDim cf.szFaceName(32)
|
||||
face.CopyTo(0, cf.szFaceName, 0, Math.Min(31, face.Length))
|
||||
|
||||
Dim lParam As IntPtr
|
||||
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
|
||||
Marshal.StructureToPtr(cf, lParam, False)
|
||||
|
||||
Dim res As Integer
|
||||
res = SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, lParam)
|
||||
If (res = 0) Then
|
||||
Return True
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Sets the font size only for the selected part of the rich text box
|
||||
' without modifying the other properties like font or style
|
||||
' <param name="size">new point size to use</param>
|
||||
' <returns>true on success, false on failure</returns>
|
||||
Public Function SetSelectionSize(ByVal size As Integer) As Boolean
|
||||
Dim cf As New STRUCT_CHARFORMAT()
|
||||
cf.cbSize = Marshal.SizeOf(cf)
|
||||
cf.dwMask = Convert.ToUInt32(CFM_SIZE)
|
||||
' yHeight is in 1/20 pt
|
||||
cf.yHeight = size * 20
|
||||
|
||||
Dim lParam As IntPtr
|
||||
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
|
||||
Marshal.StructureToPtr(cf, lParam, False)
|
||||
|
||||
Dim res As Integer
|
||||
res = SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, lParam)
|
||||
If (res = 0) Then
|
||||
Return True
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Sets the bold style only for the selected part of the rich text box
|
||||
' without modifying the other properties like font or size
|
||||
' <param name="bold">make selection bold (true) or regular (false)</param>
|
||||
' <returns>true on success, false on failure</returns>
|
||||
Public Function SetSelectionBold(ByVal bold As Boolean) As Boolean
|
||||
If (bold) Then
|
||||
Return SetSelectionStyle(CFM_BOLD, CFE_BOLD)
|
||||
Else
|
||||
Return SetSelectionStyle(CFM_BOLD, 0)
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Sets the italic style only for the selected part of the rich text box
|
||||
' without modifying the other properties like font or size
|
||||
' <param name="italic">make selection italic (true) or regular (false)</param>
|
||||
' <returns>true on success, false on failure</returns>
|
||||
Public Function SetSelectionItalic(ByVal italic As Boolean) As Boolean
|
||||
If (italic) Then
|
||||
Return SetSelectionStyle(CFM_ITALIC, CFE_ITALIC)
|
||||
Else
|
||||
Return SetSelectionStyle(CFM_ITALIC, 0)
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Sets the underlined style only for the selected part of the rich text box
|
||||
' without modifying the other properties like font or size
|
||||
' <param name="underlined">make selection underlined (true) or regular (false)</param>
|
||||
' <returns>true on success, false on failure</returns>
|
||||
Public Function SetSelectionUnderlined(ByVal underlined As Boolean) As Boolean
|
||||
If (underlined) Then
|
||||
Return SetSelectionStyle(CFM_UNDERLINE, CFE_UNDERLINE)
|
||||
Else
|
||||
Return SetSelectionStyle(CFM_UNDERLINE, 0)
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Set the style only for the selected part of the rich text box
|
||||
' with the possibility to mask out some styles that are not to be modified
|
||||
' <param name="mask">modify which styles?</param>
|
||||
' <param name="effect">new values for the styles</param>
|
||||
' <returns>true on success, false on failure</returns>
|
||||
Private Function SetSelectionStyle(ByVal mask As Int32, ByVal effect As Int32) As Boolean
|
||||
Dim cf As New STRUCT_CHARFORMAT()
|
||||
cf.cbSize = Marshal.SizeOf(cf)
|
||||
cf.dwMask = Convert.ToUInt32(mask)
|
||||
cf.dwEffects = Convert.ToUInt32(effect)
|
||||
|
||||
Dim lParam As IntPtr
|
||||
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
|
||||
Marshal.StructureToPtr(cf, lParam, False)
|
||||
|
||||
Dim res As Integer
|
||||
res = SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, lParam)
|
||||
If (res = 0) Then
|
||||
Return True
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Public Sub New(ByRef cbo As RichTextBox)
|
||||
Me.Anchor = cbo.Anchor
|
||||
Me.BackColor = cbo.BackColor
|
||||
Me.BackgroundImage = cbo.BackgroundImage
|
||||
Me.CausesValidation = cbo.CausesValidation
|
||||
Me.ContextMenu = cbo.ContextMenu
|
||||
Me.Dock = cbo.Dock
|
||||
Me.Enabled = cbo.Enabled
|
||||
Me.Font = cbo.Font
|
||||
Me.ForeColor = cbo.ForeColor
|
||||
Me.MaxLength = cbo.MaxLength
|
||||
Me.Text = cbo.Text
|
||||
Me.TabStop = cbo.TabStop
|
||||
Me.Visible = cbo.Visible
|
||||
Me.Location = cbo.Location
|
||||
Me.Size = cbo.Size
|
||||
Me.TabIndex = cbo.TabIndex
|
||||
Dim parent As Object = cbo.Parent
|
||||
parent.Controls.Remove(cbo)
|
||||
parent.Controls.Add(Me)
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
42
EDOKA/Utils/RichTextBoxHS.resx
Normal file
42
EDOKA/Utils/RichTextBoxHS.resx
Normal file
@@ -0,0 +1,42 @@
|
||||
<?xml version="1.0" encoding="utf-8" ?>
|
||||
<root>
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="ResMimeType">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="Version">
|
||||
<value>1.0.0.0</value>
|
||||
</resheader>
|
||||
<resheader name="Reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="Writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
</root>
|
||||
161
EDOKA/Utils/RichTextBoxHS.vb
Normal file
161
EDOKA/Utils/RichTextBoxHS.vb
Normal file
@@ -0,0 +1,161 @@
|
||||
Imports System.Drawing
|
||||
Imports System.Text
|
||||
Public Class RichTextBoxHS
|
||||
Inherits Windows.Forms.RichTextBox
|
||||
|
||||
#Region " Windows Form Designer generated code "
|
||||
|
||||
Public Sub New()
|
||||
MyBase.New()
|
||||
|
||||
'This call is required by the Windows Form Designer.
|
||||
InitializeComponent()
|
||||
|
||||
'Add any initialization after the InitializeComponent() call
|
||||
|
||||
End Sub
|
||||
|
||||
'Form overrides dispose to clean up the component list.
|
||||
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If disposing Then
|
||||
If Not (components Is Nothing) Then
|
||||
components.Dispose()
|
||||
End If
|
||||
End If
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
|
||||
'Required by the Windows Form Designer
|
||||
Private components As System.ComponentModel.IContainer
|
||||
|
||||
'NOTE: The following procedure is required by the Windows Form Designer
|
||||
'It can be modified using the Windows Form Designer.
|
||||
'Do not modify it using the code editor.
|
||||
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
|
||||
components = New System.ComponentModel.Container()
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
Public WriteOnly Property SelectionBackColor() As Color
|
||||
Set(ByVal Value As Color)
|
||||
'First, test SelectedText property NOT SelectedRTF property because
|
||||
'...SelectedRTF will never be nothing, it will always have at least
|
||||
'...the current default Font table
|
||||
If Me.SelectedText Is Nothing Then Exit Property
|
||||
Dim sb As New StringBuilder() 'use StringBuilder for speed and cleanliness
|
||||
Dim SelText As String = Me.SelectedRtf 'move to local string for speed
|
||||
Dim strTemp As String 'used twice for ease of calculating internal coordinates
|
||||
Dim FontTableEnds As Integer 'end character of the rtf font table
|
||||
Dim ColorTableBegins As Integer 'beginning of the rtf color table
|
||||
Dim ColorTableEnds As Integer 'end of the rtf color table
|
||||
Dim StartLooking As Integer 'used to walk a string appending chunks
|
||||
Dim HighlightBlockStart As Integer 'used to find "\highlight#" block for stripping
|
||||
Dim HighlightBlockEnd As Integer 'used to find "\highlight#" block for stripping
|
||||
Dim cycl As Integer 'used in For/Next loops
|
||||
Dim NewColorIndex As Integer = 0 'new color table index for incoming color
|
||||
'find the end of the font table
|
||||
FontTableEnds = InStr(1, SelText, "}}")
|
||||
'add the header and font table to the string accumulator
|
||||
sb.Append(Mid(SelText, 1, FontTableEnds + 1))
|
||||
'find the color table start
|
||||
ColorTableBegins = InStr(FontTableEnds, SelText, "{\colortbl")
|
||||
If ColorTableBegins = 0 Then 'no color table exists
|
||||
'add a color table header
|
||||
sb.Append("{\colortbl ;")
|
||||
'no color table so for later use make the ColorTableEnd the same as FontTableEnds
|
||||
ColorTableEnds = FontTableEnds
|
||||
'default our new color table index to 1 since it will be the only one
|
||||
'remember Color table index 0 is reserved
|
||||
NewColorIndex = 1
|
||||
Else 'a color table already exists
|
||||
'find the end of the color table
|
||||
ColorTableEnds = InStr(ColorTableBegins, SelText, "}")
|
||||
'backup one character so as to exclude the brace
|
||||
ColorTableEnds -= 1
|
||||
'need to count the quantity of semi;colons which will
|
||||
'... determine what color table index number our new color will be
|
||||
strTemp = Mid(SelText, FontTableEnds + 2, (ColorTableEnds - FontTableEnds) - 1)
|
||||
For cycl = 1 To strTemp.Length
|
||||
If Mid(strTemp, cycl, 1) = ";" Then NewColorIndex += 1
|
||||
Next
|
||||
'append the color table without end brace
|
||||
sb.Append(strTemp)
|
||||
End If
|
||||
'append the color table entry for the highlight color
|
||||
sb.Append("\red" & Trim(Value.R.ToString))
|
||||
sb.Append("\green" & Trim(Value.G.ToString))
|
||||
sb.Append("\blue" & Trim(Value.B.ToString))
|
||||
'append the table entry terminator semi;colon
|
||||
sb.Append(";")
|
||||
'append the color table terminating brace
|
||||
sb.Append("}")
|
||||
'append the new highlight tag
|
||||
sb.Append("\highlight" & Trim(NewColorIndex.ToString))
|
||||
'Drop into a single string for easier manipulation
|
||||
strTemp = Mid(SelText, ColorTableEnds + 2, (SelText.Length - ColorTableEnds) - 1)
|
||||
'begin at first character
|
||||
StartLooking = 1
|
||||
'append everything remaining, but strip all remaing highlight tags
|
||||
Do
|
||||
'find a "\highlight" block
|
||||
HighlightBlockStart = InStr(StartLooking, strTemp, "\highlight")
|
||||
'if no "\highlight" block found
|
||||
If HighlightBlockStart = 0 Then
|
||||
'append everything remaining
|
||||
sb.Append(Mid(strTemp, StartLooking, strTemp.Length - StartLooking))
|
||||
'we done appending
|
||||
Exit Do
|
||||
End If
|
||||
'calculate the end of the word "highlight"
|
||||
HighlightBlockEnd = HighlightBlockStart + 9
|
||||
'accomodate color tables with over 9 colors and thus multi-digit color indexes
|
||||
'Plus, watch for (and discard) ONE space if it immediately follows the last digit
|
||||
Do
|
||||
'keep stepping past end
|
||||
HighlightBlockEnd += 1
|
||||
'watch for (and discard) ONE space if it immediately follows the last digit
|
||||
If Mid(strTemp, HighlightBlockEnd + 1, 1) = " " Then
|
||||
HighlightBlockEnd += 1
|
||||
Exit Do
|
||||
End If
|
||||
'looking for the first non-numeric character
|
||||
Loop While InStr(1, "0123456789", Mid(strTemp, HighlightBlockEnd + 1, 1))
|
||||
'append this block
|
||||
sb.Append(Mid(strTemp, StartLooking, (HighlightBlockStart - StartLooking)))
|
||||
'move the start forward past the last "\highlight#" block
|
||||
StartLooking = HighlightBlockEnd + 1
|
||||
Loop
|
||||
Me.SelectedRtf = sb.ToString
|
||||
End Set
|
||||
End Property
|
||||
Public Sub FindHighlight(ByVal SearchText As String, ByVal HighlightColor As Color, ByVal MatchCase As Boolean, ByVal WholeWords As Boolean)
|
||||
Me.SuspendLayout()
|
||||
Dim StartLooking As Integer = 0
|
||||
Dim FoundAt As Integer
|
||||
Dim SearchLength As Integer
|
||||
Dim RTBfinds As RichTextBoxFinds
|
||||
If SearchText Is Nothing Then Exit Sub
|
||||
Select Case True
|
||||
Case MatchCase And WholeWords
|
||||
RTBfinds = RichTextBoxFinds.MatchCase Or RichTextBoxFinds.WholeWord
|
||||
Case MatchCase
|
||||
RTBfinds = RichTextBoxFinds.MatchCase
|
||||
Case WholeWords
|
||||
RTBfinds = RichTextBoxFinds.WholeWord
|
||||
Case Else
|
||||
RTBfinds = RichTextBoxFinds.None
|
||||
End Select
|
||||
SearchLength = SearchText.Length
|
||||
Do
|
||||
FoundAt = Me.Find(SearchText, StartLooking, RTBfinds)
|
||||
If FoundAt > -1 Then Me.SelectionBackColor = HighlightColor
|
||||
StartLooking = StartLooking + SearchLength
|
||||
Loop While FoundAt > -1
|
||||
Me.ResumeLayout()
|
||||
End Sub
|
||||
Public Sub BackColorSetWhole(ByVal BackColorDefault As Color)
|
||||
Me.SelectAll()
|
||||
Me.SelectionBackColor = BackColorDefault
|
||||
End Sub
|
||||
End Class
|
||||
618
EDOKA/Utils/Statushandling.vb
Normal file
618
EDOKA/Utils/Statushandling.vb
Normal file
@@ -0,0 +1,618 @@
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.ComponentModel
|
||||
Imports UtilityLibrary.Win32
|
||||
|
||||
Public Class Statushandling
|
||||
|
||||
#Region "Deklarationen"
|
||||
|
||||
Dim m_aktuellerstatus As Integer
|
||||
Dim m_neuerstatus As Integer
|
||||
Dim m_abgeschlossen As Boolean
|
||||
Dim m_ausgangsarchivierung As Boolean
|
||||
Dim m_eingangsarchivierung As Boolean
|
||||
Dim m_folgestatus As Boolean
|
||||
Dim m_dokumentid As String
|
||||
|
||||
Dim m_bemerkungverantwortlicher As String
|
||||
Property BemerkungVerantwortlicher() As String
|
||||
Get
|
||||
Return m_bemerkungverantwortlicher
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_bemerkungverantwortlicher = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Dokumentid() As String
|
||||
Get
|
||||
Return m_dokumentid
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_dokumentid = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property AktullerStatus() As Integer
|
||||
Get
|
||||
Return m_aktuellerstatus
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
m_aktuellerstatus = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property NeuerStatus() As Integer
|
||||
Get
|
||||
Return m_neuerstatus
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
m_neuerstatus = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property Ablgeschossen() As Boolean
|
||||
Get
|
||||
Return m_abgeschlossen
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_abgeschlossen = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property Ausgangsarchivierung() As Boolean
|
||||
Get
|
||||
Return m_ausgangsarchivierung
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_ausgangsarchivierung = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Eingangsarchivierung() As Boolean
|
||||
Get
|
||||
Return m_eingangsarchivierung
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_eingangsarchivierung = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Folgestatus() As Boolean
|
||||
Get
|
||||
Return m_folgestatus
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_folgestatus = Value
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
Dim dokumentwerte As DataTable
|
||||
|
||||
#Region "Meldungen"
|
||||
|
||||
Public Function Meldung_Verantwortlicher(ByVal dokumentid As String, ByVal verantwortlicher As Integer)
|
||||
Try
|
||||
dokumentwerte = GetDokumentwerte(dokumentid, 100, 0)
|
||||
insert_Message(1, dokumentid, Meldungstext_aufbereiten, parstext(dokumentwerte.Rows(0).Item("betreff")), Globals.MitarbeiterNr, verantwortlicher, 0)
|
||||
Catch
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function Meldung_Status(ByVal dokumentid As String, ByVal status As String)
|
||||
Try
|
||||
dokumentwerte = GetDokumentwerte(dokumentid, 102, status)
|
||||
insert_Message(0, dokumentid, Meldungstext_aufbereiten, parstext(dokumentwerte.Rows(0).Item("betreff")), Globals.MitarbeiterNr, 0, status)
|
||||
Catch
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function Meldung_Aufhebung(ByVal dokumentid As String, ByVal verantwortlicher As Integer)
|
||||
dokumentwerte = GetDokumentwerte(dokumentid, 110, 0)
|
||||
insert_Message(0, dokumentid, Meldungstext_aufbereiten, parstext(dokumentwerte.Rows(0).Item("betreff")), Globals.MitarbeiterNr, 0, 0)
|
||||
End Function
|
||||
|
||||
Public Function Meldungstext_aufbereiten() As String
|
||||
Dim s As String
|
||||
s = ""
|
||||
Try
|
||||
s = dokumentwerte.Rows(0).Item("meldung") + vbCrLf + dokumentwerte.Rows(0).Item("idvmeldung") + vbCrLf + dokumentwerte.Rows(0).Item("footer")
|
||||
If Me.BemerkungVerantwortlicher <> "" Then
|
||||
s = Me.BemerkungVerantwortlicher + vbCrLf + "------------------------" + vbCrLf + s
|
||||
' s = s + vbCrLf + vbCrLf + Me.BemerkungVerantwortlicher
|
||||
Me.BemerkungVerantwortlicher = ""
|
||||
End If
|
||||
s = parstext(s)
|
||||
Catch
|
||||
End Try
|
||||
Meldungstext_aufbereiten = s
|
||||
End Function
|
||||
|
||||
Public Function parstext(ByVal s As String) As String
|
||||
s = s.Replace("&dokumentid&", dokumentwerte.Rows(0).Item("dokumentid"))
|
||||
s = s.Replace("&nrpar00&", dokumentwerte.Rows(0).Item("nrpar00"))
|
||||
s = s.Replace("&bkpar00&", dokumentwerte.Rows(0).Item("bkpar00"))
|
||||
s = s.Replace("&dokumenttyp&", dokumentwerte.Rows(0).Item("bezeichnung"))
|
||||
s = s.Replace("&status&", dokumentwerte.Rows(0).Item("status"))
|
||||
s = s.Replace("&statusdatum&", Today)
|
||||
s = s.Replace("&verantwortlich&", dokumentwerte.Rows(0).Item("verantwortlich"))
|
||||
s = s.Replace("&absender&", dokumentwerte.Rows(0).Item("absender"))
|
||||
s = s.Replace("&empfaenger&", dokumentwerte.Rows(0).Item("empfaenger"))
|
||||
Return s
|
||||
End Function
|
||||
|
||||
Public Function GetDokumentwerte(ByVal Dokumentid As String, ByVal typ As Integer, ByVal status As Integer) As DataTable
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.SP_message_getdokumentwerte"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@typ", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, typ))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, status))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function insert_Message(ByVal typ As Integer, ByVal Dokumentid As String, ByVal message As String, ByVal betreff As String, _
|
||||
ByVal absender As Integer, ByVal empfaenger As Integer, ByVal status As Integer)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.SP_message_insert"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@absender", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, absender))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@empfaenger", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, empfaenger))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, betreff))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, message))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Dokumentid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@status", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, status))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@weiterleiten", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@typ", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, typ))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Datenzugriffe"
|
||||
Private Function Generic_Select(ByVal typ As Integer) As DataTable
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Select Case typ
|
||||
Case 1
|
||||
scmCmdToExecute.CommandText = "dbo.SP_Dokumentstatus_statushandling_Select"
|
||||
Case Else
|
||||
End Select
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
Select Case typ
|
||||
Case 1
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.Dokumentid))
|
||||
Case Else
|
||||
End Select
|
||||
If typ = 1 Then
|
||||
End If
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokumenterstellung::Generic_Select::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Archivierung"
|
||||
Public Function Set_Ausgangsarchiviert(ByVal dokumentid As String) As Integer
|
||||
Dim da As DataTable
|
||||
Dim currentstatus As Integer
|
||||
Dim i, i1 As Integer
|
||||
Me.Dokumentid = dokumentid
|
||||
da = Generic_Select(1)
|
||||
currentstatus = da.Rows(0).Item("dokument_statusnr")
|
||||
For i = 0 To da.Rows.Count - 1
|
||||
If da.Rows(i).Item("status_bezeichnungnr") = 3 Then
|
||||
For i1 = 0 To da.Rows.Count - 1
|
||||
If da.Rows(i1).Item("status_bezeichnungnr") = 4 Or _
|
||||
da.Rows(i1).Item("status_bezeichnungnr") = 5 Then
|
||||
Me.insert_history_status(da.Rows(i1).Item("dokument_statusnr"), dokumentid, Globals.MitarbeiterNr)
|
||||
Return da.Rows(i1).Item("dokument_statusnr")
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
da.Dispose()
|
||||
End Function
|
||||
|
||||
Public Function Set_Eingangsarchiviert(ByVal dokumentid As String) As Integer
|
||||
Dim da As DataTable
|
||||
Dim currentstatus As Integer
|
||||
Dim i, i1 As Integer
|
||||
Me.Dokumentid = dokumentid
|
||||
da = Generic_Select(1)
|
||||
currentstatus = da.Rows(0).Item("dokument_statusnr")
|
||||
For i1 = 0 To da.Rows.Count - 1
|
||||
If da.Rows(i1).Item("status_bezeichnungnr") = 6 Or _
|
||||
da.Rows(i1).Item("status_bezeichnungnr") = 7 Or _
|
||||
da.Rows(i1).Item("status_bezeichnungnr") = 11 Then
|
||||
Me.insert_history_status(da.Rows(i1).Item("dokument_statusnr"), dokumentid, Globals.MitarbeiterNr)
|
||||
MsgBox(da.Rows(i1).Item("dokument_statusnr"))
|
||||
Return da.Rows(i1).Item("dokument_statusnr")
|
||||
End If
|
||||
Next
|
||||
da.Dispose()
|
||||
End Function
|
||||
#End Region
|
||||
|
||||
Dim ds As New edokadb.clsDokument_status()
|
||||
|
||||
Public Sub Dispose()
|
||||
ds.Dispose()
|
||||
End Sub
|
||||
|
||||
Public Function Check_Neuer_Status()
|
||||
ds.cpMainConnectionProvider = conn
|
||||
ds.iDokument_statusnr = New SqlInt32(CType(Me.NeuerStatus, Int32))
|
||||
ds.SelectOne()
|
||||
|
||||
If ds.bFolgestatus_durch_anderen_verantwortlichen.Value = True Then
|
||||
Me.Folgestatus = True
|
||||
End If
|
||||
Me.Ausgangsarchivierung = False
|
||||
If ds.iStatus_bezeichnungnr.Value = 3 Or ds.bDokument_ausgangsarchivierung.Value = True Then
|
||||
Me.Ausgangsarchivierung = True
|
||||
End If
|
||||
If ds.bDokument_bearbeitung_abgeschlossen.Value = True Then
|
||||
Me.Ablgeschossen = True
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function insert_history_status(ByVal statusnr As Integer, ByVal dokumentid As String, ByVal Verantwortlicher As Integer)
|
||||
Dim sh As New edokadb.clsStatushistory()
|
||||
sh.cpMainConnectionProvider = conn
|
||||
Dim dbkey As New edokadb.clsMyKey_Tabelle()
|
||||
Dim key As Long
|
||||
dbkey.cpMainConnectionProvider = conn
|
||||
conn.OpenConnection()
|
||||
key = dbkey.get_dbkey("statushistory")
|
||||
sh.iStatushistorynr = New SqlInt32(CType(key, Int32))
|
||||
sh.iStatus = New SqlInt32(CType(statusnr, Int32))
|
||||
sh.iMandantnr = New SqlInt32(CType(Globals.MandantNr, Int32))
|
||||
sh.iMutierer = New SqlInt32(CType(Globals.MitarbeiterNr, Int32))
|
||||
sh.bAktiv = New SqlBoolean(True)
|
||||
sh.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
|
||||
sh.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
|
||||
sh.sDokumentid = New SqlString(CType(dokumentid, String))
|
||||
sh.iVerantwortlich = New SqlInt32(CType(Verantwortlicher, Int32))
|
||||
conn.OpenConnection()
|
||||
sh.Insert()
|
||||
conn.CloseConnection(True)
|
||||
dbkey.Dispose()
|
||||
sh.Dispose()
|
||||
End Function
|
||||
|
||||
Public Function insert_history_status_abschluss(ByVal statusnr As Integer, ByVal dokumentid As String, ByVal Verantwortlicher As Integer)
|
||||
Dim sh As New edokadb.clsStatushistory()
|
||||
sh.cpMainConnectionProvider = conn
|
||||
Dim dbkey As New edokadb.clsMyKey_Tabelle()
|
||||
Dim key As Long
|
||||
dbkey.cpMainConnectionProvider = conn
|
||||
conn.OpenConnection()
|
||||
key = dbkey.get_dbkey("statushistory")
|
||||
sh.iStatushistorynr = New SqlInt32(CType(key, Int32))
|
||||
sh.iStatus = New SqlInt32(CType(statusnr, Int32))
|
||||
sh.iMandantnr = New SqlInt32(CType(Globals.MandantNr, Int32))
|
||||
sh.iMutierer = New SqlInt32(CType(9998, Int32))
|
||||
sh.bAktiv = New SqlBoolean(True)
|
||||
sh.daErstellt_am = New SqlDateTime(CType(Now, DateTime))
|
||||
sh.daMutiert_am = New SqlDateTime(CType(Now, DateTime))
|
||||
sh.sDokumentid = New SqlString(CType(dokumentid, String))
|
||||
sh.iVerantwortlich = New SqlInt32(CType(Verantwortlicher, Int32))
|
||||
conn.OpenConnection()
|
||||
sh.Insert()
|
||||
conn.CloseConnection(True)
|
||||
dbkey.Dispose()
|
||||
sh.Dispose()
|
||||
End Function
|
||||
|
||||
Public Function Alle_Status(ByVal Dokumentid As String) As DataTable
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.SP_Trefferliste_Select_Status"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
|
||||
End Function
|
||||
|
||||
Public Function Status_Erstellen(ByVal dokumentid As String, ByVal blsequenz As Boolean)
|
||||
'Status_Erstellen_Overwrite(dokumentid, 0)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_dokumentberabeigung_status_erstellen"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
|
||||
If Globals.bckdokument = False Then
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@bck", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
Else
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@bck", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
|
||||
End If
|
||||
If blsequenz = False Then
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@blsequenz", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
Else
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@blsequenz", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
|
||||
End If
|
||||
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function Status_Erstellen_Overwrite(ByVal dokumentid As String, ByVal blsequenz As Boolean)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_dokument_status_import_erstellen"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@Statustyp", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 7))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Public Function check_abschluss(ByVal dokumentid As String, ByVal mitarbeiternr As Integer)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_dokumentberarbeitung_abschluss"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@abschlussstatus", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
i = scmCmdToExecute.Parameters.Item("@abschlussstatus").Value
|
||||
If i <> 0 Then
|
||||
insert_history_status_abschluss(i, dokumentid, 9998)
|
||||
Dokument_Abschliessen(dokumentid, i)
|
||||
End If
|
||||
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
|
||||
Public Function Dokument_Abschliessen(ByVal dokumentid As String, ByVal status As Integer)
|
||||
Dim dok As New edokadb.clsDokument()
|
||||
Dim dt As New edokadb.clsDokumenttyp()
|
||||
Dim par As New edokadb.clsPartner()
|
||||
Dim loeschung As Boolean = False
|
||||
|
||||
dok.cpMainConnectionProvider = conn
|
||||
par.cpMainConnectionProvider = conn
|
||||
dt.cpMainConnectionProvider = conn
|
||||
|
||||
dok.sDokumentid = New SqlString(CType(dokumentid, String))
|
||||
Try
|
||||
|
||||
dok.SelectOne()
|
||||
conn.OpenConnection()
|
||||
|
||||
|
||||
'Prüfung auf saldierten Partner und ggf. Dokument löschen bzw. aufheben
|
||||
par.iNRPAR00 = New SqlInt32(CType(dok.iNrpar00.Value, Int32))
|
||||
par.SelectOne()
|
||||
If par.bSaldiert.Value = True Then
|
||||
loeschung = True
|
||||
End If
|
||||
dok.iStatusnr = New SqlInt32(CType(status, Integer))
|
||||
dok.iVerantwortlich = New SqlInt32(CType(9998, Integer))
|
||||
dok.Update()
|
||||
conn.CloseConnection(True)
|
||||
Meldung_Status(dokumentid, status)
|
||||
|
||||
dt.iDokumenttypnr = New SqlInt32(CType(dok.iDokumenttypnr.Value, Int32))
|
||||
dt.SelectOne()
|
||||
If dt.bVertrag.Value = True Then
|
||||
If loeschung Then
|
||||
If loeschart(dok.sDokumentid.Value) = 1 Then
|
||||
MyMsg.show_standardmessage(232, MsgBoxStyle.Information)
|
||||
Insert_Note(dok.sDokumentid.Value, MyTxt.gettext(237))
|
||||
set_aufgehoben(dok.sDokumentid.Value)
|
||||
Else
|
||||
MyMsg.show_standardmessage(231, MsgBoxStyle.Information)
|
||||
Insert_Note(dok.sDokumentid.Value, MyTxt.gettext(236))
|
||||
set_geloescht(dok.sDokumentid.Value)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Sub Insert_Note(ByVal dokumentid As String, ByVal meldung As String)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
scmCmdToExecute.CommandText = "dbo.SP_Dokument_Notizen"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
scmCmdToExecute.Connection.Open()
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@notiznr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@betreff", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, meldung))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, meldung))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.ExecuteNonQuery()
|
||||
Catch ex As Exception
|
||||
'MsgBox(ex.Message)
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Connection.Close()
|
||||
scmCmdToExecute.Dispose()
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Function loeschart(ByVal dokid As String)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
scmCmdToExecute.CommandText = "dbo.SP_check_aufhebung_loeschung"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
conn.OpenConnection()
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@res", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
scmCmdToExecute.ExecuteNonQuery()
|
||||
Return scmCmdToExecute.Parameters("@res").Value
|
||||
Catch ex As Exception
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
conn.CloseConnection(True)
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Sub set_geloescht(ByVal dokid As String)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
scmCmdToExecute.CommandText = "dbo.SP_Dokument_delete"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
conn.OpenConnection()
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiter", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@loeschgrund", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "Gelöscht, da Partner saldiert ist"))
|
||||
scmCmdToExecute.ExecuteNonQuery()
|
||||
Catch ex As Exception
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
conn.CloseConnection(True)
|
||||
Dim dt As DataTable
|
||||
dt = get_coldindex_and_statusnr(dokid, False, False)
|
||||
Archivfnkt.insert_coldupdate_status(dt, dokid, "Alt")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Public Function set_aufgehoben(ByVal dokumentid As String)
|
||||
Dim dt As DataTable
|
||||
dt = get_coldindex_and_statusnr(dokumentid, True, False)
|
||||
Archivfnkt.insert_coldupdate_status(dt, dokumentid, "Alt")
|
||||
End Function
|
||||
|
||||
Public Function get_coldindex_and_statusnr(ByVal dokumentid As String, ByVal aufheben As Boolean, ByVal reaktivieren As Boolean) As DataTable
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_get_coldindex_and_aufhebungsstatus"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@reaktivieren", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, reaktivieren))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@aufhebungsstatus", SqlDbType.Int, 4, ParameterDirection.Output, True, 10, 0, "", DataRowVersion.Proposed, 0))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
i = scmCmdToExecute.Parameters.Item("@aufhebungsstatus").Value
|
||||
If (i <> 0 And aufheben) Or (i <> 0 And reaktivieren) Then
|
||||
insert_history_status(i, dokumentid, MitarbeiterNr)
|
||||
Dim d As New edokadb.clsDokument()
|
||||
d.cpMainConnectionProvider = conn
|
||||
d.sDokumentid = New SqlString(CType(dokumentid, String))
|
||||
d.SelectOne()
|
||||
d.iStatusnr = New SqlInt32(CType(i, Int32))
|
||||
'Rel. 3.6
|
||||
d.daMutiertam = New SqlDateTime(CType(Now(), DateTime))
|
||||
d.iMutierer = New SqlInt32(CType(Globals.MitarbeiterNr, Int32))
|
||||
|
||||
conn.OpenConnection()
|
||||
d.Update()
|
||||
conn.CloseConnection(True)
|
||||
d.Dispose()
|
||||
End If
|
||||
Return dtToReturn
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
' // some error occured. Bubble it to caller and encapsulate Exception object
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
End Class
|
||||
BIN
EDOKA/Utils/Utils.zip
Normal file
BIN
EDOKA/Utils/Utils.zip
Normal file
Binary file not shown.
115
EDOKA/Utils/WebOCHostCtrl.resx
Normal file
115
EDOKA/Utils/WebOCHostCtrl.resx
Normal file
@@ -0,0 +1,115 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<root>
|
||||
<!--
|
||||
Microsoft ResX Schema
|
||||
|
||||
Version 1.3
|
||||
|
||||
The primary goals of this format is to allow a simple XML format
|
||||
that is mostly human readable. The generation and parsing of the
|
||||
various data types are done through the TypeConverter classes
|
||||
associated with the data types.
|
||||
|
||||
Example:
|
||||
|
||||
... ado.net/XML headers & schema ...
|
||||
<resheader name="resmimetype">text/microsoft-resx</resheader>
|
||||
<resheader name="version">1.3</resheader>
|
||||
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
|
||||
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
|
||||
<data name="Name1">this is my long string</data>
|
||||
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
|
||||
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
[base64 mime encoded serialized .NET Framework object]
|
||||
</data>
|
||||
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
[base64 mime encoded string representing a byte array form of the .NET Framework object]
|
||||
</data>
|
||||
|
||||
There are any number of "resheader" rows that contain simple
|
||||
name/value pairs.
|
||||
|
||||
Each data row contains a name, and value. The row also contains a
|
||||
type or mimetype. Type corresponds to a .NET class that support
|
||||
text/value conversion through the TypeConverter architecture.
|
||||
Classes that don't support this are serialized and stored with the
|
||||
mimetype set.
|
||||
|
||||
The mimetype is used for serialized objects, and tells the
|
||||
ResXResourceReader how to depersist the object. This is currently not
|
||||
extensible. For a given mimetype the value must be set accordingly:
|
||||
|
||||
Note - application/x-microsoft.net.object.binary.base64 is the format
|
||||
that the ResXResourceWriter will generate, however the reader can
|
||||
read any of the formats listed below.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.binary.base64
|
||||
value : The object must be serialized with
|
||||
: System.Serialization.Formatters.Binary.BinaryFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.soap.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
mimetype: application/x-microsoft.net.object.bytearray.base64
|
||||
value : The object must be serialized into a byte array
|
||||
: using a System.ComponentModel.TypeConverter
|
||||
: and then encoded with base64 encoding.
|
||||
-->
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
|
||||
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="resmimetype">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="version">
|
||||
<value>1.3</value>
|
||||
</resheader>
|
||||
<resheader name="reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<data name="webBrowser.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="webBrowser.OcxState" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
<value>
|
||||
AAEAAAD/////AQAAAAAAAAAMAgAAAFpTeXN0ZW0uV2luZG93cy5Gb3JtcywgVmVyc2lvbj0xLjAuMzMw
|
||||
MC4wLCBDdWx0dXJlPW5ldXRyYWwsIFB1YmxpY0tleVRva2VuPWI3N2E1YzU2MTkzNGUwODkFAQAAACFT
|
||||
eXN0ZW0uV2luZG93cy5Gb3Jtcy5BeEhvc3QrU3RhdGUBAAAABERhdGEHAgIAAAAJAwAAAA8DAAAAsQAA
|
||||
AAIBAAAAAQAAAAAAAAAAAAAAAJwAAABMAAAAqj8AABMhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABM
|
||||
AAAAAAAAAAAAAAABAAAA4NBXAHM1zxGuaQgAKy4SYggAAAAAAAAATAAAAAEUAgAAAAAAwAAAAAAAAEaA
|
||||
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAL
|
||||
</value>
|
||||
</data>
|
||||
<data name="$this.Name">
|
||||
<value>WebOCHostCtrl</value>
|
||||
</data>
|
||||
</root>
|
||||
351
EDOKA/Utils/WebOCHostCtrl.vb
Normal file
351
EDOKA/Utils/WebOCHostCtrl.vb
Normal file
@@ -0,0 +1,351 @@
|
||||
' A WebBrowser host fashioned as a UserControl. This allows us to:
|
||||
' (1) Encapsulate common tasks while using the WebOC (performing actions on DocumentComplete, saving files to
|
||||
' disk, etc.).
|
||||
' (2) Reuse all the above functionality on different forms - particularly
|
||||
' useful for handling NewWindow2.
|
||||
|
||||
Imports mshtml
|
||||
Imports System.Resources
|
||||
|
||||
Public Class WebOCHostCtrl
|
||||
Inherits System.Windows.Forms.UserControl
|
||||
|
||||
' Expose WebBrowser events so that clients can sink them simply and
|
||||
' directly, without exposing the underlying control.
|
||||
Public Event CommandStateChange(ByVal Sender As Object, ByVal E As AxSHDocVw.DWebBrowserEvents2_CommandStateChangeEvent)
|
||||
Public Event EnableBack(ByVal Sender As Object, ByVal E As System.EventArgs)
|
||||
Public Event DisableBack(ByVal Sender As Object, ByVal E As System.EventArgs)
|
||||
Public Event EnableForward(ByVal Sender As Object, ByVal E As System.EventArgs)
|
||||
Public Event DisableForward(ByVal Sender As Object, ByVal E As System.EventArgs)
|
||||
Public Event StatusTextChange(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_StatusTextChangeEvent)
|
||||
Public Event DocumentComplete(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_DocumentCompleteEvent)
|
||||
Public Event TopLevelNavigateComplete2(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_NavigateComplete2Event)
|
||||
|
||||
' Instance data.
|
||||
Private enableCtxMenu As Boolean
|
||||
|
||||
' The current instance of MSHTML.
|
||||
Private WithEvents doc As HtmlDocument
|
||||
|
||||
' The GUID we need to invoke FInd, View Source and Options on
|
||||
' WebBrowser. Note that the second param is in its two complement
|
||||
' representation because the number otherwise outstrips the size
|
||||
' of a VB short.
|
||||
'Private cmdGUID As New Guid(&HED016940, -17061, &H11CF, &HBA, &H4E, &H0, &HC0, &H4F, &HD7, &H8, &H16)
|
||||
|
||||
' Constants for the above-named commands
|
||||
Private Enum MiscCommandTarget
|
||||
Find = 1
|
||||
ViewSource
|
||||
Options
|
||||
End Enum
|
||||
|
||||
' Constants for regular OLECMDID command targets.
|
||||
|
||||
|
||||
' Constants for forward/back testing.
|
||||
Enum CommandState
|
||||
UpdateCommands = -1
|
||||
Forward = 1
|
||||
Back = 2
|
||||
End Enum
|
||||
|
||||
#Region " Windows Form Designer generated code "
|
||||
|
||||
Public Sub New()
|
||||
MyBase.New()
|
||||
|
||||
'This call is required by the Windows Form Designer.
|
||||
InitializeComponent()
|
||||
|
||||
'Add any initialization after the InitializeComponent() call
|
||||
|
||||
' Load resources.
|
||||
rm = New ResourceManager("WebOCHostCtrl", System.Reflection.Assembly.GetExecutingAssembly())
|
||||
End Sub
|
||||
|
||||
'UserControl overrides dispose to clean up the component list.
|
||||
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If disposing Then
|
||||
If Not (components Is Nothing) Then
|
||||
components.Dispose()
|
||||
End If
|
||||
|
||||
rm = Nothing
|
||||
End If
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
|
||||
'Required by the Windows Form Designer
|
||||
Private components As System.ComponentModel.IContainer
|
||||
|
||||
'NOTE: The following procedure is required by the Windows Form Designer
|
||||
'It can be modified using the Windows Form Designer.
|
||||
'Do not modify it using the code editor.
|
||||
Friend WithEvents webBrowser As AxSHDocVw.AxWebBrowser
|
||||
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
|
||||
Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(WebOCHostCtrl))
|
||||
Me.webBrowser = New AxSHDocVw.AxWebBrowser()
|
||||
CType(Me.webBrowser, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'webBrowser
|
||||
'
|
||||
Me.webBrowser.Anchor = (((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
|
||||
Or System.Windows.Forms.AnchorStyles.Left) _
|
||||
Or System.Windows.Forms.AnchorStyles.Right)
|
||||
Me.webBrowser.Enabled = True
|
||||
Me.webBrowser.OcxState = CType(resources.GetObject("webBrowser.OcxState"), System.Windows.Forms.AxHost.State)
|
||||
Me.webBrowser.Size = New System.Drawing.Size(616, 320)
|
||||
Me.webBrowser.TabIndex = 0
|
||||
'
|
||||
'WebOCHostCtrl
|
||||
'
|
||||
Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.webBrowser})
|
||||
Me.Name = "WebOCHostCtrl"
|
||||
Me.Size = New System.Drawing.Size(616, 320)
|
||||
CType(Me.webBrowser, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
'
|
||||
' PRIVATE INSTANCE VARIABLES
|
||||
'
|
||||
Private rm As ResourceManager
|
||||
|
||||
'
|
||||
' PROPERTIES
|
||||
'
|
||||
|
||||
' Obtain a reference to the hosted HTML document.
|
||||
Public ReadOnly Property HtmlDocument() As mshtml.HTMLDocument
|
||||
Get
|
||||
Dim doc As HTMLDocument
|
||||
Try
|
||||
doc = CType(webBrowser.Document, mshtml.HTMLDocument)
|
||||
Catch
|
||||
Throw (New Exception(rm.GetString("Err_HtmlDocumentNotReady")))
|
||||
End Try
|
||||
|
||||
HtmlDocument = doc
|
||||
End Get
|
||||
End Property
|
||||
|
||||
'
|
||||
' METHODS
|
||||
'
|
||||
|
||||
' Define a simple Navigate to handle most navigation circumstances.
|
||||
Public Overloads Sub Navigate(ByVal url As String)
|
||||
Dim o As New Object()
|
||||
|
||||
webBrowser.Navigate(url, o, o, o, o)
|
||||
End Sub
|
||||
|
||||
Public Overloads Sub Navigate(ByVal url As String, ByVal o As Object)
|
||||
|
||||
End Sub
|
||||
|
||||
' Print a document, telling the WebBrowser whether or not to display
|
||||
' the UI. MSHTML exposes a method to print as well, but we want these
|
||||
' semantics to work for any document server (Word, Excel, etc.), so we
|
||||
' perform the op against the doc host instead.
|
||||
Public Sub Print(ByVal doUI As Boolean)
|
||||
'Dim doOpt As SHDocVw.OLECMDEXECOPT
|
||||
|
||||
'If doUI Then
|
||||
' doOpt = SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_PROMPTUSER
|
||||
'Else
|
||||
' doOpt = SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_PROMPTUSER
|
||||
'End If
|
||||
|
||||
'webBrowser.ExecWB(SHDocVw.OLECMDID.OLECMDID_PRINT, doOpt)
|
||||
End Sub
|
||||
|
||||
' Print a document using an MSHTML Print Template.
|
||||
Public Sub PrintFormatted(ByVal tmplPath As String)
|
||||
'Dim o As New Object()
|
||||
|
||||
'webBrowser.ExecWB(SHDocVw.OLECMDID.OLECMDID_PRINT, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DONTPROMPTUSER, CType(tmplPath, Object), o)
|
||||
End Sub
|
||||
|
||||
' Easy commands to test copy/cut/paste status of the control.
|
||||
Public Function IsCutEnabled() As Boolean
|
||||
'Dim res As SHDocVw.OLECMDF = webBrowser.QueryStatusWB(SHDocVw.OLECMDID.OLECMDID_CUT)
|
||||
'If (res And SHDocVw.OLECMDF.OLECMDF_ENABLED) = SHDocVw.OLECMDF.OLECMDF_ENABLED Then
|
||||
' IsCutEnabled = True
|
||||
'Else
|
||||
' IsCutEnabled = False
|
||||
'End If
|
||||
End Function
|
||||
|
||||
Public Function IsCopyEnabled() As Boolean
|
||||
'Dim res As SHDocVw.OLECMDF = webBrowser.QueryStatusWB(SHDocVw.OLECMDID.OLECMDID_COPY)
|
||||
'If (res And SHDocVw.OLECMDF.OLECMDF_ENABLED) = SHDocVw.OLECMDF.OLECMDF_ENABLED Then
|
||||
' IsCopyEnabled = True
|
||||
'Else
|
||||
' IsCopyEnabled = False
|
||||
'End If
|
||||
End Function
|
||||
|
||||
Public Function IsPasteEnabled() As Boolean
|
||||
'Dim qVal As SHDocVw.OLECMDF = webBrowser.QueryStatusWB(SHDocVw.OLECMDID.OLECMDID_PASTE)
|
||||
'Dim i As Integer
|
||||
'If (qVal And SHDocVw.OLECMDF.OLECMDF_ENABLED) = SHDocVw.OLECMDF.OLECMDF_ENABLED Then
|
||||
' IsPasteEnabled = True
|
||||
'Else
|
||||
' IsPasteEnabled = False
|
||||
'End If
|
||||
End Function
|
||||
|
||||
' View the source of the current HTML page in Notepad.
|
||||
Public Sub ViewSource()
|
||||
Dim cmdt As IOleCommandTarget
|
||||
Dim o As Object
|
||||
|
||||
' If the doc object isn't set to anything, or there's
|
||||
' some bizarre error in accessing IOleCommandTarget,
|
||||
' exit gracefully.
|
||||
Try
|
||||
cmdt = CType(doc, IOleCommandTarget)
|
||||
'cmdt.Exec(cmdGUID, MiscCommandTarget.ViewSource, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DODEFAULT, o, o)
|
||||
Catch
|
||||
Throw (New Exception(Err.GetException().Message))
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Public Sub Find()
|
||||
Dim cmdt As IOleCommandTarget
|
||||
Dim o As Object
|
||||
|
||||
' If the doc object isn't set to anything, or there's
|
||||
' some bizarre error in accessing IOleCommandTarget,
|
||||
' exit gracefully.
|
||||
Try
|
||||
cmdt = CType(doc, IOleCommandTarget)
|
||||
'cmdt.Exec(cmdGUID, MiscCommandTarget.Find, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DODEFAULT, o, o)
|
||||
Catch
|
||||
Throw (New Exception(Err.GetException().Message))
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Public Sub InternetOptions()
|
||||
Dim cmdt As IOleCommandTarget
|
||||
Dim o As Object
|
||||
|
||||
' If the doc object isn't set to anything, or there's
|
||||
' some bizarre error in accessing IOleCommandTarget,
|
||||
' exit gracefully.
|
||||
Try
|
||||
cmdt = CType(doc, IOleCommandTarget)
|
||||
'cmdt.Exec(cmdGUID, MiscCommandTarget.Options, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DODEFAULT, o, o)
|
||||
Catch
|
||||
' Throw (New Exception(Err.GetException().Message))
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
' Enable or disable IE's context menu? This allows the parent host
|
||||
' to render its own.
|
||||
Public Property BrowserContextMenu() As Boolean
|
||||
Get
|
||||
BrowserContextMenu = enableCtxMenu
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
' Disable it. Note that we'll need to do this for each
|
||||
' page navigation, as the event sink is specific to an
|
||||
' instance of MSHTML.
|
||||
If (True = Value) Then
|
||||
DisableContextMenu()
|
||||
Else
|
||||
EnableContextMenu()
|
||||
End If
|
||||
|
||||
enableCtxMenu = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
' Some simple thunks
|
||||
Public Sub GoBack()
|
||||
webBrowser.GoBack()
|
||||
End Sub
|
||||
|
||||
Public Sub GoForward()
|
||||
webBrowser.GoForward()
|
||||
End Sub
|
||||
|
||||
Public Sub GoHome()
|
||||
webBrowser.GoHome()
|
||||
End Sub
|
||||
|
||||
' Cut/copy/paste methods.
|
||||
Public Sub Cut()
|
||||
'webBrowser.ExecWB(SHDocVw.OLECMDID.OLECMDID_CUT, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DONTPROMPTUSER)
|
||||
End Sub
|
||||
|
||||
Public Sub Copy()
|
||||
'webBrowser.ExecWB(SHDocVw.OLECMDID.OLECMDID_COPY, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DONTPROMPTUSER)
|
||||
End Sub
|
||||
|
||||
Public Sub Paste()
|
||||
'webBrowser.ExecWB(SHDocVw.OLECMDID.OLECMDID_PASTE, SHDocVw.OLECMDEXECOPT.OLECMDEXECOPT_DONTPROMPTUSER)
|
||||
End Sub
|
||||
|
||||
'
|
||||
' PRIVATE METHODS
|
||||
'
|
||||
Public Sub DisableContextMenu()
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub EnableContextMenu()
|
||||
|
||||
End Sub
|
||||
|
||||
' Multiplex this event, so that hosts don't have to fuss with
|
||||
' the CSC_ values or repeat this logic for every hosted
|
||||
' instance.
|
||||
Private Sub webBrowser_CommandStateChange(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_CommandStateChangeEvent) Handles WebBrowser.CommandStateChange
|
||||
If CommandState.Back = e.command Then
|
||||
If True = e.enable Then
|
||||
RaiseEvent EnableBack(sender, New System.EventArgs())
|
||||
Else
|
||||
RaiseEvent DisableBack(sender, New System.EventArgs())
|
||||
End If
|
||||
ElseIf CommandState.Forward = e.command Then
|
||||
If True = e.enable Then
|
||||
RaiseEvent EnableForward(sender, New System.EventArgs())
|
||||
Else
|
||||
RaiseEvent DisableForward(sender, New System.EventArgs())
|
||||
End If
|
||||
Else
|
||||
RaiseEvent CommandStateChange(sender, e)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
' Perform per-document init tasks.
|
||||
Private Sub webBrowser_DocumentComplete(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_DocumentCompleteEvent) Handles WebBrowser.DocumentComplete
|
||||
Try
|
||||
doc = CType(webBrowser.Document, mshtml.HTMLDocument)
|
||||
Catch
|
||||
' Not a fatal error - we might be hosting a Word doc in-place,
|
||||
' e.g.
|
||||
End Try
|
||||
|
||||
' Bubble up to our host.
|
||||
RaiseEvent DocumentComplete(sender, e)
|
||||
End Sub
|
||||
|
||||
'Sink the event and raise it to the container.
|
||||
Private Sub webBrowser_StatusTextChange(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_StatusTextChangeEvent) Handles WebBrowser.StatusTextChange
|
||||
RaiseEvent StatusTextChange(sender, e)
|
||||
End Sub
|
||||
|
||||
Private Sub webBrowser_TopLevelNavigateComplete2(ByVal sender As Object, ByVal e As AxSHDocVw.DWebBrowserEvents2_NavigateComplete2Event) Handles WebBrowser.NavigateComplete2
|
||||
If (webBrowser.LocationURL).Equals(Convert.ToString(e.uRL)) Then
|
||||
RaiseEvent TopLevelNavigateComplete2(sender, e)
|
||||
End If
|
||||
End Sub
|
||||
End Class
|
||||
159
EDOKA/Utils/Win32API.vb
Normal file
159
EDOKA/Utils/Win32API.vb
Normal file
@@ -0,0 +1,159 @@
|
||||
Option Strict On
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Text
|
||||
|
||||
' Class to wrap up Windows 32 API constants and functions.
|
||||
Public Class Win32API
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Public Structure OSVersionInfo
|
||||
Public OSVersionInfoSize As Integer
|
||||
Public majorVersion As Integer
|
||||
Public minorVersion As Integer
|
||||
Public buildNumber As Integer
|
||||
Public platformId As Integer
|
||||
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=128)> _
|
||||
Public versionString As String
|
||||
End Structure
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Public Structure SECURITY_ATTRIBUTES
|
||||
Public nLength As Integer
|
||||
Public lpSecurityDescriptor As Integer
|
||||
Public bInheritHandle As Integer
|
||||
End Structure
|
||||
|
||||
Public Const GWL_EXSTYLE As Integer = (-20)
|
||||
Public Const SW_Maximize As Integer = 3
|
||||
Public Const SW_Minimze As Integer = 2
|
||||
Public Const GW_OWNER As Integer = 4
|
||||
Public Const SW_RESTORE As Integer = 9
|
||||
Public Const SW_SHOW As Integer = 5
|
||||
Public Const WS_EX_TOOLWINDOW As Integer = &H80
|
||||
Public Const WS_EX_APPWINDOW As Integer = &H40000
|
||||
Private Shared Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, _
|
||||
ByRef lpdwProcessId As Integer) As Integer
|
||||
End Function
|
||||
|
||||
|
||||
Public Declare Function CreateDirectory Lib "kernel32" _
|
||||
Alias "CreateDirectoryA" (ByVal lpPathName As String, _
|
||||
ByVal lpSecurityAttributes _
|
||||
As SECURITY_ATTRIBUTES) As Boolean
|
||||
|
||||
|
||||
Public Delegate Function EnumWindowsCallback(ByVal hWnd As Integer, _
|
||||
ByVal lParam As Integer) As Boolean
|
||||
|
||||
Public Declare Function EnumWindows Lib "user32.dll" _
|
||||
Alias "EnumWindows" (ByVal callback As EnumWindowsCallback, _
|
||||
ByVal lParam As Integer) As Integer
|
||||
|
||||
<DllImport("user32.dll", EntryPoint:="EnumWindows", SetLastError:=True, _
|
||||
CharSet:=CharSet.Ansi, ExactSpelling:=True, _
|
||||
CallingConvention:=CallingConvention.StdCall)> _
|
||||
Public Shared Function EnumWindowsDllImport(ByVal callback As EnumWindowsCallback, _
|
||||
ByVal lParam As Integer) As Integer
|
||||
End Function
|
||||
|
||||
Public Declare Auto Function FindWindow Lib "user32.dll" _
|
||||
Alias "FindWindow" (ByVal lpClassName As String, _
|
||||
ByVal lpWindowName As String) As Integer
|
||||
|
||||
Public Declare Auto Function FindWindowAny Lib "user32.dll" _
|
||||
Alias "FindWindow" (ByVal lpClassName As Integer, _
|
||||
ByVal lpWindowName As Integer) As Integer
|
||||
|
||||
Public Declare Auto Function FindWindowNullClassName Lib "user32.dll" _
|
||||
Alias "FindWindow" (ByVal lpClassName As Integer, _
|
||||
ByVal lpWindowName As String) As Integer
|
||||
|
||||
Public Declare Auto Function FindWindowNullWindowCaption Lib "user32.dll" _
|
||||
Alias "FindWindow" (ByVal lpClassName As String, _
|
||||
ByVal lpWindowName As Integer) As Integer
|
||||
|
||||
Public Declare Function GetActiveWindow Lib "user32.dll" () As IntPtr
|
||||
|
||||
Public Declare Function GetClassName Lib "user32.dll" _
|
||||
Alias "GetClassNameA" (ByVal hwnd As Integer, _
|
||||
ByVal lpClassName As String, _
|
||||
ByVal cch As Integer) As Integer
|
||||
|
||||
Public Declare Function GetDiskFreeSpace Lib "kernel32" _
|
||||
Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
|
||||
ByRef lpSectorsPerCluster As Integer, _
|
||||
ByRef lpBytesPerSector As Integer, _
|
||||
ByRef lpNumberOfFreeClusters As Integer, _
|
||||
ByRef lpTotalNumberOfClusters As Integer) As Integer
|
||||
|
||||
|
||||
Public Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
|
||||
Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, _
|
||||
ByRef lpFreeBytesAvailableToCaller As Integer, _
|
||||
ByRef lpTotalNumberOfBytes As Integer, _
|
||||
ByRef lpTotalNumberOfFreeBytes As UInt32) As Integer
|
||||
|
||||
Public Declare Function GetDriveType Lib "kernel32" _
|
||||
Alias "GetDriveTypeA" (ByVal nDrive As String) As Integer
|
||||
|
||||
Public Declare Function GetParent Lib "user32.dll" _
|
||||
Alias "GetParent" (ByVal hwnd As Integer) As Integer
|
||||
|
||||
|
||||
Declare Ansi Function GetVersionEx Lib "kernel32.dll" _
|
||||
Alias "GetVersionExA" (ByRef osvi As OSVersionInfo) As Boolean
|
||||
|
||||
Public Declare Function GetWindow Lib "user32.dll" _
|
||||
Alias "GetWindow" (ByVal hwnd As Integer, _
|
||||
ByVal wCmd As Integer) As Integer
|
||||
|
||||
Public Declare Function GetWindowLong Lib "user32.dll" _
|
||||
Alias "GetWindowLongA" (ByVal hwnd As Integer, _
|
||||
ByVal nIndex As Integer) As Integer
|
||||
|
||||
Public Declare Sub GetWindowText Lib "user32.dll" _
|
||||
Alias "GetWindowTextA" (ByVal hWnd As Integer, _
|
||||
ByVal lpString As StringBuilder, _
|
||||
ByVal nMaxCount As Integer)
|
||||
|
||||
Public Declare Function IsIconic Lib "user32.dll" _
|
||||
Alias "IsIconic" (ByVal hwnd As Integer) As Boolean
|
||||
|
||||
Public Declare Function IsPwrHibernateAllowed Lib "Powrprof.dll" _
|
||||
Alias "IsPwrHibernateAllowed" () As Integer
|
||||
|
||||
Public Declare Function IsWindowVisible Lib "user32.dll" _
|
||||
Alias "IsWindowVisible" (ByVal hwnd As Integer) As Boolean
|
||||
|
||||
Public Declare Function SetForegroundWindow Lib "user32.dll" _
|
||||
Alias "SetForegroundWindow" (ByVal hwnd As Integer) As Integer
|
||||
|
||||
Public Declare Function SetActiveWindow Lib "user32.dll" _
|
||||
Alias "SetActiveWindow" (ByVal hwnd As Integer) As Integer
|
||||
|
||||
|
||||
Public Declare Function SetSuspendState Lib "Powrprof.dll" _
|
||||
Alias "SetSuspendState" (ByVal Hibernate As Integer, _
|
||||
ByVal ForceCritical As Integer, _
|
||||
ByVal DisableWakeEvent As Integer) As Integer
|
||||
|
||||
Public Declare Function ShowWindow Lib "user32.dll" _
|
||||
Alias "ShowWindow" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
|
||||
|
||||
Declare Function SwapMouseButton Lib "user32.dll" _
|
||||
Alias "SwapMouseButton" (ByVal bSwap As Integer) As Integer
|
||||
|
||||
Public Declare Function BringWindowToTop Lib "user32" Alias "BringWindowToTop" (ByVal hwnd As Long) As Long
|
||||
|
||||
'Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
|
||||
|
||||
'Public Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
|
||||
'Public Const SB_VERT As Long = 1
|
||||
'Public Const SB_HORZ As Long = 0
|
||||
|
||||
Public Declare Function SetParent Lib "user32" Alias "SetParent" (ByVal hWndChild As IntPtr, ByVal hWndNewParent As IntPtr) As System.IntPtr
|
||||
|
||||
Public Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Integer, ByRef lpRect As Rectangle) As Long
|
||||
|
||||
|
||||
|
||||
End Class
|
||||
141
EDOKA/Utils/WindowPostitions.vb
Normal file
141
EDOKA/Utils/WindowPostitions.vb
Normal file
@@ -0,0 +1,141 @@
|
||||
Imports System
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
|
||||
Public Class WindowPositions
|
||||
Dim m_mitarbeiternr As Integer
|
||||
Dim m_window As String
|
||||
Dim m_top As Long
|
||||
Dim m_left As Long
|
||||
Dim m_width As Long
|
||||
Dim m_height As Long
|
||||
|
||||
#Region "Properties"
|
||||
|
||||
Property Mitarbeiternr() As Integer
|
||||
Get
|
||||
Return m_mitarbeiternr
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
m_mitarbeiternr = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Window()
|
||||
Get
|
||||
Return m_window
|
||||
End Get
|
||||
Set(ByVal Value)
|
||||
m_window = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Top() As Long
|
||||
Get
|
||||
Return m_top
|
||||
End Get
|
||||
Set(ByVal Value As Long)
|
||||
m_top = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Left() As Long
|
||||
Get
|
||||
Return m_left
|
||||
End Get
|
||||
Set(ByVal Value As Long)
|
||||
m_left = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property Width() As Long
|
||||
Get
|
||||
Return m_width
|
||||
End Get
|
||||
Set(ByVal Value As Long)
|
||||
m_width = Value
|
||||
End Set
|
||||
End Property
|
||||
Property Height() As Long
|
||||
Get
|
||||
Return m_height
|
||||
End Get
|
||||
Set(ByVal Value As Long)
|
||||
m_height = Value
|
||||
End Set
|
||||
End Property
|
||||
#End Region
|
||||
|
||||
#Region "DBHandle"
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Öffentliche Methoden"
|
||||
|
||||
Public Sub Get_Position(ByVal Frm As Form)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable("coldindex")
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.[sp_windowpositions]"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
Try
|
||||
conn.OpenConnection()
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@Formular", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Frm.Text))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@top", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Frm.Top))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@left", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Frm.Left))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@width", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Frm.Width))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@height", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Frm.Height))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
conn.CloseConnection(True)
|
||||
End Try
|
||||
If dtToReturn.Rows.Count > 0 Then
|
||||
Frm.Top = dtToReturn.Rows(0).Item("top")
|
||||
Frm.Left = dtToReturn.Rows(0).Item("left")
|
||||
Frm.Width = dtToReturn.Rows(0).Item("width")
|
||||
Frm.Height = dtToReturn.Rows(0).Item("height")
|
||||
End If
|
||||
dtToReturn.Dispose()
|
||||
End Sub
|
||||
|
||||
Public Sub Set_Position(ByVal frm As Form)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim dtToReturn As DataTable = New DataTable("coldindex")
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.[sp_windowpositions]"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
Try
|
||||
conn.OpenConnection()
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@Formular", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, frm.Text))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@top", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, frm.Top))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@left", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, frm.Left))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@width", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, frm.Width))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@height", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, frm.Height))
|
||||
scmCmdToExecute.ExecuteNonQuery()
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
conn.CloseConnection(True)
|
||||
End Try
|
||||
If dtToReturn.Rows.Count > 0 Then
|
||||
frm.Top = dtToReturn.Rows(0).Item("top")
|
||||
frm.Left = dtToReturn.Rows(0).Item("left")
|
||||
frm.Width = dtToReturn.Rows(0).Item("width")
|
||||
frm.Height = dtToReturn.Rows(0).Item("height")
|
||||
End If
|
||||
dtToReturn.Dispose()
|
||||
|
||||
End Sub
|
||||
#End Region
|
||||
|
||||
End Class
|
||||
66
EDOKA/Utils/clsBalloon.vb
Normal file
66
EDOKA/Utils/clsBalloon.vb
Normal file
@@ -0,0 +1,66 @@
|
||||
#Region " Custom ToolTip Builder "
|
||||
Public Class clsBalloon
|
||||
Private Enum ToolTipIcon
|
||||
TTI_INFO = 1
|
||||
TTI_WARNING = 2
|
||||
TTI_ERROR = 3
|
||||
End Enum
|
||||
|
||||
Private Enum ToolTipStyle
|
||||
TTS_BALLOON = 64
|
||||
WS_BORDER = 8388608
|
||||
TTS_NOPREFIX = 2
|
||||
TTM_SETTITLE = 1056
|
||||
TTM_UPDATETIPTEXT = 1036
|
||||
TTM_SETTIPBKCOLOR = 1043
|
||||
TTM_SETTIPTEXTCOLOR = 1044
|
||||
End Enum
|
||||
|
||||
Public Sub CustomBalloon(ByVal tip As ToolTip, Optional ByVal style As Integer = 0)
|
||||
'/// the first 5 lines are from Divil's Balloon tip example
|
||||
'/// i've marked them with a * at the end.
|
||||
'/// start of *
|
||||
Dim hwnd As NativeWindow = DirectCast(GetType(ToolTip).GetField("window", Reflection.BindingFlags.NonPublic Or Reflection.BindingFlags.Instance).GetValue(tip), NativeWindow) '/// *
|
||||
style = Win32.GetWindowLong(hwnd.Handle, Win32.GWL_STYLE) '/// *
|
||||
style = style Xor ToolTipStyle.WS_BORDER '/// *
|
||||
style = style Or ToolTipStyle.TTS_BALLOON Or ToolTipStyle.TTS_NOPREFIX '/// *
|
||||
Win32.SetWindowLong(hwnd.Handle, Win32.GWL_STYLE, style) '/// *
|
||||
'/// end of *
|
||||
'/// the remaining code , for colors / caption / icon is all by me ( Dynamic Sysop )
|
||||
'/// no to set the caption / icon & colors up...
|
||||
SetToolTipCaption(hwnd, "HOT-Keys")
|
||||
SetToolTipBackColor(hwnd, Color.LemonChiffon)
|
||||
SetToolTipForeColor(hwnd, Color.Black)
|
||||
End Sub
|
||||
|
||||
Private Sub SetToolTipCaption(ByVal tip As NativeWindow, ByVal Caption As String)
|
||||
Win32.SendMessage(tip.Handle, ToolTipStyle.TTM_SETTITLE, ToolTipIcon.TTI_INFO, Caption)
|
||||
End Sub
|
||||
|
||||
Private Sub SetToolTipBackColor(ByVal tip As NativeWindow, ByVal c As Color)
|
||||
'/// set the back color of the tooltip
|
||||
Dim Col As Integer = ColorTranslator.ToWin32(Color.FromArgb(Convert.ToInt32(c.R), Convert.ToInt32(c.G), Convert.ToInt32(c.B)))
|
||||
Win32.SetToolColors(tip.Handle, ToolTipStyle.TTM_SETTIPBKCOLOR, Col, 0)
|
||||
End Sub
|
||||
|
||||
Private Sub SetToolTipForeColor(ByVal tip As NativeWindow, ByVal c As Color)
|
||||
'/// set the back color of the tooltip
|
||||
Dim Col As Integer = ColorTranslator.ToWin32(Color.FromArgb(Convert.ToInt32(c.R), Convert.ToInt32(c.G), Convert.ToInt32(c.B)))
|
||||
Win32.SetToolColors(tip.Handle, ToolTipStyle.TTM_SETTIPTEXTCOLOR, Col, 0)
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
#End Region
|
||||
'/// the Win32 Api calls to be used by the above Class...
|
||||
#Region " Win32 Api Calls "
|
||||
Public Class Win32
|
||||
|
||||
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
|
||||
Public Declare Function SetToolColors Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
|
||||
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As IntPtr, ByVal nIndex As Integer) As Integer
|
||||
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As IntPtr, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
|
||||
Public Const GWL_STYLE As Integer = (-16)
|
||||
|
||||
End Class
|
||||
#End Region
|
||||
|
||||
99
EDOKA/Utils/clsJournal.vb
Normal file
99
EDOKA/Utils/clsJournal.vb
Normal file
@@ -0,0 +1,99 @@
|
||||
Imports System.IO.File
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.ComponentModel
|
||||
Imports System.SystemException
|
||||
Imports System.Threading
|
||||
|
||||
Public Class clsJournal
|
||||
Dim m_protokolltyp As Integer
|
||||
Property ProtokollTyp() As Integer
|
||||
Get
|
||||
Return m_protokolltyp
|
||||
End Get
|
||||
Set(ByVal Value As Integer)
|
||||
m_protokolltyp = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_objekt As String
|
||||
Property Objekt() As String
|
||||
Get
|
||||
Return m_objekt
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_objekt = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_ereignis As String
|
||||
Property Ereignis() As String
|
||||
Get
|
||||
Return m_ereignis
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_ereignis = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Dim m_id As String
|
||||
Property IDBez() As String
|
||||
Get
|
||||
Return m_id
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_id = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Public Function Journaleintrag(ByVal typ As Integer, ByVal tablename As String, ByVal keyfeld As String, ByVal keyvalue As String, ByVal ereignis As String, ByVal where As String, ByVal obj As String, ByVal idvalue As String)
|
||||
Dim inpdata As New DataSet()
|
||||
Dim i As Integer
|
||||
Dim o As Integer
|
||||
|
||||
Select Case typ
|
||||
Case 1
|
||||
Dim inp As New SqlDataAdapter("Select * from " & tablename, Globals.sConnectionString)
|
||||
inp.Fill(inpdata, "Table1")
|
||||
Case 2
|
||||
Dim inp As New SqlDataAdapter("select * from " & tablename & where, Globals.sConnectionString)
|
||||
inp.Fill(inpdata, "Table1")
|
||||
Case 3
|
||||
Dim inp As New SqlDataAdapter("Select * from " & tablename & " where " & keyfeld & " = " & keyvalue, Globals.sConnectionString)
|
||||
inp.Fill(inpdata, "Table1")
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
|
||||
|
||||
For i = 0 To inpdata.Tables(0).Rows.Count - 1
|
||||
For o = 0 To inpdata.Tables(0).Columns.Count - 1
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
scmCmdToExecute.CommandText = "dbo.SP_Revisionsjournal_Insert"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
|
||||
Try
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
conn.OpenConnection()
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@ereignis", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ereignis))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@objekt", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, obj))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@id", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, idvalue))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@feld", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, inpdata.Tables(0).Columns(o).ColumnName))
|
||||
If inpdata.Tables(0).Rows(i).Item(o) Is System.DBNull.Value Then
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, "<NULL>"))
|
||||
Else
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, CType(inpdata.Tables(0).Rows(i).Item(o), String)))
|
||||
End If
|
||||
scmCmdToExecute.ExecuteNonQuery()
|
||||
conn.CloseConnection(True)
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
End Try
|
||||
Next
|
||||
Next
|
||||
inpdata.Dispose()
|
||||
End Function
|
||||
|
||||
End Class
|
||||
86
EDOKA/Utils/clsPerformance.vb
Normal file
86
EDOKA/Utils/clsPerformance.vb
Normal file
@@ -0,0 +1,86 @@
|
||||
Imports UtilityLibrary
|
||||
Imports System.IO
|
||||
Imports C1.Win.C1TrueDBGrid
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.ComponentModel
|
||||
Imports UtilityLibrary.Win32
|
||||
|
||||
Public Class clsPerformance
|
||||
Public Sub insert_entry(ByVal msg As String)
|
||||
If Globals.DoLog = False Then Exit Sub
|
||||
Try
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_performance"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, msg))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@zeit", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Catch ex As Exception
|
||||
'MsgBox(ex.Message)
|
||||
'Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub force_insert_entry(ByVal msg As String)
|
||||
If Globals.Force_Watch_Message = False Then Exit Sub
|
||||
Try
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_performance"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, msg))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@zeit", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Catch ex As Exception
|
||||
' MsgBox(ex.Message)
|
||||
'Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub Insert_DocRestore(ByVal msg As String)
|
||||
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
|
||||
Dim i As Integer
|
||||
Dim dtToReturn As DataTable = New DataTable()
|
||||
Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute)
|
||||
scmCmdToExecute.CommandText = "dbo.sp_dokumentrestore"
|
||||
scmCmdToExecute.CommandType = CommandType.StoredProcedure
|
||||
scmCmdToExecute.Connection = conn.scoDBConnection
|
||||
Try
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@mitarbeiternr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Globals.MitarbeiterNr))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@meldung", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, msg))
|
||||
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
|
||||
sdaAdapter.Fill(dtToReturn)
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
Throw New Exception("Dokument_Information_Wert::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
|
||||
Finally
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Sub
|
||||
End Class
|
||||
87
EDOKA/Utils/clsXTimer.vb
Normal file
87
EDOKA/Utils/clsXTimer.vb
Normal file
@@ -0,0 +1,87 @@
|
||||
Option Strict Off
|
||||
Option Explicit On
|
||||
Friend Class clsXTimer
|
||||
|
||||
Private Sub CODFORCOPY_PAST()
|
||||
'===============================================================================
|
||||
'Dieser Codteil wird für die Messung gebraucht
|
||||
'===============================================================================
|
||||
Dim m_clsXTime As New clsXTimer()
|
||||
m_clsXTime.Calibrate()
|
||||
m_clsXTime.StartTimer()
|
||||
'Zu messender Code go's here
|
||||
m_clsXTime.StopTimer()
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
#Region " Class Constructor "
|
||||
Public Sub New()
|
||||
MyBase.New()
|
||||
Class_Initialize_Renamed()
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Deklarationen "
|
||||
Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As clsXTimer.LARGE_INTEGER) As Integer
|
||||
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As clsXTimer.LARGE_INTEGER) As Integer
|
||||
Private Structure LARGE_INTEGER
|
||||
Dim lowpart As Integer
|
||||
Dim highpart As Integer
|
||||
End Structure
|
||||
|
||||
Private m_liStart As clsXTimer.LARGE_INTEGER
|
||||
Private m_liEnd As clsXTimer.LARGE_INTEGER
|
||||
Private m_liFreq As clsXTimer.LARGE_INTEGER
|
||||
Private m_dblCalibr As Double
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Eigenschaften "
|
||||
Public ReadOnly Property RunTime() As Object
|
||||
Get ' ms
|
||||
RunTime = Math.Abs((Calibr(m_liEnd) - Calibr(m_liStart)) / Calibr(m_liFreq) * 1000 - m_dblCalibr)
|
||||
If RunTime < 0 Then RunTime = 0
|
||||
End Get
|
||||
End Property
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Timer "
|
||||
Public Sub Calibrate()
|
||||
Call QueryPerformanceCounter(m_liStart)
|
||||
Call QueryPerformanceCounter(m_liEnd)
|
||||
m_dblCalibr = (Calibr(m_liEnd) - Calibr(m_liStart)) / Calibr(m_liFreq) * 1000 ' Millisekunden.
|
||||
End Sub
|
||||
|
||||
Public Sub StartTimer()
|
||||
Call QueryPerformanceCounter(m_liStart)
|
||||
End Sub
|
||||
|
||||
Public Sub StopTimer()
|
||||
Call QueryPerformanceCounter(m_liEnd)
|
||||
MsgBox("Verstichene Zeit=" & Format(RunTime, "0.00 ms"))
|
||||
End Sub
|
||||
|
||||
Public Function Stop_nd_GetTime() As String
|
||||
Call QueryPerformanceCounter(m_liEnd)
|
||||
Return Format(RunTime, "0.00 ms")
|
||||
End Function
|
||||
|
||||
Private Function Calibr(ByRef liX As clsXTimer.LARGE_INTEGER) As Double
|
||||
Calibr = liX.lowpart + liX.highpart * 4294967296.0#
|
||||
End Function
|
||||
|
||||
Private Sub Class_Initialize_Renamed()
|
||||
Call QueryPerformanceFrequency(m_liFreq)
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
End Class
|
||||
154
EDOKA/Utils/frmErrorAVQ_File.Designer.vb
generated
Normal file
154
EDOKA/Utils/frmErrorAVQ_File.Designer.vb
generated
Normal file
@@ -0,0 +1,154 @@
|
||||
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
|
||||
Partial Class frmErrorAVQ_File
|
||||
Inherits System.Windows.Forms.Form
|
||||
|
||||
'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen.
|
||||
<System.Diagnostics.DebuggerNonUserCode()> _
|
||||
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
Try
|
||||
If disposing AndAlso components IsNot Nothing Then
|
||||
components.Dispose()
|
||||
End If
|
||||
Finally
|
||||
MyBase.Dispose(disposing)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
'Wird vom Windows Form-Designer benötigt.
|
||||
Private components As System.ComponentModel.IContainer
|
||||
|
||||
'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich.
|
||||
'Das Bearbeiten ist mit dem Windows Form-Designer möglich.
|
||||
'Das Bearbeiten mit dem Code-Editor ist nicht möglich.
|
||||
<System.Diagnostics.DebuggerStepThrough()> _
|
||||
Private Sub InitializeComponent()
|
||||
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(frmErrorAVQ_File))
|
||||
Me.Panel1 = New System.Windows.Forms.Panel
|
||||
Me.Label4 = New System.Windows.Forms.Label
|
||||
Me.Label3 = New System.Windows.Forms.Label
|
||||
Me.Label2 = New System.Windows.Forms.Label
|
||||
Me.PicVIBeachten = New System.Windows.Forms.PictureBox
|
||||
Me.Label1 = New System.Windows.Forms.Label
|
||||
Me.Panel2 = New System.Windows.Forms.Panel
|
||||
Me.Button1 = New System.Windows.Forms.Button
|
||||
Me.TextBox1 = New System.Windows.Forms.TextBox
|
||||
Me.Panel1.SuspendLayout()
|
||||
CType(Me.PicVIBeachten, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
Me.Panel2.SuspendLayout()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'Panel1
|
||||
'
|
||||
Me.Panel1.Controls.Add(Me.Label4)
|
||||
Me.Panel1.Controls.Add(Me.Label3)
|
||||
Me.Panel1.Controls.Add(Me.Label2)
|
||||
Me.Panel1.Controls.Add(Me.PicVIBeachten)
|
||||
Me.Panel1.Controls.Add(Me.Label1)
|
||||
Me.Panel1.Dock = System.Windows.Forms.DockStyle.Top
|
||||
Me.Panel1.Location = New System.Drawing.Point(0, 0)
|
||||
Me.Panel1.Name = "Panel1"
|
||||
Me.Panel1.Size = New System.Drawing.Size(779, 88)
|
||||
Me.Panel1.TabIndex = 63
|
||||
'
|
||||
'Label4
|
||||
'
|
||||
Me.Label4.AutoSize = True
|
||||
Me.Label4.Location = New System.Drawing.Point(125, 36)
|
||||
Me.Label4.Name = "Label4"
|
||||
Me.Label4.Size = New System.Drawing.Size(0, 13)
|
||||
Me.Label4.TabIndex = 69
|
||||
'
|
||||
'Label3
|
||||
'
|
||||
Me.Label3.AutoSize = True
|
||||
Me.Label3.Location = New System.Drawing.Point(58, 36)
|
||||
Me.Label3.Name = "Label3"
|
||||
Me.Label3.Size = New System.Drawing.Size(61, 13)
|
||||
Me.Label3.TabIndex = 68
|
||||
Me.Label3.Text = "Dateiname:"
|
||||
'
|
||||
'Label2
|
||||
'
|
||||
Me.Label2.AutoSize = True
|
||||
Me.Label2.Location = New System.Drawing.Point(12, 70)
|
||||
Me.Label2.Name = "Label2"
|
||||
Me.Label2.Size = New System.Drawing.Size(95, 13)
|
||||
Me.Label2.TabIndex = 67
|
||||
Me.Label2.Text = "Fehlerhafte Zeilen:"
|
||||
'
|
||||
'PicVIBeachten
|
||||
'
|
||||
Me.PicVIBeachten.Image = CType(resources.GetObject("PicVIBeachten.Image"), System.Drawing.Image)
|
||||
Me.PicVIBeachten.Location = New System.Drawing.Point(12, 3)
|
||||
Me.PicVIBeachten.Name = "PicVIBeachten"
|
||||
Me.PicVIBeachten.Size = New System.Drawing.Size(40, 46)
|
||||
Me.PicVIBeachten.TabIndex = 66
|
||||
Me.PicVIBeachten.TabStop = False
|
||||
'
|
||||
'Label1
|
||||
'
|
||||
Me.Label1.AutoSize = True
|
||||
Me.Label1.Location = New System.Drawing.Point(58, 9)
|
||||
Me.Label1.Name = "Label1"
|
||||
Me.Label1.Size = New System.Drawing.Size(549, 13)
|
||||
Me.Label1.TabIndex = 65
|
||||
Me.Label1.Text = "Bei der automatischen Verarbeitung ist ein Fehler aufgetreten. Die angelieferte D" & _
|
||||
"atei kann nicht verarbeitet werden."
|
||||
'
|
||||
'Panel2
|
||||
'
|
||||
Me.Panel2.Controls.Add(Me.Button1)
|
||||
Me.Panel2.Dock = System.Windows.Forms.DockStyle.Bottom
|
||||
Me.Panel2.Location = New System.Drawing.Point(0, 393)
|
||||
Me.Panel2.Name = "Panel2"
|
||||
Me.Panel2.Size = New System.Drawing.Size(779, 34)
|
||||
Me.Panel2.TabIndex = 64
|
||||
'
|
||||
'Button1
|
||||
'
|
||||
Me.Button1.Location = New System.Drawing.Point(12, 6)
|
||||
Me.Button1.Name = "Button1"
|
||||
Me.Button1.Size = New System.Drawing.Size(123, 23)
|
||||
Me.Button1.TabIndex = 67
|
||||
Me.Button1.Text = "Fenster schliessen"
|
||||
Me.Button1.UseVisualStyleBackColor = True
|
||||
'
|
||||
'TextBox1
|
||||
'
|
||||
Me.TextBox1.BackColor = System.Drawing.SystemColors.ActiveCaptionText
|
||||
Me.TextBox1.Dock = System.Windows.Forms.DockStyle.Fill
|
||||
Me.TextBox1.Font = New System.Drawing.Font("Courier New", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
|
||||
Me.TextBox1.Location = New System.Drawing.Point(0, 88)
|
||||
Me.TextBox1.Multiline = True
|
||||
Me.TextBox1.Name = "TextBox1"
|
||||
Me.TextBox1.Size = New System.Drawing.Size(779, 305)
|
||||
Me.TextBox1.TabIndex = 65
|
||||
'
|
||||
'frmErrorAVQ_File
|
||||
'
|
||||
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
|
||||
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
|
||||
Me.ClientSize = New System.Drawing.Size(779, 427)
|
||||
Me.Controls.Add(Me.TextBox1)
|
||||
Me.Controls.Add(Me.Panel2)
|
||||
Me.Controls.Add(Me.Panel1)
|
||||
Me.Name = "frmErrorAVQ_File"
|
||||
Me.Text = "Fehlerhafte Parameter-Datei"
|
||||
Me.Panel1.ResumeLayout(False)
|
||||
Me.Panel1.PerformLayout()
|
||||
CType(Me.PicVIBeachten, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
Me.Panel2.ResumeLayout(False)
|
||||
Me.ResumeLayout(False)
|
||||
Me.PerformLayout()
|
||||
|
||||
End Sub
|
||||
Friend WithEvents Panel1 As System.Windows.Forms.Panel
|
||||
Friend WithEvents Label4 As System.Windows.Forms.Label
|
||||
Friend WithEvents Label3 As System.Windows.Forms.Label
|
||||
Friend WithEvents Label2 As System.Windows.Forms.Label
|
||||
Friend WithEvents PicVIBeachten As System.Windows.Forms.PictureBox
|
||||
Friend WithEvents Label1 As System.Windows.Forms.Label
|
||||
Friend WithEvents Panel2 As System.Windows.Forms.Panel
|
||||
Friend WithEvents Button1 As System.Windows.Forms.Button
|
||||
Friend WithEvents TextBox1 As System.Windows.Forms.TextBox
|
||||
End Class
|
||||
149
EDOKA/Utils/frmErrorAVQ_File.resx
Normal file
149
EDOKA/Utils/frmErrorAVQ_File.resx
Normal file
@@ -0,0 +1,149 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<root>
|
||||
<!--
|
||||
Microsoft ResX Schema
|
||||
|
||||
Version 2.0
|
||||
|
||||
The primary goals of this format is to allow a simple XML format
|
||||
that is mostly human readable. The generation and parsing of the
|
||||
various data types are done through the TypeConverter classes
|
||||
associated with the data types.
|
||||
|
||||
Example:
|
||||
|
||||
... ado.net/XML headers & schema ...
|
||||
<resheader name="resmimetype">text/microsoft-resx</resheader>
|
||||
<resheader name="version">2.0</resheader>
|
||||
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
|
||||
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
|
||||
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
|
||||
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
|
||||
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
<value>[base64 mime encoded serialized .NET Framework object]</value>
|
||||
</data>
|
||||
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
|
||||
<comment>This is a comment</comment>
|
||||
</data>
|
||||
|
||||
There are any number of "resheader" rows that contain simple
|
||||
name/value pairs.
|
||||
|
||||
Each data row contains a name, and value. The row also contains a
|
||||
type or mimetype. Type corresponds to a .NET class that support
|
||||
text/value conversion through the TypeConverter architecture.
|
||||
Classes that don't support this are serialized and stored with the
|
||||
mimetype set.
|
||||
|
||||
The mimetype is used for serialized objects, and tells the
|
||||
ResXResourceReader how to depersist the object. This is currently not
|
||||
extensible. For a given mimetype the value must be set accordingly:
|
||||
|
||||
Note - application/x-microsoft.net.object.binary.base64 is the format
|
||||
that the ResXResourceWriter will generate, however the reader can
|
||||
read any of the formats listed below.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.binary.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.soap.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.bytearray.base64
|
||||
value : The object must be serialized into a byte array
|
||||
: using a System.ComponentModel.TypeConverter
|
||||
: and then encoded with base64 encoding.
|
||||
-->
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="metadata">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" use="required" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
<xsd:attribute ref="xml:space" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="assembly">
|
||||
<xsd:complexType>
|
||||
<xsd:attribute name="alias" type="xsd:string" />
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
|
||||
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
|
||||
<xsd:attribute ref="xml:space" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="resmimetype">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="version">
|
||||
<value>2.0</value>
|
||||
</resheader>
|
||||
<resheader name="reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<assembly alias="System.Drawing" name="System.Drawing, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
|
||||
<data name="PicVIBeachten.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
<value>
|
||||
iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAYAAABXAvmHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
|
||||
YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAAOpgAABdwnLpRPAAABQNJREFUaEPtmH1o
|
||||
VXUYx891d3PYaGgNpSGuDLMpFkVF0R9CEFGU/bN/hBqRFM6IKAgKgjKQwtIkiwWR0YsvV0gqxbTC0ula
|
||||
bu7FTZtm8y0m21iuptPdl6ff5/md39mdzPKPe7cjnMHDzr3nOed8X57n93vO9bzoL1IgUiBSIFIgbAp0
|
||||
tH4nXYffkbDhuiI8nR2bJTNcIplUkZzrv09aGuuuLiKpvz1JD3mSSduoS5TKWys+uzpI9HYtkoFTk4z6
|
||||
BZIcmh+QePTBx+TVV2rDTYK6B7wSGJ4u3UeW2lLyXSgrWyo7tzWFl8SZI4sVfKovZoDPUAfSqdmSHrSl
|
||||
hAtLnnw5vASc+goY5ZPFkh6eE/TDro3XCS78/H1L+Eg49W35WPDaxMlyLadsF5Y9uzx8BEarbwCbVWj/
|
||||
prh1gTLyV6Wt62aqC7t2NIeHRHfnU9LXGpfzf1L7JbLzixlSFL8hCNfULK+ZYU8W3lslL76wOjwEnPqp
|
||||
vyAwPQA+pbBSrim8R5s3k5xly8gQcC407GmbeBJO/aD2jQNO/SnxB4R4aOEiJUawQkEkNC70tBRq+Vw8
|
||||
Y9XPpGNKoLBgpoIn1AGzsdELSsD0w/q1s6W8/DmZUBdO//aSglf1L1wbbFoA1vKZ/LASAKxdkWaZvDK5
|
||||
eCom9MPtC56e2N0Z8CPNa8qDHjBAmzbElMCC+c/I/XdVSU/jZLsKGZLqQo8l8OmquerChAx7qN/TXKQE
|
||||
MoOlCg5gEGjf7GkJPf5ItRKgcSkdPY8L56+XzImYOnHnbdWy/PVPxr+ZqX0InDtoQBkCCs6AQlmOcYAN
|
||||
i3Kiad15JQuJLpNrHPvgzUq55daa8XXhRPtr0vdrXAmkTloCgFcCvgsAZ8NKfHijOjDqvCGgeUftNTfP
|
||||
qRnfcZuy6d1fJEPtBtjg1BF1fRKU0do3KpWA7sZZBJSIaWRGDK6HSO2KuepC24H6/JeSUx8HrPpTrbqm
|
||||
JDT8MqpPlOgqpHk0t8s5Zo9pZv3OfIYIDb/y7c/zT4Cy6W+YJP+0FYyoDygii8QF0xssoVrrlAvnXB7/
|
||||
zbiNC0nfBRybN69GWpv25Y8E6g/Ux5SAAhqcZkFRy4QD6JcS47Or/SCPnE7bE4zaev6QvZYyenfll/kj
|
||||
QDmc3esJ6ip4Hg4YF5BAcZZMf2QIlk8HnBzyD9t76KRKL5l7sS/krRdQ//SOmAzsMw8DBLXvgADGJ0G5
|
||||
NCSKg3moOF6hZTKKLPkdVnXtBdw0OSzJ7M552RfYTXt/isnZX/yGRFFAAI4SIAwJCGSP0kyj1LeO0gAn
|
||||
j+tc4CS9cNCSdL3Q0rg3d6X0+6F10v2jWToNAfcgBQL47MCF4yMEUJNRgfdgfU8e6xrc5K3NnOPe9BjL
|
||||
75r3NuaOAK+LJ7d7SkABd/pgnPKBA3bFYXzGhWml1fLD9gM6/2sJOQdcPi5wbEjjiLprctgE777jidwR
|
||||
QP3j2zztgf460wdGJYIHEtnHlqDdyFB+S22FkkbdsfLddywOfbutQG4T3JLYnRsSOMCAdvRrT7q2mvj2
|
||||
8uGIAlhBG2C4d7nr/uBe5p7ZDrsxJKfNjAsQYFT+v2je4Mml8V/XkItAx74ZUb/ipmW57QN+1f34o6+0
|
||||
NhmBcx3cl6angWn8xVXPmwk1hyuR+1maply9ar2q4+L9NZuE4LM7vvTzWLkuP/teHCNUXsBf0W/rUVKk
|
||||
QKRApECkQKTAOCvwLwgAbFDiNRjdAAAAAElFTkSuQmCC
|
||||
</value>
|
||||
</data>
|
||||
</root>
|
||||
121
EDOKA/Utils/frmErrorAVQ_File.vb
Normal file
121
EDOKA/Utils/frmErrorAVQ_File.vb
Normal file
@@ -0,0 +1,121 @@
|
||||
Imports System.IO
|
||||
Imports System.Xml
|
||||
Imports System.Xml.Schema
|
||||
|
||||
Imports System.Data
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Data.SqlClient
|
||||
|
||||
Public Class frmErrorAVQ_File
|
||||
Private m_Success As Boolean = True
|
||||
Dim Resultat As String = ""
|
||||
|
||||
Dim intFilename As String
|
||||
|
||||
Sub New(ByVal filename As String)
|
||||
MyBase.New()
|
||||
InitializeComponent()
|
||||
intFilename = filename
|
||||
End Sub
|
||||
Private Sub frmErrorAVQ_File_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
||||
Me.TextBox1.Text = Get_FileInhalt(intFilename)
|
||||
Me.Label4.Text = intFilename
|
||||
End Sub
|
||||
|
||||
Private Function Get_FileInhalt(ByVal filename As String)
|
||||
|
||||
Dim resultat As String = ""
|
||||
Dim daten As String()
|
||||
daten = IO.File.ReadAllLines(filename, System.Text.Encoding.GetEncoding("ISO-8859-1"))
|
||||
Dim int As Integer
|
||||
Dim l As Integer = 0
|
||||
Dim z As Integer = 0
|
||||
For Each s As String In daten
|
||||
l = l + 1
|
||||
z = 0
|
||||
For Each ch As Char In s
|
||||
z = z + 1
|
||||
If ch = "" Then
|
||||
resultat = resultat & "Zeile " & Trim(Str(l)) & ", Pos. " & Trim(Str(z)) & ": ungültiges Zeichen: " & ch & vbTab & daten(l - 1) & vbNewLine
|
||||
End If
|
||||
'int = Microsoft.VisualBasic.AscW(ch).Parse(Globalization.NumberStyles.HexNumber)
|
||||
'If Microsoft.VisualBasic.AscW(ch) <= 31 Then
|
||||
' int = Microsoft.VisualBasic.AscW(ch).Parse(Globalization.NumberStyles.HexNumber)
|
||||
' If Microsoft.VisualBasic.AscW(ch) <> 9 Then
|
||||
' Try
|
||||
' resultat = resultat & "Zeile " & Trim(Str(l)) & ", Pos. " & Trim(Str(z)) & " ungültiges Zeichen:" & ch
|
||||
' Catch ex As Exception
|
||||
' resultat = resultat & "Zeile " & Trim(Str(l)) & ", Pos. " & Trim(Str(z)) & " ungültiges Zeichen"
|
||||
' End Try
|
||||
' End If
|
||||
'End If
|
||||
Next
|
||||
Next
|
||||
Return resultat
|
||||
End Function
|
||||
|
||||
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
|
||||
Me.Close()
|
||||
End Sub
|
||||
|
||||
Dim instance As XmlReaderSettings
|
||||
Dim handler As ValidationEventHandler
|
||||
|
||||
Private Function xx(ByVal infile As String) As String
|
||||
Dim settings As XmlReaderSettings = New XmlReaderSettings()
|
||||
settings.CheckCharacters = True
|
||||
settings.ValidationType = ValidationType.Schema
|
||||
settings.ValidationFlags = settings.ValidationFlags Or XmlSchemaValidationFlags.ProcessInlineSchema
|
||||
settings.ValidationFlags = settings.ValidationFlags Or XmlSchemaValidationFlags.ReportValidationWarnings
|
||||
AddHandler settings.ValidationEventHandler, AddressOf ValidationCallBack
|
||||
|
||||
' Create the XmlReader object.
|
||||
Dim reader As XmlReader = XmlReader.Create(infile, settings)
|
||||
|
||||
' Parse the file.
|
||||
While (reader.Read())
|
||||
End While
|
||||
End Function
|
||||
|
||||
' Display any warnings or errors.
|
||||
Private Shared Sub ValidationCallBack(ByVal sender As Object, ByVal args As ValidationEventArgs)
|
||||
If (args.Severity = XmlSeverityType.Warning) Then
|
||||
Console.WriteLine(" Warning: Matching schema not found. No validation occurred." + args.Message)
|
||||
Else
|
||||
Console.WriteLine(" Validation error: " + args.Message)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
'Private Function validatexml(ByVal infile As String) As Boolean
|
||||
' 'First we create the xmltextreader
|
||||
' Dim xmlr As New XmlTextReader(infile)
|
||||
' 'We pass the xmltextreader into the xmlvalidatingreader
|
||||
' 'This will validate the xml doc with the schema file
|
||||
' 'NOTE the xml file it self points to the schema file
|
||||
' Dim xmlvread As New XmlValidatingReader(xmlr)
|
||||
|
||||
' ' Set the validation event handler
|
||||
' AddHandler xmlvread.ValidationEventHandler, AddressOf ValidationCallBack
|
||||
' m_Success = True 'make sure to reset the success var
|
||||
|
||||
' ' Read XML data
|
||||
' Try
|
||||
' While (xmlvread.ReadContentAsString)
|
||||
' End While
|
||||
' Catch ex As Exception
|
||||
' Resultat = Resultat + ex.Message + vbNewLine
|
||||
' End Try
|
||||
' 'Close the reader.
|
||||
' xmlvread.Close()
|
||||
|
||||
' 'The validationeventhandler is the only thing that would set m_Success to false
|
||||
' Return m_Success
|
||||
|
||||
'End Function
|
||||
'Private Sub ValidationCallBack(ByVal sender As Object, ByVal args As ValidationEventArgs)
|
||||
' 'Display the validation error. This is only called on error
|
||||
' m_Success = False 'Validation failed
|
||||
' 'Resultat = Resultat + (args.Message + vbNewLine)
|
||||
'End Sub
|
||||
|
||||
End Class
|
||||
120
EDOKA/Utils/frmProgress.resx
Normal file
120
EDOKA/Utils/frmProgress.resx
Normal file
@@ -0,0 +1,120 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<root>
|
||||
<!--
|
||||
Microsoft ResX Schema
|
||||
|
||||
Version 2.0
|
||||
|
||||
The primary goals of this format is to allow a simple XML format
|
||||
that is mostly human readable. The generation and parsing of the
|
||||
various data types are done through the TypeConverter classes
|
||||
associated with the data types.
|
||||
|
||||
Example:
|
||||
|
||||
... ado.net/XML headers & schema ...
|
||||
<resheader name="resmimetype">text/microsoft-resx</resheader>
|
||||
<resheader name="version">2.0</resheader>
|
||||
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
|
||||
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
|
||||
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
|
||||
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
|
||||
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
<value>[base64 mime encoded serialized .NET Framework object]</value>
|
||||
</data>
|
||||
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
|
||||
<comment>This is a comment</comment>
|
||||
</data>
|
||||
|
||||
There are any number of "resheader" rows that contain simple
|
||||
name/value pairs.
|
||||
|
||||
Each data row contains a name, and value. The row also contains a
|
||||
type or mimetype. Type corresponds to a .NET class that support
|
||||
text/value conversion through the TypeConverter architecture.
|
||||
Classes that don't support this are serialized and stored with the
|
||||
mimetype set.
|
||||
|
||||
The mimetype is used for serialized objects, and tells the
|
||||
ResXResourceReader how to depersist the object. This is currently not
|
||||
extensible. For a given mimetype the value must be set accordingly:
|
||||
|
||||
Note - application/x-microsoft.net.object.binary.base64 is the format
|
||||
that the ResXResourceWriter will generate, however the reader can
|
||||
read any of the formats listed below.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.binary.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.soap.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.bytearray.base64
|
||||
value : The object must be serialized into a byte array
|
||||
: using a System.ComponentModel.TypeConverter
|
||||
: and then encoded with base64 encoding.
|
||||
-->
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="metadata">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" use="required" type="xsd:string" />
|
||||
<xsd:attribute name="type" type="xsd:string" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" />
|
||||
<xsd:attribute ref="xml:space" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="assembly">
|
||||
<xsd:complexType>
|
||||
<xsd:attribute name="alias" type="xsd:string" />
|
||||
<xsd:attribute name="name" type="xsd:string" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
|
||||
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
|
||||
<xsd:attribute ref="xml:space" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="resmimetype">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="version">
|
||||
<value>2.0</value>
|
||||
</resheader>
|
||||
<resheader name="reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
</root>
|
||||
161
EDOKA/Utils/frmProgress.vb
Normal file
161
EDOKA/Utils/frmProgress.vb
Normal file
@@ -0,0 +1,161 @@
|
||||
Public Class frmProgress
|
||||
Inherits System.Windows.Forms.Form
|
||||
|
||||
#Region " Vom Windows Form Designer generierter Code "
|
||||
|
||||
Public Sub New()
|
||||
MyBase.New()
|
||||
|
||||
' Dieser Aufruf ist für den Windows Form-Designer erforderlich.
|
||||
InitializeComponent()
|
||||
|
||||
' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen
|
||||
|
||||
End Sub
|
||||
|
||||
' Die Form überschreibt den Löschvorgang der Basisklasse, um Komponenten zu bereinigen.
|
||||
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If disposing Then
|
||||
If Not (components Is Nothing) Then
|
||||
components.Dispose()
|
||||
End If
|
||||
End If
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
|
||||
' Für Windows Form-Designer erforderlich
|
||||
Private components As System.ComponentModel.IContainer
|
||||
|
||||
'HINWEIS: Die folgende Prozedur ist für den Windows Form-Designer erforderlich
|
||||
'Sie kann mit dem Windows Form-Designer modifiziert werden.
|
||||
'Verwenden Sie nicht den Code-Editor zur Bearbeitung.
|
||||
Friend WithEvents Info As System.Windows.Forms.Label
|
||||
Friend WithEvents lblproz As System.Windows.Forms.Label
|
||||
Friend WithEvents Panel1 As System.Windows.Forms.Panel
|
||||
Friend WithEvents Bar1a As MyProgressbar
|
||||
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
|
||||
Me.Info = New System.Windows.Forms.Label
|
||||
Me.Bar1a = New EDOKAApp.MyProgressbar
|
||||
Me.lblproz = New System.Windows.Forms.Label
|
||||
Me.Panel1 = New System.Windows.Forms.Panel
|
||||
Me.Panel1.SuspendLayout()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'Info
|
||||
'
|
||||
Me.Info.Location = New System.Drawing.Point(8, 16)
|
||||
Me.Info.Name = "Info"
|
||||
Me.Info.Size = New System.Drawing.Size(392, 23)
|
||||
Me.Info.TabIndex = 1
|
||||
Me.Info.Text = "Label1"
|
||||
'
|
||||
'Bar1a
|
||||
'
|
||||
Me.Bar1a.Location = New System.Drawing.Point(8, 32)
|
||||
Me.Bar1a.Name = "Bar1a"
|
||||
Me.Bar1a.Size = New System.Drawing.Size(392, 21)
|
||||
Me.Bar1a.Style = System.Windows.Forms.ProgressBarStyle.Continuous
|
||||
Me.Bar1a.TabIndex = 3
|
||||
'
|
||||
'lblproz
|
||||
'
|
||||
Me.lblproz.AutoSize = True
|
||||
Me.lblproz.Location = New System.Drawing.Point(189, 0)
|
||||
Me.lblproz.Name = "lblproz"
|
||||
Me.lblproz.Size = New System.Drawing.Size(24, 13)
|
||||
Me.lblproz.TabIndex = 5
|
||||
Me.lblproz.Text = "0 %"
|
||||
'
|
||||
'Panel1
|
||||
'
|
||||
Me.Panel1.Controls.Add(Me.lblproz)
|
||||
Me.Panel1.Location = New System.Drawing.Point(8, 58)
|
||||
Me.Panel1.Name = "Panel1"
|
||||
Me.Panel1.Size = New System.Drawing.Size(392, 13)
|
||||
Me.Panel1.TabIndex = 5
|
||||
'
|
||||
'frmProgress
|
||||
'
|
||||
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
|
||||
Me.ClientSize = New System.Drawing.Size(408, 83)
|
||||
Me.Controls.Add(Me.Panel1)
|
||||
Me.Controls.Add(Me.Bar1a)
|
||||
Me.Controls.Add(Me.Info)
|
||||
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedDialog
|
||||
Me.MaximizeBox = False
|
||||
Me.MinimizeBox = False
|
||||
Me.Name = "frmProgress"
|
||||
Me.ShowInTaskbar = False
|
||||
Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
|
||||
Me.Text = "Fortschrittsanzeige"
|
||||
Me.Panel1.ResumeLayout(False)
|
||||
Me.Panel1.PerformLayout()
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
|
||||
Dim m_CloseIsInvisible As Boolean = False
|
||||
Property CloseIsInvisible() As Boolean
|
||||
Get
|
||||
Return m_CloseIsInvisible
|
||||
End Get
|
||||
Set(ByVal Value As Boolean)
|
||||
m_CloseIsInvisible = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
'SHU 20041119
|
||||
'Wenn der Parameter True ist, wird beim Close-Ereignis das Fenster nicht geschlossen,
|
||||
'sonder nur invisible gesetzt
|
||||
Public Sub New(ByVal CloseIsInvisible As Boolean)
|
||||
MyBase.New()
|
||||
|
||||
' Dieser Aufruf ist für den Windows Form-Designer erforderlich.
|
||||
InitializeComponent()
|
||||
|
||||
Me.CloseIsInvisible = CloseIsInvisible
|
||||
' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub frmProgress_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
||||
End Sub
|
||||
|
||||
Private Sub Info_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Info.TextChanged
|
||||
Me.Refresh()
|
||||
System.Windows.Forms.Application.DoEvents()
|
||||
End Sub
|
||||
|
||||
Private Sub frmProgress_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
|
||||
If Me.CloseIsInvisible = True Then
|
||||
Me.Visible = False
|
||||
e.Cancel = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub NewBar1_ValueChanged() Handles Bar1a.ValueChanged
|
||||
Me.lblproz.Text = Trim(Str(Me.Bar1a.Value)) & " %"
|
||||
Application.DoEvents()
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
|
||||
Public Class MyProgressbar
|
||||
Inherits System.Windows.Forms.ProgressBar
|
||||
Public Event ValueChanged()
|
||||
Dim m_value As Integer
|
||||
Property Value() As Integer
|
||||
Get
|
||||
Return m_value
|
||||
End Get
|
||||
Set(ByVal value As Integer)
|
||||
MyBase.Value = value
|
||||
m_value = value
|
||||
RaiseEvent ValueChanged()
|
||||
End Set
|
||||
End Property
|
||||
End Class
|
||||
331
EDOKA/Utils/frmSortSelect.resx
Normal file
331
EDOKA/Utils/frmSortSelect.resx
Normal file
@@ -0,0 +1,331 @@
|
||||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<root>
|
||||
<!--
|
||||
Microsoft ResX Schema
|
||||
|
||||
Version 1.3
|
||||
|
||||
The primary goals of this format is to allow a simple XML format
|
||||
that is mostly human readable. The generation and parsing of the
|
||||
various data types are done through the TypeConverter classes
|
||||
associated with the data types.
|
||||
|
||||
Example:
|
||||
|
||||
... ado.net/XML headers & schema ...
|
||||
<resheader name="resmimetype">text/microsoft-resx</resheader>
|
||||
<resheader name="version">1.3</resheader>
|
||||
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
|
||||
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
|
||||
<data name="Name1">this is my long string</data>
|
||||
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
|
||||
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
[base64 mime encoded serialized .NET Framework object]
|
||||
</data>
|
||||
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
|
||||
[base64 mime encoded string representing a byte array form of the .NET Framework object]
|
||||
</data>
|
||||
|
||||
There are any number of "resheader" rows that contain simple
|
||||
name/value pairs.
|
||||
|
||||
Each data row contains a name, and value. The row also contains a
|
||||
type or mimetype. Type corresponds to a .NET class that support
|
||||
text/value conversion through the TypeConverter architecture.
|
||||
Classes that don't support this are serialized and stored with the
|
||||
mimetype set.
|
||||
|
||||
The mimetype is used for serialized objects, and tells the
|
||||
ResXResourceReader how to depersist the object. This is currently not
|
||||
extensible. For a given mimetype the value must be set accordingly:
|
||||
|
||||
Note - application/x-microsoft.net.object.binary.base64 is the format
|
||||
that the ResXResourceWriter will generate, however the reader can
|
||||
read any of the formats listed below.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.binary.base64
|
||||
value : The object must be serialized with
|
||||
: System.Serialization.Formatters.Binary.BinaryFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
|
||||
mimetype: application/x-microsoft.net.object.soap.base64
|
||||
value : The object must be serialized with
|
||||
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
|
||||
: and then encoded with base64 encoding.
|
||||
mimetype: application/x-microsoft.net.object.bytearray.base64
|
||||
value : The object must be serialized into a byte array
|
||||
: using a System.ComponentModel.TypeConverter
|
||||
: and then encoded with base64 encoding.
|
||||
-->
|
||||
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
|
||||
<xsd:element name="root" msdata:IsDataSet="true">
|
||||
<xsd:complexType>
|
||||
<xsd:choice maxOccurs="unbounded">
|
||||
<xsd:element name="data">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
|
||||
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
|
||||
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
<xsd:element name="resheader">
|
||||
<xsd:complexType>
|
||||
<xsd:sequence>
|
||||
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
|
||||
</xsd:sequence>
|
||||
<xsd:attribute name="name" type="xsd:string" use="required" />
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:choice>
|
||||
</xsd:complexType>
|
||||
</xsd:element>
|
||||
</xsd:schema>
|
||||
<resheader name="resmimetype">
|
||||
<value>text/microsoft-resx</value>
|
||||
</resheader>
|
||||
<resheader name="version">
|
||||
<value>1.3</value>
|
||||
</resheader>
|
||||
<resheader name="reader">
|
||||
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<resheader name="writer">
|
||||
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
|
||||
</resheader>
|
||||
<data name="SqlConnection1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlConnection1.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>152, 17</value>
|
||||
</data>
|
||||
<data name="dsSortOrderUser.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>17, 17</value>
|
||||
</data>
|
||||
<data name="dsSortOrderUser.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="dsSortOrder.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>280, 17</value>
|
||||
</data>
|
||||
<data name="dsSortOrder.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="daSortOrder.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="daSortOrder.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>391, 17</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand1.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand1.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>17, 54</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand1.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand1.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand1.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>791, 17</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand1.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand1.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand1.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>645, 54</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand1.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand1.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand1.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>172, 54</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand1.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="daSortOrderUser.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="daSortOrderUser.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>503, 17</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand2.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand2.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>331, 54</value>
|
||||
</data>
|
||||
<data name="SqlDeleteCommand2.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand2.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand2.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>151, 17</value>
|
||||
</data>
|
||||
<data name="SqlInsertCommand2.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand2.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand2.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>638, 17</value>
|
||||
</data>
|
||||
<data name="SqlSelectCommand2.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand2.CommandDesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand2.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>486, 54</value>
|
||||
</data>
|
||||
<data name="SqlUpdateCommand2.DesignTimeVisible" type="System.Boolean, mscorlib, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>False</value>
|
||||
</data>
|
||||
<data name="ContextMenu2.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>686, 21</value>
|
||||
</data>
|
||||
<data name="ContextMenu2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="mnuUp.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="mnuDown.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="mnuDelete.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="mnuSortOrder.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="ToolBar1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="speichern.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="abbrechen.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="ImageList1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="ImageList1.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
|
||||
<value>824, 18</value>
|
||||
</data>
|
||||
<data name="ImageList1.ImageStream" mimetype="application/x-microsoft.net.object.binary.base64">
|
||||
<value>
|
||||
AAEAAAD/////AQAAAAAAAAAMAgAAAFpTeXN0ZW0uV2luZG93cy5Gb3JtcywgVmVyc2lvbj0xLjAuMzMw
|
||||
MC4wLCBDdWx0dXJlPW5ldXRyYWwsIFB1YmxpY0tleVRva2VuPWI3N2E1YzU2MTkzNGUwODkFAQAAACZT
|
||||
eXN0ZW0uV2luZG93cy5Gb3Jtcy5JbWFnZUxpc3RTdHJlYW1lcgEAAAAERGF0YQcCAgAAAAkDAAAADwMA
|
||||
AAAWCQAAAk1TRnQBSQFMAgEBAgEAAQUBAAEEAQABEAEAARABAAT/AQkBEAj/AUIBTQE2AQQGAAE2AQQC
|
||||
AAEoAwABQAMAASADAAEBAQABCAYAAQgYAAGAAgABgAMAAoABAAGAAwABgAEAAYABAAKAAgADwAEAAcAB
|
||||
3AHAAQAB8AHKAaYBAAEzBQABMwEAATMBAAEzAQACMwIAAxYBAAMcAQADIgEAAykBAANVAQADTQEAA0IB
|
||||
AAM5AQABgAF8Af8BAAJQAf8BAAGTAQAB1gEAAf8B7AHMAQABxgHWAe8BAAHWAucBAAGQAakBrQIAAf8B
|
||||
MwMAAWYDAAGZAwABzAIAATMDAAIzAgABMwFmAgABMwGZAgABMwHMAgABMwH/AgABZgMAAWYBMwIAAmYC
|
||||
AAFmAZkCAAFmAcwCAAFmAf8CAAGZAwABmQEzAgABmQFmAgACmQIAAZkBzAIAAZkB/wIAAcwDAAHMATMC
|
||||
AAHMAWYCAAHMAZkCAALMAgABzAH/AgAB/wFmAgAB/wGZAgAB/wHMAQABMwH/AgAB/wEAATMBAAEzAQAB
|
||||
ZgEAATMBAAGZAQABMwEAAcwBAAEzAQAB/wEAAf8BMwIAAzMBAAIzAWYBAAIzAZkBAAIzAcwBAAIzAf8B
|
||||
AAEzAWYCAAEzAWYBMwEAATMCZgEAATMBZgGZAQABMwFmAcwBAAEzAWYB/wEAATMBmQIAATMBmQEzAQAB
|
||||
MwGZAWYBAAEzApkBAAEzAZkBzAEAATMBmQH/AQABMwHMAgABMwHMATMBAAEzAcwBZgEAATMBzAGZAQAB
|
||||
MwLMAQABMwHMAf8BAAEzAf8BMwEAATMB/wFmAQABMwH/AZkBAAEzAf8BzAEAATMC/wEAAWYDAAFmAQAB
|
||||
MwEAAWYBAAFmAQABZgEAAZkBAAFmAQABzAEAAWYBAAH/AQABZgEzAgABZgIzAQABZgEzAWYBAAFmATMB
|
||||
mQEAAWYBMwHMAQABZgEzAf8BAAJmAgACZgEzAQADZgEAAmYBmQEAAmYBzAEAAWYBmQIAAWYBmQEzAQAB
|
||||
ZgGZAWYBAAFmApkBAAFmAZkBzAEAAWYBmQH/AQABZgHMAgABZgHMATMBAAFmAcwBmQEAAWYCzAEAAWYB
|
||||
zAH/AQABZgH/AgABZgH/ATMBAAFmAf8BmQEAAWYB/wHMAQABzAEAAf8BAAH/AQABzAEAApkCAAGZATMB
|
||||
mQEAAZkBAAGZAQABmQEAAcwBAAGZAwABmQIzAQABmQEAAWYBAAGZATMBzAEAAZkBAAH/AQABmQFmAgAB
|
||||
mQFmATMBAAGZATMBZgEAAZkBZgGZAQABmQFmAcwBAAGZATMB/wEAApkBMwEAApkBZgEAA5kBAAKZAcwB
|
||||
AAKZAf8BAAGZAcwCAAGZAcwBMwEAAWYBzAFmAQABmQHMAZkBAAGZAswBAAGZAcwB/wEAAZkB/wIAAZkB
|
||||
/wEzAQABmQHMAWYBAAGZAf8BmQEAAZkB/wHMAQABmQL/AQABzAMAAZkBAAEzAQABzAEAAWYBAAHMAQAB
|
||||
mQEAAcwBAAHMAQABmQEzAgABzAIzAQABzAEzAWYBAAHMATMBmQEAAcwBMwHMAQABzAEzAf8BAAHMAWYC
|
||||
AAHMAWYBMwEAAZkCZgEAAcwBZgGZAQABzAFmAcwBAAGZAWYB/wEAAcwBmQIAAcwBmQEzAQABzAGZAWYB
|
||||
AAHMApkBAAHMAZkBzAEAAcwBmQH/AQACzAIAAswBMwEAAswBZgEAAswBmQEAA8wBAALMAf8BAAHMAf8C
|
||||
AAHMAf8BMwEAAZkB/wFmAQABzAH/AZkBAAHMAf8BzAEAAcwC/wEAAcwBAAEzAQAB/wEAAWYBAAH/AQAB
|
||||
mQEAAcwBMwIAAf8CMwEAAf8BMwFmAQAB/wEzAZkBAAH/ATMBzAEAAf8BMwH/AQAB/wFmAgAB/wFmATMB
|
||||
AAHMAmYBAAH/AWYBmQEAAf8BZgHMAQABzAFmAf8BAAH/AZkCAAH/AZkBMwEAAf8BmQFmAQAB/wKZAQAB
|
||||
/wGZAcwBAAH/AZkB/wEAAf8BzAIAAf8BzAEzAQAB/wHMAWYBAAH/AcwBmQEAAf8CzAEAAf8BzAH/AQAC
|
||||
/wEzAQABzAH/AWYBAAL/AZkBAAL/AcwBAAJmAf8BAAFmAf8BZgEAAWYC/wEAAf8CZgEAAf8BZgH/AQAC
|
||||
/wFmAQABIQEAAaUBAANfAQADdwEAA4YBAAOWAQADywEAA7IBAAPXAQAD3QEAA+MBAAPqAQAD8QEAA/gB
|
||||
AAHwAfsB/wEAAaQCoAEAA4ADAAH/AgAB/wMAAv8BAAH/AwAB/wEAAf8BAAL/AgAD//8A/wD/AP8ABQAQ
|
||||
AjAAAgINAAECBgABAwH/KAABAgEAAgMGAAIHAQABAwEAAQIEAAHsAQMB7AH/KAABAgEAAgMGAAIHAQAB
|
||||
AwEAAQICAAEDAewBAwHsAQMB/ygAAQIBAAIDBgACBwEAAQMBAAECAQABAwHsAQMB7AEDAewB/wEAAewm
|
||||
AAECAQACAwkAAQMBAAECAQAB7AEDAewBAwHsAQMB/wEAAewmAAECAQAMAwEAAQIBAAEDAewBAwIAAewB
|
||||
/wEAAewmAAECAQACAwgAAgMBAAECAQAB7AEDAewCBwEDAf8BAAHsAQABBiQAAQIBAAEDAQAIBwEAAQMB
|
||||
AAECAQABAwHsAQMB7AEDAewB/wIAAQYF/iAAAQIBAAEDAQAIBwEAAQMBAAECAQAB7AEDAewBAwHsAQMB
|
||||
/wEAAW0G/iAAAQIBAAEDAQAIBwEAAQMBAAECAQABAwHsAQMB7AEDAewB/wEAAewBbQH+BG0gAAECAQAB
|
||||
AwEACAcBAAEDAQABAgEAAewBAwHsAQMB7AEDAf8BAAHsAQACbSMAAQIBAAEDAQAIBwMAAQIBAAEDAewB
|
||||
AwHsAQcB/wHsAQAB7AIAAW0jAAECAQABAwEACAcBAAEHAQABAgEAAewBAwEHAf8B7AEAA+wmAAECDgAB
|
||||
AgEAAQcB/wHsAQAF7CYAEAIwAAFCAU0BPgcAAT4DAAEoAwABQAMAASADAAEBAQABAQYAAQEWAAP/gwAB
|
||||
/AF/BgAB8AF/BgABwAF/BwABHwcAAR8HAAEXBwABBycAAQcHAAEXBwABHwcAAR8HAAEfGgAL
|
||||
</value>
|
||||
</data>
|
||||
<data name="Panel2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="Label19.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="LBSelect.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="Button11.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="Label22.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="LBSort.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="Label21.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="lbSortfields.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="$this.Name">
|
||||
<value>frmSortSelect</value>
|
||||
</data>
|
||||
</root>
|
||||
764
EDOKA/Utils/frmSortSelect.vb
Normal file
764
EDOKA/Utils/frmSortSelect.vb
Normal file
@@ -0,0 +1,764 @@
|
||||
Imports System.Data.SqlClient
|
||||
Imports System.Data.SqlTypes
|
||||
Imports System.Math
|
||||
Public Class frmSortSelect
|
||||
Inherits System.Windows.Forms.Form
|
||||
|
||||
#Region " Vom Windows Form Designer generierter Code "
|
||||
|
||||
Public Sub New()
|
||||
MyBase.New()
|
||||
|
||||
' Dieser Aufruf ist für den Windows Form-Designer erforderlich.
|
||||
InitializeComponent()
|
||||
|
||||
' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen
|
||||
|
||||
End Sub
|
||||
|
||||
' Die Form überschreibt den Löschvorgang der Basisklasse, um Komponenten zu bereinigen.
|
||||
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
|
||||
If disposing Then
|
||||
If Not (components Is Nothing) Then
|
||||
components.Dispose()
|
||||
End If
|
||||
End If
|
||||
MyBase.Dispose(disposing)
|
||||
End Sub
|
||||
|
||||
' Für Windows Form-Designer erforderlich
|
||||
Private components As System.ComponentModel.IContainer
|
||||
|
||||
'HINWEIS: Die folgende Prozedur ist für den Windows Form-Designer erforderlich
|
||||
'Sie kann mit dem Windows Form-Designer modifiziert werden.
|
||||
'Verwenden Sie nicht den Code-Editor zur Bearbeitung.
|
||||
Friend WithEvents SqlConnection1 As System.Data.SqlClient.SqlConnection
|
||||
Friend WithEvents dsSortOrderUser As System.Data.DataSet
|
||||
Friend WithEvents dsSortOrder As System.Data.DataSet
|
||||
Friend WithEvents daSortOrder As System.Data.SqlClient.SqlDataAdapter
|
||||
Friend WithEvents SqlSelectCommand1 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents SqlInsertCommand1 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents SqlUpdateCommand1 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents SqlDeleteCommand1 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents daSortOrderUser As System.Data.SqlClient.SqlDataAdapter
|
||||
Friend WithEvents SqlSelectCommand2 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents SqlInsertCommand2 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents SqlUpdateCommand2 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents SqlDeleteCommand2 As System.Data.SqlClient.SqlCommand
|
||||
Friend WithEvents ContextMenu2 As System.Windows.Forms.ContextMenu
|
||||
Friend WithEvents mnuUp As System.Windows.Forms.MenuItem
|
||||
Friend WithEvents mnuDown As System.Windows.Forms.MenuItem
|
||||
Friend WithEvents mnuDelete As System.Windows.Forms.MenuItem
|
||||
Friend WithEvents mnuSortOrder As System.Windows.Forms.MenuItem
|
||||
Friend WithEvents ToolBar1 As System.Windows.Forms.ToolBar
|
||||
Friend WithEvents speichern As System.Windows.Forms.ToolBarButton
|
||||
Friend WithEvents abbrechen As System.Windows.Forms.ToolBarButton
|
||||
Friend WithEvents ImageList1 As System.Windows.Forms.ImageList
|
||||
Friend WithEvents Panel2 As System.Windows.Forms.Panel
|
||||
Friend WithEvents Label19 As System.Windows.Forms.Label
|
||||
Friend WithEvents Button11 As System.Windows.Forms.Button
|
||||
Friend WithEvents Label22 As System.Windows.Forms.Label
|
||||
Friend WithEvents LBSort As System.Windows.Forms.ListBox
|
||||
Friend WithEvents Label21 As System.Windows.Forms.Label
|
||||
Friend WithEvents lbSortfields As System.Windows.Forms.ListBox
|
||||
Friend WithEvents LBSelect As System.Windows.Forms.ListBox
|
||||
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
|
||||
Me.components = New System.ComponentModel.Container()
|
||||
Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frmSortSelect))
|
||||
Me.SqlConnection1 = New System.Data.SqlClient.SqlConnection()
|
||||
Me.dsSortOrderUser = New System.Data.DataSet()
|
||||
Me.dsSortOrder = New System.Data.DataSet()
|
||||
Me.daSortOrder = New System.Data.SqlClient.SqlDataAdapter()
|
||||
Me.SqlDeleteCommand1 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.SqlInsertCommand1 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.SqlSelectCommand1 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.SqlUpdateCommand1 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.daSortOrderUser = New System.Data.SqlClient.SqlDataAdapter()
|
||||
Me.SqlDeleteCommand2 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.SqlInsertCommand2 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.SqlSelectCommand2 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.SqlUpdateCommand2 = New System.Data.SqlClient.SqlCommand()
|
||||
Me.ContextMenu2 = New System.Windows.Forms.ContextMenu()
|
||||
Me.mnuUp = New System.Windows.Forms.MenuItem()
|
||||
Me.mnuDown = New System.Windows.Forms.MenuItem()
|
||||
Me.mnuDelete = New System.Windows.Forms.MenuItem()
|
||||
Me.mnuSortOrder = New System.Windows.Forms.MenuItem()
|
||||
Me.ToolBar1 = New System.Windows.Forms.ToolBar()
|
||||
Me.speichern = New System.Windows.Forms.ToolBarButton()
|
||||
Me.abbrechen = New System.Windows.Forms.ToolBarButton()
|
||||
Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components)
|
||||
Me.Panel2 = New System.Windows.Forms.Panel()
|
||||
Me.Label19 = New System.Windows.Forms.Label()
|
||||
Me.LBSelect = New System.Windows.Forms.ListBox()
|
||||
Me.Button11 = New System.Windows.Forms.Button()
|
||||
Me.Label22 = New System.Windows.Forms.Label()
|
||||
Me.LBSort = New System.Windows.Forms.ListBox()
|
||||
Me.Label21 = New System.Windows.Forms.Label()
|
||||
Me.lbSortfields = New System.Windows.Forms.ListBox()
|
||||
CType(Me.dsSortOrderUser, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
CType(Me.dsSortOrder, System.ComponentModel.ISupportInitialize).BeginInit()
|
||||
Me.Panel2.SuspendLayout()
|
||||
Me.SuspendLayout()
|
||||
'
|
||||
'SqlConnection1
|
||||
'
|
||||
Me.SqlConnection1.ConnectionString = "data source=tgtsqledokabssf;initial catalog=edoka;integrated security=SSPI;persis" & _
|
||||
"t security info=False;workstation id=TG602643;packet size=4096"
|
||||
'
|
||||
'dsSortOrderUser
|
||||
'
|
||||
Me.dsSortOrderUser.DataSetName = "NewDataSet"
|
||||
Me.dsSortOrderUser.Locale = New System.Globalization.CultureInfo("de-CH")
|
||||
'
|
||||
'dsSortOrder
|
||||
'
|
||||
Me.dsSortOrder.DataSetName = "NewDataSet"
|
||||
Me.dsSortOrder.Locale = New System.Globalization.CultureInfo("de-CH")
|
||||
'
|
||||
'daSortOrder
|
||||
'
|
||||
Me.daSortOrder.DeleteCommand = Me.SqlDeleteCommand1
|
||||
Me.daSortOrder.InsertCommand = Me.SqlInsertCommand1
|
||||
Me.daSortOrder.SelectCommand = Me.SqlSelectCommand1
|
||||
Me.daSortOrder.TableMappings.AddRange(New System.Data.Common.DataTableMapping() {New System.Data.Common.DataTableMapping("Table", "ReportingSortOrder", New System.Data.Common.DataColumnMapping() {New System.Data.Common.DataColumnMapping("DisplayFieldName", "DisplayFieldName"), New System.Data.Common.DataColumnMapping("Aufsteigend", "Aufsteigend"), New System.Data.Common.DataColumnMapping("ID", "ID"), New System.Data.Common.DataColumnMapping("ReportID", "ReportID"), New System.Data.Common.DataColumnMapping("ReportFieldName", "ReportFieldName")})})
|
||||
Me.daSortOrder.UpdateCommand = Me.SqlUpdateCommand1
|
||||
'
|
||||
'SqlDeleteCommand1
|
||||
'
|
||||
Me.SqlDeleteCommand1.CommandText = "[pv_ReportingSortOrder_delete]"
|
||||
Me.SqlDeleteCommand1.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlDeleteCommand1.Connection = Me.SqlConnection1
|
||||
Me.SqlDeleteCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlDeleteCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ID", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Aufsteigend", System.Data.SqlDbType.Bit, 1, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Aufsteigend", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_DisplayFieldName", System.Data.SqlDbType.VarChar, 1024, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "DisplayFieldName", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportFieldName", System.Data.SqlDbType.VarChar, 1024, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportFieldName", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportID", System.Data.DataRowVersion.Original, Nothing))
|
||||
'
|
||||
'SqlInsertCommand1
|
||||
'
|
||||
Me.SqlInsertCommand1.CommandText = "[pv_ReportingSortOrder_insert]"
|
||||
Me.SqlInsertCommand1.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlInsertCommand1.Connection = Me.SqlConnection1
|
||||
Me.SqlInsertCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlInsertCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@DisplayFieldName", System.Data.SqlDbType.VarChar, 1024, "DisplayFieldName"))
|
||||
Me.SqlInsertCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Aufsteigend", System.Data.SqlDbType.Bit, 1, "Aufsteigend"))
|
||||
Me.SqlInsertCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ID", System.Data.SqlDbType.Int, 4, "ID"))
|
||||
Me.SqlInsertCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportID", System.Data.SqlDbType.Int, 4, "ReportID"))
|
||||
Me.SqlInsertCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportFieldName", System.Data.SqlDbType.VarChar, 1024, "ReportFieldName"))
|
||||
'
|
||||
'SqlSelectCommand1
|
||||
'
|
||||
Me.SqlSelectCommand1.CommandText = "[pv_ReportingSortOrder_select]"
|
||||
Me.SqlSelectCommand1.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlSelectCommand1.Connection = Me.SqlConnection1
|
||||
Me.SqlSelectCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlSelectCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportID", System.Data.SqlDbType.Int, 4, "ReportID"))
|
||||
'
|
||||
'SqlUpdateCommand1
|
||||
'
|
||||
Me.SqlUpdateCommand1.CommandText = "[pv_ReportingSortOrder_update]"
|
||||
Me.SqlUpdateCommand1.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlUpdateCommand1.Connection = Me.SqlConnection1
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@DisplayFieldName", System.Data.SqlDbType.VarChar, 1024, "DisplayFieldName"))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Aufsteigend", System.Data.SqlDbType.Bit, 1, "Aufsteigend"))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ID", System.Data.SqlDbType.Int, 4, "ID"))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Param1", System.Data.SqlDbType.Int, 4, "ReportID"))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportFieldName", System.Data.SqlDbType.VarChar, 1024, "ReportFieldName"))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ID", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Aufsteigend", System.Data.SqlDbType.Bit, 1, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Aufsteigend", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_DisplayFieldName", System.Data.SqlDbType.VarChar, 1024, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "DisplayFieldName", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportFieldName", System.Data.SqlDbType.VarChar, 1024, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportFieldName", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlUpdateCommand1.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportID", System.Data.DataRowVersion.Original, Nothing))
|
||||
'
|
||||
'daSortOrderUser
|
||||
'
|
||||
Me.daSortOrderUser.DeleteCommand = Me.SqlDeleteCommand2
|
||||
Me.daSortOrderUser.InsertCommand = Me.SqlInsertCommand2
|
||||
Me.daSortOrderUser.SelectCommand = Me.SqlSelectCommand2
|
||||
Me.daSortOrderUser.TableMappings.AddRange(New System.Data.Common.DataTableMapping() {New System.Data.Common.DataTableMapping("Table", "ReportingSortOrderUser", New System.Data.Common.DataColumnMapping() {New System.Data.Common.DataColumnMapping("ID", "ID"), New System.Data.Common.DataColumnMapping("ReportingSortOrderID", "ReportingSortOrderID"), New System.Data.Common.DataColumnMapping("ReportID", "ReportID"), New System.Data.Common.DataColumnMapping("DisplayFieldName", "DisplayFieldName"), New System.Data.Common.DataColumnMapping("ReportFieldName", "ReportFieldName"), New System.Data.Common.DataColumnMapping("Aufsteigend", "Aufsteigend"), New System.Data.Common.DataColumnMapping("mitarbeiternr", "mitarbeiternr"), New System.Data.Common.DataColumnMapping("SortOrder", "SortOrder"), New System.Data.Common.DataColumnMapping("Mandant_Nr", "Mandant_Nr"), New System.Data.Common.DataColumnMapping("Aktiv", "Aktiv"), New System.Data.Common.DataColumnMapping("Erstellt_Am", "Erstellt_Am"), New System.Data.Common.DataColumnMapping("Mutiert_Am", "Mutiert_Am"), New System.Data.Common.DataColumnMapping("Mutierer", "Mutierer"), New System.Data.Common.DataColumnMapping("Loeschen", "Loeschen")})})
|
||||
Me.daSortOrderUser.UpdateCommand = Me.SqlUpdateCommand2
|
||||
'
|
||||
'SqlDeleteCommand2
|
||||
'
|
||||
Me.SqlDeleteCommand2.CommandText = "[pv_ReportingSortOrderUser_delete]"
|
||||
Me.SqlDeleteCommand2.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlDeleteCommand2.Connection = Me.SqlConnection1
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ID", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Aktiv", System.Data.SqlDbType.Bit, 1, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Aktiv", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Aufsteigend", System.Data.SqlDbType.Bit, 1, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Aufsteigend", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_DisplayFieldName", System.Data.SqlDbType.VarChar, 1024, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "DisplayFieldName", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Erstellt_Am", System.Data.SqlDbType.DateTime, 8, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Erstellt_Am", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Loeschen", System.Data.SqlDbType.Bit, 1, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Loeschen", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Mandant_Nr", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Mandant_Nr", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Mutierer", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Mutierer", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Mutiert_Am", System.Data.SqlDbType.DateTime, 8, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "Mutiert_Am", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportFieldName", System.Data.SqlDbType.VarChar, 1024, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportFieldName", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportID", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportingSortOrderID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "ReportingSortOrderID", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_SortOrder", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "SortOrder", System.Data.DataRowVersion.Original, Nothing))
|
||||
Me.SqlDeleteCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_mitarbeiternr", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "mitarbeiternr", System.Data.DataRowVersion.Original, Nothing))
|
||||
'
|
||||
'SqlInsertCommand2
|
||||
'
|
||||
Me.SqlInsertCommand2.CommandText = "[pv_ReportingSortOrderUser_insert]"
|
||||
Me.SqlInsertCommand2.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlInsertCommand2.Connection = Me.SqlConnection1
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ID", System.Data.SqlDbType.Int, 4, "ID"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportingSortOrderID", System.Data.SqlDbType.Int, 4, "ReportingSortOrderID"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportID", System.Data.SqlDbType.Int, 4, "ReportID"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@DisplayFieldName", System.Data.SqlDbType.VarChar, 1024, "DisplayFieldName"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportFieldName", System.Data.SqlDbType.VarChar, 1024, "ReportFieldName"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Aufsteigend", System.Data.SqlDbType.Bit, 1, "Aufsteigend"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@mitarbeiternr", System.Data.SqlDbType.Int, 4, "mitarbeiternr"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@SortOrder", System.Data.SqlDbType.Int, 4, "SortOrder"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Mandant_Nr", System.Data.SqlDbType.Int, 4, "Mandant_Nr"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Aktiv", System.Data.SqlDbType.Bit, 1, "Aktiv"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Erstellt_Am", System.Data.SqlDbType.DateTime, 8, "Erstellt_Am"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Mutiert_Am", System.Data.SqlDbType.DateTime, 8, "Mutiert_Am"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Mutierer", System.Data.SqlDbType.Int, 4, "Mutierer"))
|
||||
Me.SqlInsertCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Loeschen", System.Data.SqlDbType.Bit, 1, "Loeschen"))
|
||||
'
|
||||
'SqlSelectCommand2
|
||||
'
|
||||
Me.SqlSelectCommand2.CommandText = "[pv_ReportingSortOrderUser_select]"
|
||||
Me.SqlSelectCommand2.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlSelectCommand2.Connection = Me.SqlConnection1
|
||||
Me.SqlSelectCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(0, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlSelectCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportID", System.Data.SqlDbType.Int, 4, "ReportID"))
|
||||
Me.SqlSelectCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@mitarbeiternr", System.Data.SqlDbType.Int, 4, "mitarbeiternr"))
|
||||
'
|
||||
'SqlUpdateCommand2
|
||||
'
|
||||
Me.SqlUpdateCommand2.CommandText = "[pv_ReportingSortOrderUser_update]"
|
||||
Me.SqlUpdateCommand2.CommandType = System.Data.CommandType.StoredProcedure
|
||||
Me.SqlUpdateCommand2.Connection = Me.SqlConnection1
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@RETURN_VALUE", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.ReturnValue, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportingSortOrderID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@DisplayFieldName", System.Data.SqlDbType.VarChar, 1024))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@ReportFieldName", System.Data.SqlDbType.VarChar, 1024))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Aufsteigend", System.Data.SqlDbType.Bit, 1))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@mitarbeiternr", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@SortOrder", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Mandant_Nr", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Aktiv", System.Data.SqlDbType.Bit, 1))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Erstellt_Am", System.Data.SqlDbType.DateTime, 8))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Mutiert_Am", System.Data.SqlDbType.DateTime, 8))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Mutierer", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Loeschen", System.Data.SqlDbType.Bit, 1))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Aktiv", System.Data.SqlDbType.Bit, 1))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Aufsteigend", System.Data.SqlDbType.Bit, 1))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_DisplayFieldName", System.Data.SqlDbType.VarChar, 1024))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Erstellt_Am", System.Data.SqlDbType.DateTime, 8))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Loeschen", System.Data.SqlDbType.Bit, 1))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Mandant_Nr", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Mutierer", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_Mutiert_Am", System.Data.SqlDbType.DateTime, 8))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportFieldName", System.Data.SqlDbType.VarChar, 1024))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_ReportingSortOrderID", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_SortOrder", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
Me.SqlUpdateCommand2.Parameters.Add(New System.Data.SqlClient.SqlParameter("@Original_mitarbeiternr", System.Data.SqlDbType.Int, 4, System.Data.ParameterDirection.Input, False, CType(10, Byte), CType(0, Byte), "", System.Data.DataRowVersion.Current, Nothing))
|
||||
'
|
||||
'ContextMenu2
|
||||
'
|
||||
Me.ContextMenu2.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuUp, Me.mnuDown, Me.mnuDelete, Me.mnuSortOrder})
|
||||
'
|
||||
'mnuUp
|
||||
'
|
||||
Me.mnuUp.Index = 0
|
||||
Me.mnuUp.Text = "&Aufwärts"
|
||||
'
|
||||
'mnuDown
|
||||
'
|
||||
Me.mnuDown.Index = 1
|
||||
Me.mnuDown.Text = "A&bwärts"
|
||||
'
|
||||
'mnuDelete
|
||||
'
|
||||
Me.mnuDelete.Index = 2
|
||||
Me.mnuDelete.Text = "&Löschen"
|
||||
'
|
||||
'mnuSortOrder
|
||||
'
|
||||
Me.mnuSortOrder.Index = 3
|
||||
Me.mnuSortOrder.Text = "Sortierung ändern"
|
||||
'
|
||||
'ToolBar1
|
||||
'
|
||||
Me.ToolBar1.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.abbrechen, Me.speichern})
|
||||
Me.ToolBar1.DropDownArrows = True
|
||||
Me.ToolBar1.ImageList = Me.ImageList1
|
||||
Me.ToolBar1.Name = "ToolBar1"
|
||||
Me.ToolBar1.ShowToolTips = True
|
||||
Me.ToolBar1.Size = New System.Drawing.Size(338, 25)
|
||||
Me.ToolBar1.TabIndex = 11
|
||||
'
|
||||
'speichern
|
||||
'
|
||||
Me.speichern.ImageIndex = 0
|
||||
Me.speichern.Tag = "Speichern"
|
||||
Me.speichern.ToolTipText = "übernehmen"
|
||||
'
|
||||
'abbrechen
|
||||
'
|
||||
Me.abbrechen.ImageIndex = 1
|
||||
Me.abbrechen.Tag = "Abbrechen"
|
||||
Me.abbrechen.ToolTipText = "Beenden ohne Datenübernahme"
|
||||
'
|
||||
'ImageList1
|
||||
'
|
||||
Me.ImageList1.ColorDepth = System.Windows.Forms.ColorDepth.Depth8Bit
|
||||
Me.ImageList1.ImageSize = New System.Drawing.Size(16, 16)
|
||||
Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer)
|
||||
Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent
|
||||
'
|
||||
'Panel2
|
||||
'
|
||||
Me.Panel2.Controls.AddRange(New System.Windows.Forms.Control() {Me.Label19, Me.LBSelect, Me.Button11, Me.Label22, Me.LBSort, Me.Label21, Me.lbSortfields})
|
||||
Me.Panel2.Dock = System.Windows.Forms.DockStyle.Left
|
||||
Me.Panel2.Location = New System.Drawing.Point(0, 25)
|
||||
Me.Panel2.Name = "Panel2"
|
||||
Me.Panel2.Size = New System.Drawing.Size(328, 508)
|
||||
Me.Panel2.TabIndex = 12
|
||||
'
|
||||
'Label19
|
||||
'
|
||||
Me.Label19.Location = New System.Drawing.Point(176, 15)
|
||||
Me.Label19.Name = "Label19"
|
||||
Me.Label19.Size = New System.Drawing.Size(100, 16)
|
||||
Me.Label19.TabIndex = 27
|
||||
Me.Label19.Text = "Sortierungsart"
|
||||
'
|
||||
'LBSelect
|
||||
'
|
||||
Me.LBSelect.ContextMenu = Me.ContextMenu2
|
||||
Me.LBSelect.Location = New System.Drawing.Point(16, 288)
|
||||
Me.LBSelect.Name = "LBSelect"
|
||||
Me.LBSelect.Size = New System.Drawing.Size(296, 199)
|
||||
Me.LBSelect.TabIndex = 26
|
||||
'
|
||||
'Button11
|
||||
'
|
||||
Me.Button11.Location = New System.Drawing.Point(128, 248)
|
||||
Me.Button11.Name = "Button11"
|
||||
Me.Button11.Size = New System.Drawing.Size(80, 24)
|
||||
Me.Button11.TabIndex = 25
|
||||
Me.Button11.Text = "Einfügen"
|
||||
'
|
||||
'Label22
|
||||
'
|
||||
Me.Label22.Location = New System.Drawing.Point(16, 272)
|
||||
Me.Label22.Name = "Label22"
|
||||
Me.Label22.Size = New System.Drawing.Size(100, 16)
|
||||
Me.Label22.TabIndex = 24
|
||||
Me.Label22.Text = "Sortierung"
|
||||
'
|
||||
'LBSort
|
||||
'
|
||||
Me.LBSort.Items.AddRange(New Object() {"Absteigend", "Aufsteigend"})
|
||||
Me.LBSort.Location = New System.Drawing.Point(176, 31)
|
||||
Me.LBSort.Name = "LBSort"
|
||||
Me.LBSort.Size = New System.Drawing.Size(136, 199)
|
||||
Me.LBSort.Sorted = True
|
||||
Me.LBSort.TabIndex = 22
|
||||
'
|
||||
'Label21
|
||||
'
|
||||
Me.Label21.Location = New System.Drawing.Point(16, 15)
|
||||
Me.Label21.Name = "Label21"
|
||||
Me.Label21.Size = New System.Drawing.Size(100, 16)
|
||||
Me.Label21.TabIndex = 21
|
||||
Me.Label21.Text = "Sortierkriterien"
|
||||
'
|
||||
'lbSortfields
|
||||
'
|
||||
Me.lbSortfields.Location = New System.Drawing.Point(16, 31)
|
||||
Me.lbSortfields.Name = "lbSortfields"
|
||||
Me.lbSortfields.Size = New System.Drawing.Size(136, 199)
|
||||
Me.lbSortfields.Sorted = True
|
||||
Me.lbSortfields.TabIndex = 20
|
||||
'
|
||||
'frmSortSelect
|
||||
'
|
||||
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
|
||||
Me.ClientSize = New System.Drawing.Size(338, 533)
|
||||
Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Panel2, Me.ToolBar1})
|
||||
Me.Name = "frmSortSelect"
|
||||
Me.Text = "Sortierung"
|
||||
CType(Me.dsSortOrderUser, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
CType(Me.dsSortOrder, System.ComponentModel.ISupportInitialize).EndInit()
|
||||
Me.Panel2.ResumeLayout(False)
|
||||
Me.ResumeLayout(False)
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Declaration "
|
||||
Dim m_sTableName As String
|
||||
Dim m_sDatenherkunft As String
|
||||
Dim m_sDislpayResult As String
|
||||
Dim m_sNavigationResult As String
|
||||
Dim m_sReportID As String
|
||||
Dim m_iLastID As Integer
|
||||
Dim i As Integer
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Property "
|
||||
Property TableName() As String
|
||||
Get
|
||||
Return m_sTableName
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_sTableName = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
|
||||
Property Datenherkunft() As String
|
||||
' Werte dienen für die Anziege
|
||||
Get
|
||||
Return m_sDatenherkunft
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_sDatenherkunft = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property NavigationResult() As String
|
||||
' Werte dienen für die Steuerung
|
||||
Get
|
||||
Return m_sNavigationResult
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_sNavigationResult = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property DislpayResult() As String
|
||||
Get
|
||||
Return m_sDislpayResult
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_sDislpayResult = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
Property ReportID() As String
|
||||
Get
|
||||
Return m_sReportID
|
||||
End Get
|
||||
Set(ByVal Value As String)
|
||||
m_sReportID = Value
|
||||
End Set
|
||||
End Property
|
||||
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Command Controlsfunction"
|
||||
|
||||
|
||||
Private Sub cmdOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
|
||||
End Sub
|
||||
|
||||
Private Sub cmdCancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
|
||||
Me.DialogResult = DialogResult.Cancel
|
||||
Me.Close()
|
||||
End Sub
|
||||
|
||||
Private Sub grdSortOrderUser_BeforeInsert(ByVal sender As System.Object, ByVal e As C1.Win.C1TrueDBGrid.CancelEventArgs)
|
||||
Debug.Write("BeforeInsert ")
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub grdSortOrderUser_BeforeColEdit(ByVal sender As System.Object, ByVal e As C1.Win.C1TrueDBGrid.BeforeColEditEventArgs)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Formular Funktionen "
|
||||
|
||||
Private Sub frmSortSelect_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
||||
Dim iCount As Integer
|
||||
Dim iWidth As Integer = 50
|
||||
|
||||
Try
|
||||
Globals.WinPos.Get_Position(Me)
|
||||
Catch ex As Exception
|
||||
MsgBox(ex.Message)
|
||||
End Try
|
||||
|
||||
Me.SqlConnection1.ConnectionString = Globals.sConnectionString
|
||||
Me.SqlConnection1.Open()
|
||||
|
||||
'===============================================================================
|
||||
'Datasource Sortorderfelder des Reports
|
||||
'===============================================================================
|
||||
Me.daSortOrder.SelectCommand.Parameters("@ReportID").Value = m_sReportID
|
||||
Me.daSortOrder.Fill(Me.dsSortOrder)
|
||||
|
||||
For iCount = 0 To dsSortOrder.Tables(0).Rows.Count - 1
|
||||
Me.lbSortfields.Items.Add(dsSortOrder.Tables(0).Rows(iCount).Item("DisplayFieldName"))
|
||||
Next
|
||||
If dsSortOrder.Tables(0).Rows.Count > 0 Then
|
||||
Me.lbSortfields.SelectedIndex = 0
|
||||
End If
|
||||
LBSort.SelectedIndex = 0
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub frmSortSelect_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
|
||||
Try
|
||||
Globals.WinPos.Set_Position(Me)
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Data Funktionen "
|
||||
|
||||
|
||||
|
||||
Private Sub FillProperty()
|
||||
'===============================================================================
|
||||
'Desc : Füllen der Property DislpayResult & NavigationResult
|
||||
'Erstellt : koe 10.11.2003
|
||||
'Geaendert :
|
||||
'===============================================================================
|
||||
Dim iCount As Integer
|
||||
Dim iCnt As Integer
|
||||
Dim sSeperater As String
|
||||
Dim sSortOrderDisplay(1) As String
|
||||
Dim sSortOrderNavigation(1) As String
|
||||
Dim sSortOrderDown As String
|
||||
sSortOrderDisplay(0) = " Absteigend "
|
||||
sSortOrderDisplay(1) = " Aufdsteigend "
|
||||
sSortOrderNavigation(0) = " DESC "
|
||||
sSortOrderNavigation(1) = " ASC "
|
||||
m_sNavigationResult = "ORDER BY "
|
||||
|
||||
sSeperater = ""
|
||||
|
||||
|
||||
Dim splitter
|
||||
For iCount = 0 To Me.LBSelect.Items.Count - 1
|
||||
splitter = Microsoft.VisualBasic.Split(Me.LBSelect.Items.Item(iCount), " | ")
|
||||
For iCnt = 0 To Me.dsSortOrder.Tables(0).Rows.Count - 1
|
||||
If splitter(0) = dsSortOrder.Tables(0).Rows(iCnt).Item("DisplayFieldName") Then
|
||||
m_sDislpayResult = m_sDislpayResult & sSeperater & dsSortOrder.Tables(0).Rows(iCnt).Item("DisplayFieldName") & " " & splitter(1)
|
||||
Select Case splitter(1)
|
||||
Case "Absteigend"
|
||||
m_sNavigationResult = m_sNavigationResult & sSeperater & dsSortOrder.Tables(0).Rows(iCnt).Item("ReportFieldName") & " DESC"
|
||||
Case "Aufsteigend"
|
||||
m_sNavigationResult = m_sNavigationResult & sSeperater & dsSortOrder.Tables(0).Rows(iCnt).Item("ReportFieldName") & " ASC"
|
||||
End Select
|
||||
sSeperater = ", "
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
|
||||
|
||||
Next
|
||||
'Insertitem(Me.lbSortfields, splitter(0))
|
||||
'Me.LBSelect.Items.RemoveAt(Me.LBSelect.SelectedIndex)
|
||||
|
||||
'With grdSortOrderUser
|
||||
' Try
|
||||
' .AllowAddNew = False
|
||||
' If .Splits(0).Rows.Count = 0 Then
|
||||
' m_sNavigationResult = ""
|
||||
' End If
|
||||
' For iCount = 0 To .Splits(0).Rows.Count - 1
|
||||
' m_sDislpayResult = m_sDislpayResult & sSeperater & .Columns("DisplayFieldName").CellValue(iCount) & sSortOrderDisplay(Abs(CInt(.Columns("Aufsteigend").CellValue(iCount))))
|
||||
' m_sNavigationResult = m_sNavigationResult & sSeperater & .Columns("ReportFieldName").CellValue(iCount) & sSortOrderNavigation(Abs(CInt(.Columns("Aufsteigend").CellValue(iCount))))
|
||||
' sSeperater = ", "
|
||||
' Next
|
||||
' Catch ex As Exception
|
||||
' MsgBox(ex.Message)
|
||||
' End Try
|
||||
'End With
|
||||
'ORDER BY Partner.NRPAR00, Partner.BKPAR00, dokumenttyp.bezeichnung, dokument.erstelltam, dokument.mutiertam, dokument_status.bezeichnung DESC
|
||||
Select Case m_sDatenherkunft
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
End Sub
|
||||
|
||||
#End Region
|
||||
|
||||
#Region " Extra Funktionen "
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
|
||||
|
||||
Private Sub Insertitem(ByVal lb As ListBox, ByVal s As String)
|
||||
Dim i As Integer
|
||||
Dim inserted As Boolean = False
|
||||
For i = 0 To lb.Items.Count - 1
|
||||
lb.SelectedIndex = i
|
||||
If s > lb.SelectedItem And Not inserted Then
|
||||
lb.Items.Insert(i, s)
|
||||
inserted = True
|
||||
End If
|
||||
Next
|
||||
If Not inserted Then lb.Items.Insert(i, s)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Private Sub mnuUp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuUp.Click
|
||||
Dim i As Integer
|
||||
Dim s As String
|
||||
Try
|
||||
i = LBSelect.SelectedIndex
|
||||
s = LBSelect.SelectedItem
|
||||
If i > 0 Then
|
||||
LBSelect.Items.RemoveAt(i)
|
||||
LBSelect.Items.Insert(i - 1, s)
|
||||
LBSelect.SelectedIndex = i - 1
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
'changes = True
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub mnuDown_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuDown.Click
|
||||
Dim i As Integer
|
||||
Dim s As String
|
||||
Try
|
||||
i = LBSelect.SelectedIndex
|
||||
s = LBSelect.SelectedItem
|
||||
If i < LBSelect.Items.Count - 1 Then
|
||||
LBSelect.Items.RemoveAt(i)
|
||||
LBSelect.Items.Insert(i + 1, s)
|
||||
LBSelect.SelectedIndex = i + 1
|
||||
End If
|
||||
'changes = True
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub mnuSortOrder_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSortOrder.Click
|
||||
Dim s, s1 As String
|
||||
Dim splitter
|
||||
Try
|
||||
s = LBSelect.SelectedItem
|
||||
splitter = Microsoft.VisualBasic.Split(s, " | ")
|
||||
Select Case splitter(1)
|
||||
Case "Absteigend"
|
||||
s1 = "Aufsteigend"
|
||||
Case "Aufsteigend"
|
||||
s1 = "Absteigend"
|
||||
Case Else
|
||||
s1 = "Aufsteigend"
|
||||
End Select
|
||||
s = splitter(0) + " | " + s1
|
||||
i = LBSelect.SelectedIndex
|
||||
LBSelect.SelectedIndex = i
|
||||
LBSelect.Items.RemoveAt(i)
|
||||
LBSelect.Items.Insert(i, s)
|
||||
Catch
|
||||
End Try
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub AddToSelected()
|
||||
Try
|
||||
If lbSortfields.SelectedItems.Count > 0 Then
|
||||
|
||||
' If lbSortfields.Items.Count > 0 Then
|
||||
Me.LBSelect.Items.Add(Me.lbSortfields.SelectedItem + " | " + Me.LBSort.SelectedItem)
|
||||
Me.lbSortfields.Items.RemoveAt(Me.lbSortfields.SelectedIndex)
|
||||
End If
|
||||
If lbSortfields.Items.Count > 0 Then
|
||||
lbSortfields.SelectedIndex = 0
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub DeleteFromSelected()
|
||||
Dim splitter
|
||||
Try
|
||||
If LBSelect.SelectedItems.Count > 0 Then
|
||||
|
||||
'If LBSelect.Items.Count > 0 Then
|
||||
splitter = Microsoft.VisualBasic.Split(Me.LBSelect.SelectedItem, " | ")
|
||||
Insertitem(Me.lbSortfields, splitter(0))
|
||||
Me.LBSelect.Items.RemoveAt(Me.LBSelect.SelectedIndex)
|
||||
End If
|
||||
If LBSelect.Items.Count > 0 Then
|
||||
LBSelect.SelectedIndex = 0
|
||||
End If
|
||||
Catch
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub mnuDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuDelete.Click
|
||||
DeleteFromSelected()
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick
|
||||
Select Case e.Button.Tag
|
||||
Case "Abbrechen"
|
||||
Me.DialogResult = DialogResult.Cancel
|
||||
Me.Close()
|
||||
Case "Speichern"
|
||||
FillProperty()
|
||||
Me.DialogResult = DialogResult.OK
|
||||
Me.Close()
|
||||
End Select
|
||||
End Sub
|
||||
Private Sub Button11_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button11.Click
|
||||
AddToSelected()
|
||||
End Sub
|
||||
|
||||
Private Sub lbSortfields_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lbSortfields.DoubleClick
|
||||
Button11_Click(sender, e)
|
||||
End Sub
|
||||
|
||||
Private Sub LBSelect_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles LBSelect.DoubleClick
|
||||
DeleteFromSelected()
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub LBSort_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles LBSort.DoubleClick
|
||||
Button11_Click(sender, e)
|
||||
End Sub
|
||||
End Class
|
||||
295
EDOKA/Utils/mMain.vb
Normal file
295
EDOKA/Utils/mMain.vb
Normal file
@@ -0,0 +1,295 @@
|
||||
Imports System.Windows.Forms
|
||||
Imports System.Diagnostics
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Text
|
||||
Imports System.Runtime.Serialization.Formatters.Binary
|
||||
|
||||
Imports System.IO
|
||||
|
||||
Imports EDOKALib.Common
|
||||
|
||||
Public Module mMain
|
||||
Public Class SerialHelper
|
||||
'///Class mercilessly ripped-off from Dr GUI.Net #3 :)
|
||||
Public Shared Function SerializeToBase64String(ByVal o As Object) As String
|
||||
Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
|
||||
Dim serialMemoryStream As New MemoryStream()
|
||||
formatter.Serialize(serialMemoryStream, o)
|
||||
Dim bytes() As Byte = serialMemoryStream.ToArray()
|
||||
Return Convert.ToBase64String(bytes).Trim()
|
||||
End Function
|
||||
|
||||
Public Shared Function DeserializeFromBase64String(ByVal base64String As String) As Object
|
||||
Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
|
||||
base64String = base64String.Trim(ControlChars.NullChar)
|
||||
Dim bytes() As Byte = Convert.FromBase64String(base64String)
|
||||
Dim serialMemoryStream As New MemoryStream(bytes)
|
||||
Return formatter.Deserialize(serialMemoryStream)
|
||||
End Function
|
||||
End Class
|
||||
|
||||
Public Class SingleInstance
|
||||
Public Interface ISingleInstanceForm
|
||||
Delegate Sub _WndProc(ByVal m As Message, ByRef Cancel As Boolean)
|
||||
Event WndProc As _WndProc
|
||||
ReadOnly Property Handle() As IntPtr
|
||||
Sub HandleCommand(ByVal strCmd As String)
|
||||
End Interface
|
||||
#Region "API"
|
||||
Private Const WM_COPYDATA As Integer = &H4A
|
||||
|
||||
<StructLayout(LayoutKind.Sequential)> _
|
||||
Public Structure COPYDATASTRUCT
|
||||
Public dwData As Integer
|
||||
Public cbData As Integer
|
||||
Public lpData As Integer
|
||||
End Structure
|
||||
|
||||
Private Declare Auto Function GetProp Lib "user32" (ByVal hWnd As Integer, ByVal lpString As String) As Integer
|
||||
Private Declare Auto Function SetProp Lib "user32" (ByVal hWnd As Integer, ByVal lpString As String, ByVal hData As Integer) As Integer
|
||||
|
||||
Private Delegate Function EnumWindowsProc(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
|
||||
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumWindowsProc, ByVal lParam As Integer) As Integer
|
||||
|
||||
Private Declare Auto Function SendMessage Lib "user32" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
|
||||
|
||||
Public Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
|
||||
(ByVal windowHandle As IntPtr, _
|
||||
ByVal Msg As UInt16, _
|
||||
ByVal wParam As IntPtr, _
|
||||
ByRef lParam As COPYDATASTRUCT, _
|
||||
ByVal flags As SendMessageTimeoutFlags, _
|
||||
ByVal timeout As UInt16, _
|
||||
ByVal result As IntPtr) As IntPtr
|
||||
|
||||
<Flags()> _
|
||||
Public Enum SendMessageTimeoutFlags As Short
|
||||
SMTO_NORMAL = &H0 '0x0000
|
||||
SMTO_BLOCK = &H1 ''0x0001
|
||||
SMTO_ABORTIFHUNG = &H2 '0x0002
|
||||
SMTO_NOTIMEOUTIFNOTHUNG = &H8 '0x0008
|
||||
End Enum
|
||||
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "EnumWindows"
|
||||
Private Shared _EWP As New EnumWindowsProc(AddressOf EWP)
|
||||
Private Shared Function EWP(ByVal hWnd As Integer, ByVal lParam As Integer) As Integer
|
||||
' Customised windows enumeration procedure. Stops
|
||||
' when it finds another application with the Window
|
||||
' property set, or when all windows are exhausted.
|
||||
Try
|
||||
If IsThisApp(hWnd) Then
|
||||
_hWnd = hWnd
|
||||
Return 0
|
||||
Else
|
||||
Return 1
|
||||
End If
|
||||
Catch
|
||||
Return 0
|
||||
End Try
|
||||
End Function
|
||||
Private Shared Function IsThisApp(ByVal hWnd As Long) As Boolean
|
||||
' Check if the windows property is set for this
|
||||
' window handle:
|
||||
If GetProp(hWnd, _mcThisAppID & "_APPLICATION") = 1 Then
|
||||
Return True
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Shared Function FindWindow() As Boolean
|
||||
If _hWnd = -1 Then
|
||||
EnumWindows(_EWP, 0)
|
||||
If _hWnd = -1 Then
|
||||
Return False
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
Else
|
||||
Return True
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Shared Function SendCDSToWindow(ByVal CD As COPYDATASTRUCT) As Boolean
|
||||
Try
|
||||
Dim lpCD As IntPtr = Marshal.AllocHGlobal(Len(CD))
|
||||
Marshal.StructureToPtr(CD, lpCD, False)
|
||||
'SendMessage(_hWnd, WM_COPYDATA, _hWnd, lpCD)
|
||||
Dim result As IntPtr
|
||||
Dim retVal As IntPtr
|
||||
|
||||
Dim handle As New IntPtr(_hWnd)
|
||||
|
||||
retVal = SendMessageTimeout(handle, Convert.ToUInt16(WM_COPYDATA), handle, CD, SendMessageTimeoutFlags.SMTO_NORMAL, Convert.ToUInt16(2000), result)
|
||||
|
||||
Marshal.FreeHGlobal(lpCD)
|
||||
|
||||
Return True
|
||||
Catch ex As Exception
|
||||
TKBLib.Errorhandling.TraceHelper.Msg("EdokaApp.mMain.SendCDSToWindow", ex.Message & ex.StackTrace, TraceLevel.Error)
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Shared Function SendMessageToWindow(ByVal strCmd As String) As Boolean
|
||||
If _hWnd = -1 Then Return False
|
||||
If Len(strCmd) = 0 Then
|
||||
Try
|
||||
Dim CD As COPYDATASTRUCT
|
||||
With CD
|
||||
.dwData = 0
|
||||
.cbData = 0
|
||||
.lpData = 0
|
||||
End With
|
||||
Return SendCDSToWindow(CD)
|
||||
Catch
|
||||
Return False
|
||||
End Try
|
||||
Else
|
||||
Try
|
||||
Dim B() As Byte = Encoding.Default.GetBytes(strCmd)
|
||||
Dim lpB As IntPtr = Marshal.AllocHGlobal(B.Length)
|
||||
Marshal.Copy(B, 0, lpB, B.Length)
|
||||
|
||||
Dim CD As COPYDATASTRUCT
|
||||
With CD
|
||||
.dwData = 0
|
||||
.cbData = B.Length
|
||||
.lpData = lpB.ToInt32
|
||||
End With
|
||||
Erase B
|
||||
|
||||
Try
|
||||
If SendCDSToWindow(CD) Then
|
||||
Return True
|
||||
Else
|
||||
Return False
|
||||
End If
|
||||
Catch
|
||||
Return False
|
||||
Finally
|
||||
Marshal.FreeHGlobal(lpB)
|
||||
End Try
|
||||
|
||||
Catch
|
||||
Return False
|
||||
End Try
|
||||
End If
|
||||
End Function
|
||||
Private Shared Function SendMessageToWindow(ByVal oCmd As Object) As Boolean
|
||||
Try
|
||||
Dim strCmd As String = SerialHelper.SerializeToBase64String(oCmd)
|
||||
Return SendMessageToWindow(strCmd)
|
||||
Catch
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
#End Region
|
||||
|
||||
Private Shared _hWnd As Integer = -1
|
||||
Private Shared _mcThisAppID As String
|
||||
Private Shared oMutex As Threading.Mutex
|
||||
Private Shared _MutexOwned As Boolean = False
|
||||
Private Shared WithEvents MainForm As ISingleInstanceForm
|
||||
|
||||
Shared Sub New()
|
||||
_mcThisAppID = Reflection.Assembly.GetExecutingAssembly().FullName
|
||||
oMutex = New Threading.Mutex(True, _mcThisAppID & "_APPLICATION_MUTEX", _MutexOwned)
|
||||
If Not _MutexOwned Then
|
||||
If Not FindWindow() Then
|
||||
_MutexOwned = True
|
||||
End If
|
||||
End If
|
||||
AddHandler AppDomain.CurrentDomain.ProcessExit, AddressOf OnExit
|
||||
End Sub
|
||||
Private Shared Sub OnExit(ByVal sender As Object, ByVal e As EventArgs)
|
||||
Try
|
||||
If Not oMutex Is Nothing Then
|
||||
oMutex.ReleaseMutex()
|
||||
CType(oMutex, IDisposable).Dispose()
|
||||
oMutex = Nothing
|
||||
End If
|
||||
Catch
|
||||
'Do Nothing
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Public Shared ReadOnly Property IsFirstInstance() As Boolean
|
||||
Get
|
||||
Return _MutexOwned
|
||||
End Get
|
||||
End Property
|
||||
|
||||
Public Shared Function NotifyPreviousWindow() As Boolean
|
||||
Return SendMessageToWindow(vbNullString)
|
||||
End Function
|
||||
Public Shared Function NotifyPreviousWindow(ByVal strText As String) As Boolean
|
||||
Return SendMessageToWindow(strText)
|
||||
End Function
|
||||
Public Shared Function NotifyPreviousWindow(ByVal oCmd As Object) As Boolean
|
||||
Return SendMessageToWindow(oCmd)
|
||||
End Function
|
||||
|
||||
Public Shared Sub SetMainForm(ByVal frm As ISingleInstanceForm)
|
||||
MainForm = frm
|
||||
Try
|
||||
Dim hWnd As Integer = frm.Handle.ToInt32
|
||||
SetProp(hWnd, _mcThisAppID & "_APPLICATION", 1)
|
||||
Catch
|
||||
MainForm = Nothing
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Shared Sub MainForm_WndProc(ByVal m As System.Windows.Forms.Message, ByRef Cancel As Boolean) Handles MainForm.WndProc
|
||||
Select Case m.Msg
|
||||
Case WM_COPYDATA
|
||||
Dim B() As Byte
|
||||
Try
|
||||
Dim CD As COPYDATASTRUCT = m.GetLParam(GetType(COPYDATASTRUCT))
|
||||
ReDim B(CD.cbData)
|
||||
Dim lpData As IntPtr = New IntPtr(CD.lpData)
|
||||
Marshal.Copy(lpData, B, 0, CD.cbData)
|
||||
Dim strData As String = Encoding.Default.GetString(B)
|
||||
TKBLib.Errorhandling.TraceHelper.Msg("EdokaApp.mMain.SingleeInstance.MainForm_WndProc", "Received Windows Msg " & strData, TraceLevel.Info)
|
||||
MainForm.HandleCommand(strData)
|
||||
|
||||
Cancel = True
|
||||
|
||||
Catch
|
||||
Cancel = False
|
||||
Finally
|
||||
Erase B
|
||||
End Try
|
||||
|
||||
Case Else
|
||||
Cancel = False
|
||||
End Select
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
Private MainForm As EDOKAMain
|
||||
|
||||
<STAThread()> Public Function Main(ByVal CmdArgs() As String) As Integer
|
||||
If SingleInstance.IsFirstInstance Then
|
||||
Try
|
||||
g_bRun = True
|
||||
MainForm = New EDOKAMain()
|
||||
|
||||
MainForm.CmdArgsSimulated = CmdArgs
|
||||
|
||||
SingleInstance.SetMainForm(MainForm)
|
||||
Application.Run(MainForm)
|
||||
Catch ex As Exception
|
||||
If Not Force_Exit Then
|
||||
MsgBox(ex.Message)
|
||||
End If
|
||||
End Try
|
||||
Else
|
||||
g_bRun = True
|
||||
SingleInstance.NotifyPreviousWindow(CmdArgs)
|
||||
End If
|
||||
|
||||
End Function
|
||||
End Module
|
||||
|
||||
BIN
EDOKA/Utils/vssver.scc
Normal file
BIN
EDOKA/Utils/vssver.scc
Normal file
Binary file not shown.
Reference in New Issue
Block a user