Initial
This commit is contained in:
236
EDOKA/Backup/Utils/ApplicationFileWatcher.vb
Normal file
236
EDOKA/Backup/Utils/ApplicationFileWatcher.vb
Normal file
@@ -0,0 +1,236 @@
|
||||
Imports System
|
||||
Imports System.Text
|
||||
Imports System.Runtime.InteropServices
|
||||
Imports System.Threading
|
||||
Imports System.IO
|
||||
|
||||
Public Class ApplicationFileWatcher
|
||||
|
||||
#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
|
||||
|
||||
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
|
||||
|
||||
Const STRING_BUFFER_LENGTH As Integer = 255
|
||||
Dim WindowArray As New ArrayList()
|
||||
Dim WithEvents MyTimer As New System.Timers.Timer(1000)
|
||||
|
||||
#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 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
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
#Region "Private Methoden"
|
||||
|
||||
Public Sub SetWindowName()
|
||||
Select Case Me.ApplicationType
|
||||
Case 1 'Word
|
||||
Me.WindowName = Me.Filename + " - Microsoft Word"
|
||||
Me.WindowNamePreview = Me.Filename + " (Seitenansicht) - Microsoft Word"
|
||||
Me.WindowNameDC = Me.Filename + " - DC"
|
||||
Case 2 'Excel
|
||||
Me.WindowName = "Microsoft Excel - " & Me.Filename
|
||||
Me.WindowNamePreview = "Microsoft Excel - " & Me.Filename
|
||||
Me.WindowNameDC = Me.Filename + ""
|
||||
Case 3
|
||||
Me.WindowName = Me.Appname & Me.Filename
|
||||
Me.WindowNamePreview = Me.Appname & Me.Filename
|
||||
Me.WindowNameDC = Me.Filename + ""
|
||||
Case 4
|
||||
Me.WindowName = Me.WindowName
|
||||
Me.WindowNamePreview = Me.WindowNamePreview
|
||||
Me.WindowNameDC = Me.Filename + ""
|
||||
Case Else
|
||||
End Select
|
||||
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("C:\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
|
||||
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
|
||||
|
||||
Private Sub Search_List()
|
||||
Win32API.EnumWindowsDllImport(New Win32API.EnumWindowsCallback(AddressOf _
|
||||
FillActiveWindowsList), 0)
|
||||
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/Backup/Utils/Archivfnkt.vb
Normal file
1056
EDOKA/Backup/Utils/Archivfnkt.vb
Normal file
File diff suppressed because it is too large
Load Diff
27
EDOKA/Backup/Utils/AvaloqDokumentWert.vb
Normal file
27
EDOKA/Backup/Utils/AvaloqDokumentWert.vb
Normal file
@@ -0,0 +1,27 @@
|
||||
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
|
||||
74
EDOKA/Backup/Utils/AvaloqDokumentWerte.vb
Normal file
74
EDOKA/Backup/Utils/AvaloqDokumentWerte.vb
Normal file
@@ -0,0 +1,74 @@
|
||||
Imports System.IO
|
||||
Imports System.Xml
|
||||
Imports System.Xml.Schema
|
||||
|
||||
Public Class AvaloqDokumentWerte
|
||||
|
||||
#Region "Members"
|
||||
Private arrDoukmentWerte As New ArrayList()
|
||||
Private objDokumentWert As AvaloqDokumentWert
|
||||
#End Region
|
||||
|
||||
#Region "Public methods"
|
||||
|
||||
'''<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)
|
||||
|
||||
'read all parameter nodes
|
||||
Dim parameterNodes As XmlNodeList
|
||||
parameterNodes = doc.SelectNodes("action/dokwerte/parameter")
|
||||
|
||||
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)
|
||||
Catch ex As Exception
|
||||
TKBLib.Errorhandling.TraceHelper.Msg("EdokaLib.Common.Action.Load", ex.Message & ex.StackTrace, TraceLevel.Error)
|
||||
End Try
|
||||
parameterCounter = parameterCounter + 1
|
||||
|
||||
Next
|
||||
End If
|
||||
|
||||
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
|
||||
|
||||
'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/Backup/Utils/Crypto.vb
Normal file
34
EDOKA/Backup/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
|
||||
1734
EDOKA/Backup/Utils/DivFnkt.vb
Normal file
1734
EDOKA/Backup/Utils/DivFnkt.vb
Normal file
File diff suppressed because it is too large
Load Diff
400
EDOKA/Backup/Utils/DocMgmt.vb
Normal file
400
EDOKA/Backup/Utils/DocMgmt.vb
Normal file
@@ -0,0 +1,400 @@
|
||||
'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
|
||||
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
|
||||
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) 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)
|
||||
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
|
||||
scmCmdToExecute.Dispose()
|
||||
sdaAdapter.Dispose()
|
||||
End Try
|
||||
End Function
|
||||
|
||||
#End Region
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
End Class
|
||||
|
||||
152
EDOKA/Backup/Utils/EdokaUpdate.vb
Normal file
152
EDOKA/Backup/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
|
||||
131
EDOKA/Backup/Utils/Globals.vb
Normal file
131
EDOKA/Backup/Utils/Globals.vb
Normal file
@@ -0,0 +1,131 @@
|
||||
'*
|
||||
' 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
|
||||
'
|
||||
Module Globals
|
||||
|
||||
|
||||
|
||||
'EDOKA-Version
|
||||
Public Version As String = "4.01"
|
||||
Public Versionsdatum As String = "06. August 2008"
|
||||
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
|
||||
|
||||
'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
|
||||
|
||||
|
||||
#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
|
||||
|
||||
End Module
|
||||
82
EDOKA/Backup/Utils/HHctrlapi.vb
Normal file
82
EDOKA/Backup/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/Backup/Utils/ImageCombobox.resx
Normal file
42
EDOKA/Backup/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/Backup/Utils/ImageCombobox.vb
Normal file
176
EDOKA/Backup/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/Backup/Utils/ImageLibrary.vb
Normal file
6
EDOKA/Backup/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/Backup/Utils/MultiComboBox.resx
Normal file
42
EDOKA/Backup/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>
|
||||
734
EDOKA/Backup/Utils/MultiComboBox.vb
Normal file
734
EDOKA/Backup/Utils/MultiComboBox.vb
Normal file
@@ -0,0 +1,734 @@
|
||||
|
||||
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
|
||||
Me.NullValueMessage = "NullValueMessage"
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
177
EDOKA/Backup/Utils/MyMessage.vb
Normal file
177
EDOKA/Backup/Utils/MyMessage.vb
Normal file
@@ -0,0 +1,177 @@
|
||||
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_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
|
||||
168
EDOKA/Backup/Utils/MySpalten.vb
Normal file
168
EDOKA/Backup/Utils/MySpalten.vb
Normal file
@@ -0,0 +1,168 @@
|
||||
'*
|
||||
' 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
|
||||
10
EDOKA/Backup/Utils/MyText.vb
Normal file
10
EDOKA/Backup/Utils/MyText.vb
Normal file
@@ -0,0 +1,10 @@
|
||||
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
|
||||
29
EDOKA/Backup/Utils/OleCommandTarget.vb
Normal file
29
EDOKA/Backup/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/Backup/Utils/OwnerMenu.vb
Normal file
200
EDOKA/Backup/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/Backup/Utils/RichTextBoxEx.resx
Normal file
42
EDOKA/Backup/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/Backup/Utils/RichTextBoxEx.vb
Normal file
308
EDOKA/Backup/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/Backup/Utils/RichTextBoxHS.resx
Normal file
42
EDOKA/Backup/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/Backup/Utils/RichTextBoxHS.vb
Normal file
161
EDOKA/Backup/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
|
||||
594
EDOKA/Backup/Utils/Statushandling.vb
Normal file
594
EDOKA/Backup/Utils/Statushandling.vb
Normal file
@@ -0,0 +1,594 @@
|
||||
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)
|
||||
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 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
|
||||
115
EDOKA/Backup/Utils/WebOCHostCtrl.resx
Normal file
115
EDOKA/Backup/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/Backup/Utils/WebOCHostCtrl.vb
Normal file
351
EDOKA/Backup/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
|
||||
148
EDOKA/Backup/Utils/Win32API.vb
Normal file
148
EDOKA/Backup/Utils/Win32API.vb
Normal file
@@ -0,0 +1,148 @@
|
||||
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
|
||||
|
||||
|
||||
End Class
|
||||
141
EDOKA/Backup/Utils/WindowPostitions.vb
Normal file
141
EDOKA/Backup/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/Backup/Utils/clsBalloon.vb
Normal file
66
EDOKA/Backup/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
|
||||
|
||||
77
EDOKA/Backup/Utils/clsPerformance.vb
Normal file
77
EDOKA/Backup/Utils/clsPerformance.vb
Normal file
@@ -0,0 +1,77 @@
|
||||
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
|
||||
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
|
||||
End Sub
|
||||
|
||||
Public Sub force_insert_entry(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_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
|
||||
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/Backup/Utils/clsXTimer.vb
Normal file
87
EDOKA/Backup/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
|
||||
108
EDOKA/Backup/Utils/frmProgress.resx
Normal file
108
EDOKA/Backup/Utils/frmProgress.resx
Normal file
@@ -0,0 +1,108 @@
|
||||
<?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="Info.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="Bar1.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
|
||||
<value>Assembly</value>
|
||||
</data>
|
||||
<data name="$this.Name">
|
||||
<value>frmProgress</value>
|
||||
</data>
|
||||
</root>
|
||||
134
EDOKA/Backup/Utils/frmProgress.vb
Normal file
134
EDOKA/Backup/Utils/frmProgress.vb
Normal file
@@ -0,0 +1,134 @@
|
||||
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 Bar1 As UtilityLibrary.WinControls.ProgressBarEx
|
||||
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
|
||||
Me.Info = New System.Windows.Forms.Label()
|
||||
Me.Bar1 = New UtilityLibrary.WinControls.ProgressBarEx()
|
||||
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"
|
||||
'
|
||||
'Bar1
|
||||
'
|
||||
Me.Bar1.BackgroundBitmap = Nothing
|
||||
Me.Bar1.BackgroundColor = System.Drawing.Color.FromArgb(CType(220, Byte), CType(217, Byte), CType(211, Byte))
|
||||
Me.Bar1.Border3D = System.Windows.Forms.Border3DStyle.Flat
|
||||
Me.Bar1.BorderColor = System.Drawing.SystemColors.Highlight
|
||||
Me.Bar1.EnableBorder3D = True
|
||||
Me.Bar1.ForegroundBitmap = Nothing
|
||||
Me.Bar1.ForegroundColor = System.Drawing.Color.Blue
|
||||
Me.Bar1.GradientEndColor = System.Drawing.Color.Navy
|
||||
Me.Bar1.GradientMiddleColor = System.Drawing.Color.Blue
|
||||
Me.Bar1.GradientStartColor = System.Drawing.Color.FromArgb(CType(128, Byte), CType(128, Byte), CType(255, Byte))
|
||||
Me.Bar1.Location = New System.Drawing.Point(8, 40)
|
||||
Me.Bar1.Maximum = 100
|
||||
Me.Bar1.Minimum = 0
|
||||
Me.Bar1.Name = "Bar1"
|
||||
Me.Bar1.ProgressTextColor = System.Drawing.Color.Empty
|
||||
Me.Bar1.ProgressTextHiglightColor = System.Drawing.Color.Empty
|
||||
Me.Bar1.ShowProgressText = True
|
||||
Me.Bar1.Size = New System.Drawing.Size(392, 32)
|
||||
Me.Bar1.Smooth = True
|
||||
Me.Bar1.Step = 10
|
||||
Me.Bar1.TabIndex = 2
|
||||
Me.Bar1.Text = "ProgressBarEx1"
|
||||
Me.Bar1.Value = 0
|
||||
'
|
||||
'frmProgress
|
||||
'
|
||||
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
|
||||
Me.ClientSize = New System.Drawing.Size(408, 87)
|
||||
Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Bar1, 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.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
|
||||
End Class
|
||||
293
EDOKA/Backup/Utils/mMain.vb
Normal file
293
EDOKA/Backup/Utils/mMain.vb
Normal file
@@ -0,0 +1,293 @@
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user