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 Private WithEvents objExcel As Microsoft.Office.Interop.Excel.Application Private WithEvents docExcel As Microsoft.Office.Interop.Excel.Workbook '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.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 MsgBox("Das Dokument wurde erfolgreich gespeichert.", vbInformation) Else MsgBox("Das Dokument wurde nicht gespeichert.", vbExclamation) 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 Private Sub Handle_Excel_2010(ByVal enable As Boolean) Exit Sub If enable = True Then Try objExcel.AddIns("Edoka_2").Installed = False Catch ex As Exception End Try Try objExcel.AddIns("Edoka_1").Installed = False Catch ex As Exception End Try Try objExcel.AddIns("Edoka_3").Installed = False Catch ex As Exception End Try Exit Sub End If Try If Me.DokumenTtyp.bEmail_versand.Value = True Then Dim addinfile As String = DivFnkt.XML_Param("Excel_2") If addinfile <> "" Then objExcel.AddIns.Add(addinfile, False) objExcel.AddIns("Edoka_2").Installed = False objExcel.AddIns("Edoka_2").Installed = True End If Else Dim addinfile As String = DivFnkt.XML_Param("Excel_1") If addinfile <> "" Then objExcel.AddIns.Add(addinfile, False) objExcel.AddIns("Edoka_1").Installed = False objExcel.AddIns("Edoka_1").Installed = True End If End If Catch ex As Exception End Try End Sub Public Sub Disable_Enable_MenuFunctions_Excel(ByVal Enable As Boolean) Exit Sub Me.Errormessage = "193" On Error Resume Next Handle_Excel_2010(Enable) Exit Sub Dim cmdctrl As Object Dim i As Integer For i = 1 To objExcel.CommandBars.Count objExcel.CommandBars(i).Reset() Next For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=18) cmdctrl.enabled = Enable Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=23) cmdctrl.enabled = Enable Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=748) cmdctrl.enabled = Enable Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=3823) cmdctrl.enabled = Enable Next cmdctrl 'senden an zulassen If Me.DokumenTtyp.bEmail_versand.Value = True Then For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30095) cmdctrl.enabled = True Next cmdctrl Else For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30095) cmdctrl.enabled = Enable Next cmdctrl End If ' For Each cmdctrl In objexcel.CommandBars.FindControls(ID:=30095) ' cmdctrl.enabled = Enable ' Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=797) cmdctrl.enabled = Enable Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=777) cmdctrl.enabled = Enable Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30017) cmdctrl.enabled = Enable Next cmdctrl For Each cmdctrl In objExcel.CommandBars.FindControls(Id:=30045) cmdctrl.enabled = Enable Next cmdctrl 'objExcel.NormalTemplate.Saved = True Me.Errormessage = "194" End Sub Public Function ResetFunctions_Excel() Me.Errormessage = "195" Exit Function StartExcel() Disable_Enable_MenuFunctions_Excel(True) objExcel.Visible = True Me.Errormessage = "196" End Function #End Region End Class