Public Function CompareDocuments(MainDoc As String, OldDoc As String, lAktID As Long, lMainDocVersion As Long, lOldDocVersion As Long) As Boolean 'mm 17.06.2009 - 1512795 Start
'uses the comparison-function of Word to display the difference
'between two documents
'XtremeDebug "In " & App.EXEName & " CompareDocuments in Prog " 'MLHIDE
On Error Resume Next
'mm 18.06.2009 - 1512795 Start
Dim fDocPWForm As frmDocPW
Dim i As Integer
Dim sActiveDoc As String
Dim t As C4DocH.clsDocHnd
Dim sWorkFile As String
Dim tmpPath As String
Dim cfc As ConsFunction
Dim sOldFile
'mm 18.06.2009 - 1512795 Ende
Dim lFormSchutz As Long 'mm 19.08.2009 - 1530842
lFormSchutz = 0 'mm 19.08.2009 - 1530842
If Len(MainDoc) > False And Len(OldDoc) > False Then
If FilesExtension(MainDoc) <> FilesExtension(OldDoc) Then
MsgBox ml_string(4004, "Es können nur Dokumente gleichen Typs verglichen werden."), vbOKOnly + vbInformation, ml_string(979, "Hinweis")
CompareDocuments = True
Else
Select Case LCase$(FilesExtension(MainDoc))
Case "docx", "doc", "htm", "rtf", "txt", "html" 'MLHIDE
If FilesExists(MainDoc) And FilesExists(OldDoc) Then
CompareDocuments = True 'Voraussetzungen gegeben
'hj 30.01.2009 - 1489457 - wdx auf wd geändert
'Dim wdx As Object
'mu 12.12.2008 - 1478407
'Call GetWordObject 'hj 24.11.2003 damit ConsSettings.WordVersion gefüllt wird
Call GetWordObject(, , , False) 'hj 24.11.2003 damit ConsSettings.WordVersion gefüllt wird
'Set wdx = CreateObject("Word.Application") 'hj 30.01.2009 - 1489457 'MLHIDE
If Err = False Then
'hj 30.01.2009 - 1489457
'mm 17.06.2009 - 1512795 Start
Set t = New C4DocH.clsDocHnd
Set t.Rep = GRep
Set cfc = New ConsFunction
tmpPath = cfc.GetTempPath & "Cns\CnsWork\readonly"
For i = 1 To 2
If i = 2 Then
sActiveDoc = MainDoc
sWorkFile = getDocNameWithoutPath(sActiveDoc)
sWorkFile = tmpPath & "\" & sWorkFile & "_tmp"
Call t.checkOut(True, lAktID, 0, lMainDocVersion, MainDoc, False)
Call FileCopy(MainDoc, sWorkFile)
FilesMakeWritable sWorkFile
Else
sActiveDoc = OldDoc
sWorkFile = getDocNameWithoutPath(sActiveDoc)
sWorkFile = tmpPath & "\" & sWorkFile & "_tmp"
Call t.checkOut(True, lAktID, 0, lOldDocVersion, OldDoc, False)
Call FileCopy(OldDoc, sWorkFile)
FilesMakeWritable sWorkFile
sOldFile = sWorkFile
End If
Call wd.Documents.Open(sWorkFile, False, True, False)
'mm 19.08.2009 - 1530842 Start
If wd.ActiveDocument.protectiontype = 2 Then
lFormSchutz = lFormSchutz + 1
End If
'mm 19.08.2009 - 1530842 Ende
If wd.ActiveDocument.protectiontype <> -1 Then 'mm -1 = wdNoProtection
If Len(wd.ActiveDocument.unprotect) > 0 Then 'mm: Falls Fehler auftritt, wird dieser direkt zurückgegeben
WriteDBGView "Fehler beim Entsichern des des Dokumentes. Fehler: " & Err.Description, App.EXEName
enter_password:
Set fDocPWForm = New frmDocPW
Load fDocPWForm
fDocPWForm.dokumentName = getDocNameWithoutPath(sActiveDoc)
fDocPWForm.Show vbModal
If fDocPWForm.Cancel = False Then
If Len(wd.ActiveDocument.unprotect(Password:=fDocPWForm.passwort)) > 0 Then
MsgBox ml_string(5115, "Das Dokument konnte mit diesem Passwort nicht entsichert werden."), vbExclamation, ml_string(979, "Hinweis")
GoTo enter_password
Else
Call wd.ActiveDocument.SaveAs(sWorkFile & "_tmp")
Call wd.ActiveDocument.Close
Call DeleteFile(sWorkFile)
Call FileCopy(sWorkFile & "_tmp", sWorkFile)
Call DeleteFile(sWorkFile & "_tmp")
End If
Else
Exit Function
End If
Else
'mm 19.08.2009 - 1530842 Start
Call wd.ActiveDocument.SaveAs(sWorkFile & "_tmp")
Call wd.ActiveDocument.Close
Call DeleteFile(sWorkFile)
Call FileCopy(sWorkFile & "_tmp", sWorkFile)
Call DeleteFile(sWorkFile & "_tmp")
'mm 19.08.2009 - 1530842 Ende
End If
End If
wd.Documents(sWorkFile).Close False
Next i
wd.Visible = False 'mm 19.08.2009 - 1530842
Call wd.Documents.Open(sWorkFile, False, True, False)
wd.ActiveDocument.compare sOldFile
' wd.activedocument.Compare (OldDoc)
'mm 17.06.2009 - 1512795 Ende
'mm 19.08.2009 - 1530842 Start
If lFormSchutz = 2 Then 'Formularschutz
wd.ActiveDocument.Protect Type:=2
wd.ActiveDocument.Close wd.WdSaveOptions.wdSaveChanges
End If
'mm 19.08.2009 - 1530842 Ende
If CByte(Replace(ConsSettings.WordVers, ".", ",")) > 9 Then 'MLHIDE
'mm 17.06.2009 - 1512795 Start
wd.Documents(sWorkFile).Close False
'wd.Documents(MainDoc).Close False 'cb 25.6.2003 - sonst ist unter XP 2mal Word offen !!
'mm 17.06.2009 - 1512795 Ende
End If
wd.Visible = True
Else
MsgBox Err.Number & " " & Err.Description, vbOKOnly + vbInformation, ml_string(971, "Fehler") 'MLHIDE
End If
'mu 12.12.2008 - 1478407
'Set wdx = Nothing
Else
MsgBox ml_string(3379, "Fehler beim Dateizugriff!"), vbOKOnly + vbInformation, ml_string(979, "Hinweis")
End If
Case Else
MsgBox ml_string(4005, "Für diesen Dokumententyp ist kein Versionsvergleich möglich."), vbOKOnly + vbInformation, ml_string(979, "Hinweis")
CompareDocuments = True
End Select
End If
End If
'XtremeDebug "OUT " & App.EXEName & " CompareDocuments in Prog " 'MLHIDE
End Function