Initial commit

This commit is contained in:
2020-10-21 10:43:18 +02:00
commit 56bd02798f
5848 changed files with 2659025 additions and 0 deletions

View File

@@ -0,0 +1,252 @@
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
'Rel. Office 2010
Private m_WindowNameKomp As String
Property WindowNameKompatibilitaet() As String
Get
Return m_WindowNameKomp
End Get
Set(ByVal value As String)
m_WindowNameKomp = value
End Set
End Property
Private m_WindowNamePreview As String
Property WindowNamePreview() As String
Get
Return m_WindowNamePreview
End Get
Set(ByVal Value As String)
m_WindowNamePreview = Value
End Set
End Property
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.WindowNameKompatibilitaet = Me.Filename + " [Kompatibilitätsmodus] - Microsoft Word"
Me.WindowNamePreview = Me.Filename + " (Seitenansicht) - Microsoft Word"
Me.WindowNameDC = Me.Filename + " - DC"
Case 2 'Excel
Me.WindowName = "Microsoft Excel - " & Me.Filename
Me.WindowNameKompatibilitaet = "Microsoft Excel - " & Me.Filename + " [Kompatibilitätsmodus]"
Me.WindowNamePreview = "Microsoft Excel - " & Me.Filename
Me.WindowNameDC = Me.Filename + " - Excel"
Case 3
Me.WindowName = Me.Filename + " - Adobe Reader"
Me.WindowNameKompatibilitaet = Me.Filename + " - Adobe Reader"
Me.WindowNamePreview = Me.Filename + " - Adobe Reader"
Me.WindowNameDC = Me.Filename + ""
Case 4
Me.WindowName = Me.WindowName
Me.WindowNamePreview = Me.WindowNamePreview
Me.WindowNameDC = Me.Filename + ""
Case Else
'MsgBox("Hallo")
End Select
End Sub
Public Function getWindowName() As String
Return Me.WindowName
End Function
Public Sub TimerFired(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles MyTimer.Elapsed
MyTimer.Stop()
'Dim sW As New StreamWriter("D:\TRACE.LOG", True)
'sW.WriteLine(Now)
Dim DocFound As Boolean = False
Dim i As Integer
Dim zz As Integer = 0
'While zz < 3 And DocFound = False
Me.WindowArray.Clear()
Search_List()
For i = 0 To Me.WindowArray.Count - 1
'sW.WriteLine(Me.WindowName + ":" + Me.WindowArray.Item(i))
'If Me.WindowArray.Item(i) = Me.WindowName Then MsgBox("Ist aktiv")
If Me.WindowArray.Item(i) = Me.WindowName Then DocFound = True
If Me.WindowArray.Item(i) = Me.WindowNamePreview Then DocFound = True
If Me.WindowArray.Item(i) = Me.WindowNameDC Then DocFound = True
If Me.WindowArray.Item(i) = Me.WindowNameKompatibilitaet Then DocFound = True
Next
'zz = zz + 1
' Thread.Sleep(300)
' 'End While
' Thread.Sleep(300)
If Not DocFound Then
Dim fn As String = Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente") + "~$" + Microsoft.VisualBasic.Right(Me.Filename, Len(Me.Filename) - 2)
Dim fc As New FileInfo(fn)
If fc.Exists Then DocFound = True
If Not DocFound Then
' sW.WriteLine("Stop:" + Me.WindowName)
MyTimer.Stop()
RaiseEvent DocumentClosed()
Else
MyTimer.Start()
End If
Else
MyTimer.Start()
End If
DocFound = Nothing
' sW.WriteLine(Now)
' sW.Flush()
' sW.Close()
End Sub
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

View File

@@ -0,0 +1,153 @@
Option Strict On
Imports System.Runtime.InteropServices
Imports System.Text
' Class to wrap up Windows 32 API constants and functions.
Public Class Win32API
<StructLayout(LayoutKind.Sequential)> _
Public Structure OSVersionInfo
Public OSVersionInfoSize As Integer
Public majorVersion As Integer
Public minorVersion As Integer
Public buildNumber As Integer
Public platformId As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=128)> _
Public versionString As String
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure SECURITY_ATTRIBUTES
Public nLength As Integer
Public lpSecurityDescriptor As Integer
Public bInheritHandle As Integer
End Structure
Public Const GWL_EXSTYLE As Integer = (-20)
Public Const SW_Maximize As Integer = 3
Public Const SW_Minimze As Integer = 2
Public Const GW_OWNER As Integer = 4
Public Const SW_RESTORE As Integer = 9
Public Const SW_SHOW As Integer = 5
Public Const WS_EX_TOOLWINDOW As Integer = &H80
Public Const WS_EX_APPWINDOW As Integer = &H40000
Private Shared Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, _
ByRef lpdwProcessId As Integer) As Integer
End Function
Public Declare Function CreateDirectory Lib "kernel32" _
Alias "CreateDirectoryA" (ByVal lpPathName As String, _
ByVal lpSecurityAttributes _
As SECURITY_ATTRIBUTES) As Boolean
Public Delegate Function EnumWindowsCallback(ByVal hWnd As Integer, _
ByVal lParam As Integer) As Boolean
Public Declare Function EnumWindows Lib "user32.dll" _
Alias "EnumWindows" (ByVal callback As EnumWindowsCallback, _
ByVal lParam As Integer) As Integer
<DllImport("user32.dll", EntryPoint:="EnumWindows", SetLastError:=True, _
CharSet:=CharSet.Ansi, ExactSpelling:=True, _
CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function EnumWindowsDllImport(ByVal callback As EnumWindowsCallback, _
ByVal lParam As Integer) As Integer
End Function
Public Declare Auto Function FindWindow Lib "user32.dll" _
Alias "FindWindow" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Integer
Public Declare Auto Function FindWindowAny Lib "user32.dll" _
Alias "FindWindow" (ByVal lpClassName As Integer, _
ByVal lpWindowName As Integer) As Integer
Public Declare Auto Function FindWindowNullClassName Lib "user32.dll" _
Alias "FindWindow" (ByVal lpClassName As Integer, _
ByVal lpWindowName As String) As Integer
Public Declare Auto Function FindWindowNullWindowCaption Lib "user32.dll" _
Alias "FindWindow" (ByVal lpClassName As String, _
ByVal lpWindowName As Integer) As Integer
Public Declare Function GetActiveWindow Lib "user32.dll" () As IntPtr
Public Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" (ByVal hwnd As Integer, _
ByVal lpClassName As String, _
ByVal cch As Integer) As Integer
Public Declare Function GetDiskFreeSpace Lib "kernel32" _
Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
ByRef lpSectorsPerCluster As Integer, _
ByRef lpBytesPerSector As Integer, _
ByRef lpNumberOfFreeClusters As Integer, _
ByRef lpTotalNumberOfClusters As Integer) As Integer
Public Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, _
ByRef lpFreeBytesAvailableToCaller As Integer, _
ByRef lpTotalNumberOfBytes As Integer, _
ByRef lpTotalNumberOfFreeBytes As UInt32) As Integer
Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Integer
Public Declare Function GetParent Lib "user32.dll" _
Alias "GetParent" (ByVal hwnd As Integer) As Integer
Declare Ansi Function GetVersionEx Lib "kernel32.dll" _
Alias "GetVersionExA" (ByRef osvi As OSVersionInfo) As Boolean
Public Declare Function GetWindow Lib "user32.dll" _
Alias "GetWindow" (ByVal hwnd As Integer, _
ByVal wCmd As Integer) As Integer
Public Declare Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" (ByVal hwnd As Integer, _
ByVal nIndex As Integer) As Integer
Public Declare Sub GetWindowText Lib "user32.dll" _
Alias "GetWindowTextA" (ByVal hWnd As Integer, _
ByVal lpString As StringBuilder, _
ByVal nMaxCount As Integer)
Public Declare Function IsIconic Lib "user32.dll" _
Alias "IsIconic" (ByVal hwnd As Integer) As Boolean
Public Declare Function IsPwrHibernateAllowed Lib "Powrprof.dll" _
Alias "IsPwrHibernateAllowed" () As Integer
Public Declare Function IsWindowVisible Lib "user32.dll" _
Alias "IsWindowVisible" (ByVal hwnd As Integer) As Boolean
Public Declare Function SetForegroundWindow Lib "user32.dll" _
Alias "SetForegroundWindow" (ByVal hwnd As Integer) As Integer
Public Declare Function SetActiveWindow Lib "user32.dll" _
Alias "SetActiveWindow" (ByVal hwnd As Integer) As Integer
Public Declare Function SetSuspendState Lib "Powrprof.dll" _
Alias "SetSuspendState" (ByVal Hibernate As Integer, _
ByVal ForceCritical As Integer, _
ByVal DisableWakeEvent As Integer) As Integer
Public Declare Function ShowWindow Lib "user32.dll" _
Alias "ShowWindow" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
Declare Function SwapMouseButton Lib "user32.dll" _
Alias "SwapMouseButton" (ByVal bSwap As Integer) As Integer
Public Declare Function BringWindowToTop Lib "user32" Alias "BringWindowToTop" (ByVal hwnd As Long) As Long
'Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Public Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
'Public Const SB_VERT As Long = 1
'Public Const SB_HORZ As Long = 0
End Class

