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