View File

@@ -0,0 +1,667 @@
Imports System.IO
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.Threading
Imports Word
Imports MW6.SDK.DataMatrix
Public Class WordLib
#Region "Deklarationen"
'FileObjekte
Dim objWatcher As New System.IO.FileSystemWatcher()
Dim objResult As System.IO.WaitForChangedResult
Public Event Dokument_now_Saved()
Public Event Dokument_Not_Saved()
'Applicationwatcher
Private WithEvents WordWatch As New ApplicationFileWatcher()
'Dokumentdaten
Dim dokudata As New edokadb.clsMyDokumentDaten()
Dim Dokumentdaten As DataTable
Dim DokumenTtyp As New edokadb.clsDokumenttyp()
Dim Office_Vorlage As New edokadb.clsOffice_vorlage()
'Interne Variablen
Dim isactiv As Boolean
Dim Dokument_To_Create As String
Dim Dokument_To_Save As String
Dim Dokument_Temp As String
Dim Cursor_Positionieren As Boolean
Dim IsProtected As Boolean
Dim inEditMode As Boolean
Dim timerloop As Integer
Dim Word_Active As Boolean
Dim m_DokumentID As String
Dim m_dokumentidbr As String
Dim m_DokumentTypnr As Long
'Dim m_amsdokument As Bookmark
Dim m_DokumentFilename As String
Dim m_DokumentDatum As DateTime
Dim m_Dokumentname As String
Dim m_CreateDoc As Boolean
Dim m_document_saved As Boolean
Dim CheckDokumentname As String
Dim WordnewInstance As Boolean
Dim m_sKopyDokID As String = ""
Dim OhneIDV As Boolean = False
Public IsPDF As Boolean = False
Public IsPDFForm As Boolean = False
Dim Excel_Dokument As Boolean
'IDV-Definitionen, sofern IDV nicht vorhanden ist (Entwicklung)
'Dim dc As Object
'Dim m_objdc As Object
'Dim idvdll As Object
'Dim xx As Object
'Private dckein As Integer
'Private dcinvisible As Integer
'Private dcMTBS As Long
'Dim OhneIDV As Boolean = True
'Progressbar
'Datentabellen
Public Save_Dokument As New DataTable()
Public Save_Notizen As New DataTable()
Public Save_ColdIndex As DataTable
Public Save_Dokumentwerte As DataTable
Public Save_Dokumentzuordnungen As DataTable
Public Save_Dokumentinfomeldungen As DataTable
Public Save_DokumentFunktionen As DataTable
Public save_historystatus As Integer
Public save_dokumentersetzen As DataTable
Public save_dokumentcoldindex As DataTable
Public Save_Dokumentbr As New DataTable()
Public Save_Notizenbr As New DataTable()
Public Save_ColdIndexbr As DataTable
Public Save_Dokumentwertebr As DataTable
Public Save_Dokumentzuordnungenbr As DataTable
Public Save_Dokumentinfomeldungenbr As DataTable
Public Save_DokumentFunktionenbr As DataTable
Public save_historystatusbr As Integer
Public save_dokumentersetzenbr As DataTable
Public save_dokumentcoldindexbr As DataTable
Public Dokumentcoldindex_Changed As Boolean
Public Dokumentcoldindex_changedbr As Boolean
Public dokumentcoldindex_status As String
Public dokumentcoldindex_statusbr As String
Public dokumentid_changed As Boolean
Public dokumentid_changedbr As Boolean
Public dokumentidalt As String
Public dokumentidaltbr As String
Public Ersetzte_Dokumente_Reaktivieren As Boolean
Public Ersetzte_Dokumente_Reaktivierenbr As Boolean
Public txtBemerkung_Verantwortlicher As String
Public save_verantwortlicher As Integer
Public save_stv As Integer
Dim Save_DateTime As DateTime
Dim DocReadonly As Boolean
Dim m_txtpartner As String
Property txtPartner() As String
Get
Return m_txtpartner
End Get
Set(ByVal Value As String)
m_txtpartner = Value
End Set
End Property
Dim m_txtdokumenttyp As String
Property txtDokumenttyp() As String
Get
Return m_txtdokumenttyp
End Get
Set(ByVal Value As String)
m_txtdokumenttyp = Value
End Set
End Property
'Events
Public Event OfficeFinished()
Public send_statusmessage As Boolean
Dim Finished As Boolean = False
Dim M_Errormessage As String
Property Errormessage() As String
Get
Return M_Errormessage
End Get
Set(ByVal Value As String)
M_Errormessage = Value
End Set
End Property
'EDEX Banklagernd
Public bldokument As Boolean = False
Public bldelquittungkube As Boolean = False
Public BLQuittungstext As String = ""
Public BLUnterschrift1 As String = ""
Public BLUnterschrift2 As String = ""
Public BLDel2Page As Boolean = False
Public BLAdresse1 As String = ""
Public BLAdresse2 As String = ""
Public SaveBLDossier As Boolean = False
#End Region
#Region "Properties"
Property Dokumenttypnr() As Long
Get
Return m_DokumentTypnr
End Get
Set(ByVal Value As Long)
m_DokumentTypnr = Value
End Set
End Property
Property Dokument_Saved() As Boolean
Get
Return m_document_saved
End Get
Set(ByVal Value As Boolean)
m_document_saved = 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 Dokumentidbr() As String
Get
Return m_dokumentidbr
End Get
Set(ByVal Value As String)
m_dokumentidbr = Value
End Set
End Property
Property DokumentName() As String
Get
Return m_Dokumentname
End Get
Set(ByVal Value As String)
m_Dokumentname = Value
End Set
End Property
Property Dokumentfilename() As String
Get
Return m_DokumentFilename
End Get
Set(ByVal Value As String)
m_DokumentFilename = Value
End Set
End Property
Property DokumentDatum() As DateTime
Get
Return m_DokumentDatum
End Get
Set(ByVal Value As DateTime)
m_DokumentDatum = Value
End Set
End Property
Property CreateDoc() As Boolean
Get
Return m_CreateDoc
End Get
Set(ByVal Value As Boolean)
m_CreateDoc = Value
End Set
End Property
#End Region
#Region "Excel-Funktionen"
Private Function StartExcel(Optional ByVal CurrentInstanz As Boolean = False)
Try
'objExcel = CreateObject("Excel.Application")
Catch ex As Exception
Finally
'objExcel.Visible = False
End Try
End Function
#End Region
#Region "Öffentliche Methoden"
#Region "Excel"
Public Sub Open_Excel(ByVal fname As String, ByVal dokumentid As String)
' StartExcel()
Dim dm As New DocMgmt
If dm.Get_From_DB(dokumentid, fname) = False Then
MsgBox("Dokument kann nicht geladen werden.", vbExclamation)
dm = Nothing
Exit Sub
End If
Me.inEditMode = True
Me.Excel_Dokument = True
Dokumentfilename = fname
Threading.Thread.CurrentThread.Sleep(400)
' objExcel.Workbooks.Open(fname)
Threading.Thread.CurrentThread.Sleep(400)
' docExcel = objExcel.ActiveWorkbook
' objExcel.Visible = True
Me.Dokumentfilename = fname
Me.DokumentName = fname
Process.Start(Me.Dokumentfilename)
Control_Word()
End Sub
#End Region
#End Region
#Region "ControlWord"
Private Sub Control_Word()
Me.Dokument_Saved = False
WATCHFILE()
End Sub
Dim savecount As Integer = 0
Private Function WATCHFILE()
Try
Me.Errormessage = "131"
'Wordwatch - Überprüfung auf geöffnete
If Not Me.DocReadonly Then Save_DateTime = File.GetLastWriteTime(Me.Dokumentfilename)
Me.DokumentName = DivFnkt.ExtractFilename(Me.DokumentName)
WordWatch.Filename = Me.DokumentName
'If Me.Excel_Dokument Then
' WordWatch.ApplicationType = 2
' objExcel.ActiveWindow.WindowState = Microsoft.Office.Interop.Excel.XlWindowState.xlMaximized
' objExcel.Visible = True
' Disable_Enable_MenuFunctions_Excel(False)
'End If
Me.Errormessage = "132"
Word_Active = True
Try
'Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_SHOW)
Catch
End Try
WordWatch.ApplicationType = 2
WordWatch.Start()
Dim hnd As Integer
Me.Errormessage = "133"
Try
hnd = Win32API.FindWindow(vbNullString, WordWatch.WindowName)
Catch
End Try
Catch
End Try
End Function
Private Sub Finishing() Handles WordWatch.DocumentClosed
Me.Errormessage = "134"
objWatcher.EnableRaisingEvents = False
Finished = True
Thread.Sleep(100)
If Me.bldokument = False Then
If WordWatch.doc_is_active Then Exit Sub
End If
WordWatch.Stopp()
'Weil 2x Funktion aufgeruft wird! Keine Ahnung wiso... naja who cares ;-)
If File.Exists(Me.Dokumentfilename) = False Then Exit Sub
Thread.CurrentThread.Sleep(400)
Dim i As Integer
If Me.DocReadonly Then
Delete_File()
Exit Sub
End If
Me.Errormessage = "135"
Dim xtime As DateTime
xtime = File.GetLastWriteTime(Me.Dokumentfilename)
'Gibt Fehler bei Automatischer Erstellung, wird eh nicht gebraucht
'kann nur save_Data() aufgerufen werden!!
'--------------------------------------------------------------------
Dim diff As Integer
Dim cxtime As String = xtime.ToString
Dim csavetime As String = Save_DateTime.ToString
diff = DateDiff(DateInterval.Second, Save_DateTime, xtime)
If diff > 2 Or Me.bldokument = True Then
Save_Data()
Else
Restore_Data()
End If
'Try
' Try
' objExcel.Visible = True
' objExcel.Workbooks.Close()
' objExcel.Application.Quit()
' Catch ex As Exception
' 'MsgBox(ex.Message)
' End Try
' docExcel = Nothing
' objExcel = Nothing
'Catch
'End Try
Me.Errormessage = "138"
Try
Words.Remove(Me.DokumentName)
'If Me.Excel_Dokument = True Then
' If Globals.Words.Count = 0 Then
' Me.StartExcel(True)
' objExcel.Visible = False
' Disable_Enable_MenuFunctions_Excel(True)
' objExcel.Quit()
' objExcel = Nothing
' End If
'End If
Catch
Finally
Try
'Dim p As Process
'Dim MyProcesses() As Process = _
'Process.GetProcessesByName( _
'Process.GetCurrentProcess().ProcessName)
'For Each p In MyProcesses
' If (p.Id = Process.GetCurrentProcess().Id) Then
' Globals.Apphandle = p.MainWindowHandle()
' End If
'Next
'Win32API.SetActiveWindow(Globals.Apphandle)
'Win32API.BringWindowToTop(Globals.Apphandle)
''Win32API.ShowWindow(Globals.Apphandle, Win32API.SW_Maximize)
If docsaved = True Then
RaiseEvent Dokument_now_Saved()
Else
RaiseEvent Dokument_Not_Saved()
End If
Catch
End Try
End Try
Me.Errormessage = "139"
End Sub
Public Function FileWatcher()
Me.Errormessage = "140"
Save_DateTime = File.GetLastWriteTime(Me.Dokumentfilename)
End Function
Private Sub filechange(ByVal source As Object, ByVal e As System.IO.FileSystemEventArgs)
Me.Errormessage = "141"
If e.ChangeType = IO.WatcherChangeTypes.Changed Then
MsgBox(e.FullPath & " " & e.Name)
Me.Dokument_Saved = True
End If
End Sub
#End Region
#Region "Save / Restore"
Dim docsaved As Boolean = False
Public Function Save_Data()
Me.Errormessage = "142"
docsaved = True
WordWatch.Stopp()
Thread.CurrentThread.Sleep(500)
Save_Doc()
Thread.CurrentThread.Sleep(500)
Update_Dokumentdetails()
'Dim statush As New Statushandling()
Me.Errormessage = "143"
End Function
Public Function Restore_Data()
docsaved = False
Me.Errormessage = "146"
WordWatch.Stopp()
Restore(2)
Me.Errormessage = "147"
End Function
Public Function Restore(ByVal typ As Integer)
'Restore_Datasets()
Delete_File()
End Function
Public Function Save_Doc()
Me.Errormessage = "149"
Dim docsave As New DocMgmt()
docsave.Save_To_DB(Me.DokumentID, Me.Dokumentfilename)
docsave = Nothing
Dim doarchivfnkt As Boolean
If Me.Dokumentidbr <> "" And Me.CreateDoc Then doarchivfnkt = True
If Me.Save_Dokumentbr.Rows.Count > 0 Then
doarchivfnkt = True
End If
Delete_File()
Me.Errormessage = "150"
End Function
Public Function Save_Doc_Temp(ByVal Dokumentfile As String)
Me.Errormessage = "151"
Dim docsave As New DocMgmt()
docsave.Save_To_DB(Me.DokumentID, Dokumentfile)
docsave = Nothing
File.Delete(Dokumentfile)
Me.Errormessage = "152"
End Function
Public Function Update_Dokumentdetails()
Me.Errormessage = "155"
Dim doc As New edokadb.clsDokument()
doc.cpMainConnectionProvider = conn
conn.OpenConnection()
doc.sDokumentid = New SqlString(CType(Me.DokumentID, String))
doc.SelectOne()
doc.daMutiertam = New SqlDateTime(CType(Microsoft.VisualBasic.Now, DateTime))
doc.Update()
doc.Dispose()
conn.CloseConnection(True)
Me.Errormessage = "156"
End Function
'Rel. 4.1
Public Function Delete_File()
Me.Errormessage = "157"
'Try
' Dim tmpfilename As String = "SIK_" + Format(Now, "yyyyMMddHHmmss") + "_" + IO.Path.GetFileName(Me.Dokumentfilename)
' Rename(Me.Dokumentfilename, tmpfilename)
' Globals.PerfMon.insert_entry(Me.DokumentID + " File Rename durchgeführt: " + tmpfilename)
'Catch ex As Exception
'End Try
Try
File.Delete(Me.Dokumentfilename)
Catch
End Try
' RaiseEvent OfficeFinished()
Me.Errormessage = "158"
End Function
Public Sub Restore_Datasets()
Me.Errormessage = "159"
Try
Restore_Dokumentwerte(Me.Save_Dokumentwerte, Me.DokumentID)
Restore_Statushistory(Me.save_historystatus, Me.DokumentID)
Catch ex As Exception
End Try
End Sub
Private Sub Restore_Dokumentwerte(ByVal SAVE_DOKUMENTWERTE As DataTable, ByVal dokumentid As String)
Me.Errormessage = "167"
Dim i As Integer
Dim nnr As Long
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_Dokumentwerte"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
If Me.CreateDoc = True Then
'Coldindexwerte bei neuem Dokument löschen
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentinfonr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, ""))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Now))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 0))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 2))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
Exit Sub
End If
Me.Errormessage = "168"
'Restore der alten Indexwerte
For i = 0 To SAVE_DOKUMENTWERTE.Rows.Count - 1
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("dokumentid")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentinfonr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("dokumentinfonr")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@value", SqlDbType.VarChar, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("inhalt")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutiertam", SqlDbType.DateTime, 8, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("mutiert_am")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@mutierer", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("mutierer")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@aktiv", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, SAVE_DOKUMENTWERTE.Rows(i).Item("aktiv")))
scmCmdToExecute.Parameters.Add(New SqlParameter("@fnkt", SqlDbType.Int, 1024, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, 1))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
End Try
Next
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
Me.Errormessage = "169"
End Sub
Private Sub Restore_Statushistory(ByVal save_historystatus As Integer, ByVal dokumentid As String)
Me.Errormessage = "179"
Dim scmCmdToExecute As SqlCommand = New SqlCommand()
scmCmdToExecute.CommandText = "dbo.SP_Restore_statushistory"
scmCmdToExecute.CommandType = CommandType.StoredProcedure
scmCmdToExecute.Connection = conn.scoDBConnection
scmCmdToExecute.Connection.Open()
Try
scmCmdToExecute.Parameters.Clear()
scmCmdToExecute.Parameters.Add(New SqlParameter("@statushistorynr", SqlDbType.Int, 4, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, save_historystatus))
scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 22, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, dokumentid))
scmCmdToExecute.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message)
Throw New Exception("Restore Coldindex - Delete::" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex)
Finally
scmCmdToExecute.Connection.Close()
scmCmdToExecute.Dispose()
End Try
Me.Errormessage = "180"
End Sub
#End Region
#Region "Enabel / Disable"
Public Sub Office_Freigeben()
Me.Errormessage = "187"
Try
'StartExcel()
'Disable_Enable_MenuFunctions_Excel(True)
'objExcel = Nothing
Catch
End Try
Me.Errormessage = "188"
End Sub
#End Region
End Class