[Winmerge-svn] SF.net SVN: winmerge: [5119] trunk
Windows visual diff and merge for files and directories
Brought to you by:
christianlist,
grimmdp
From: <ge...@us...> - 2008-03-03 23:45:13
|
Revision: 5119 http://winmerge.svn.sourceforge.net/winmerge/?rev=5119&view=rev Author: gerundt Date: 2008-03-03 15:45:09 -0800 (Mon, 03 Mar 2008) Log Message: ----------- PATCH: [ 1510298 ] MS Word - compare macros, bookmarks, document properties etc - Add the rest Modified Paths: -------------- trunk/Docs/Users/ChangeLog.txt trunk/Plugins/dlls/CompareMSWordFiles.dll trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls Modified: trunk/Docs/Users/ChangeLog.txt =================================================================== --- trunk/Docs/Users/ChangeLog.txt 2008-03-03 23:19:38 UTC (rev 5118) +++ trunk/Docs/Users/ChangeLog.txt 2008-03-03 23:45:09 UTC (rev 5119) @@ -5,6 +5,7 @@ WinMerge 2.8 Release Candidate Update developers list in splash screen (#1891548) Better error handling for Excel plugin (#1510293) + Add macros, bookmarks and document properties to Word plugin (#1510298) BugFix: Copy&Paste from VB6 added binary chars (#1904355) Translation updates: - Chinese Traditional (#1905323) Modified: trunk/Plugins/dlls/CompareMSWordFiles.dll =================================================================== (Binary files differ) Modified: trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls =================================================================== --- trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls 2008-03-03 23:19:38 UTC (rev 5118) +++ trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls 2008-03-03 23:45:09 UTC (rev 5119) @@ -41,6 +41,15 @@ Dim myLastErrorNumber As Long Dim myLastErrorString As String +Private Declare Function GetTempPath Lib "kernel32" _ + Alias "GetTempPathA" (ByVal nBufferLength As Long, _ + ByVal lpBuffer As String) As Long + +Private Declare Function GetTempFileName Lib "kernel32" _ + Alias "GetTempFileNameA" (ByVal lpszPath As String, _ + ByVal lpPrefixString As String, ByVal wUnique As Long, _ + ByVal lpTempFileName As String) As Long + Public Property Get PluginEvent() As String PluginEvent = "FILE_PACK_UNPACK" End Property @@ -92,6 +101,70 @@ GetMacrosHead = oTextToSave End Function +Private Function GetMacros(objDoc As Object) As String + Dim VBComp As Object + Dim iCountMacros As Integer + Dim oMacroLine As String + Dim oTextToSave As String + Dim macTempPaths() As String + Dim hFile As Long + + On Error GoTo GetMacros + + oTextToSave = "" + If Not objDoc.VBProject.VBComponents Is Nothing Then + If objDoc.VBProject.VBComponents.Count > 0 Then + ReDim macTempPaths(objDoc.VBProject.VBComponents.Count - 1) As String + oTextToSave = oTextToSave & "Macros in document" & vbCrLf + + iCountMacros = 0 + For Each VBComp In objDoc.VBProject.VBComponents + oTextToSave = oTextToSave & VBComp.Name & vbCrLf + + macTempPaths(iCountMacros) = CreateTempFile("WMS") + + ' Remove the temporary file + Kill macTempPaths(iCountMacros) + + ' Save the text content of the macro + VBComp.Export macTempPaths(iCountMacros) + + ' Read the content back from the file + hFile = FreeFile + Open macTempPaths(iCountMacros) For Input Shared As #hFile + Do While Not EOF(1) 'Loop until end of file... + Line Input #hFile, oMacroLine 'Read line into variable. + oTextToSave = oTextToSave & oMacroLine & vbCrLf + Loop + Close #hFile + + oTextToSave = oTextToSave & vbCrLf + iCountMacros = iCountMacros + 1 + Next + End If + End If + GetMacros = oTextToSave + Exit Function + +GetMacros: + oTextToSave = "" + GetMacros = oTextToSave +End Function + +Private Function GetDocProperty(objDoc As Object, pName As String) + On Error GoTo ErrHandler + + GetDocProperty = "" + If Not objDoc.BuiltinDocumentProperties.Item(pName) Is Nothing Then + GetDocProperty = objDoc.BuiltinDocumentProperties.Item(pName).Value + End If + + Exit Function + +ErrHandler: + GetDocProperty = "" +End Function + Public Function UnpackFile(fileSrc As String, fileDst As String, ByRef bChanged As Boolean, ByRef subcode As Long) As Boolean On Error GoTo CleanUp @@ -113,10 +186,51 @@ oTextToSave = oTextToSave & "Document Properties" & vbCrLf oTextToSave = oTextToSave & GetMacrosHead(objDoc) + On Error GoTo 0 + + Dim itemValue As String Dim hFile As Long + ' Get the document properties + On Error Resume Next + Dim p As Object + For Each p In objDoc.BuiltinDocumentProperties + oTextToSave = oTextToSave & p.Name + oTextToSave = oTextToSave & " = " + itemValue = GetDocProperty(objDoc, p.Name) + If itemValue <> "" Then + oTextToSave = oTextToSave & itemValue + End If + oTextToSave = oTextToSave & vbCrLf + Next + On Error GoTo CleanUp + oTextToSave = oTextToSave & vbCrLf + ' Get the Macros + oTextToSave = oTextToSave & GetMacros(objDoc) + + On Error GoTo CleanUp + + oTextToSave = oTextToSave & vbCrLf + + ' Bookmarks + On Error Resume Next + Dim nms As Object + Set nms = objDoc.Bookmarks + If nms.Count > 0 Then + oTextToSave = oTextToSave & "Bookmarks in document" & vbCrLf + End If + Dim iCountNames As Integer + For iCountNames = 1 To nms.Count + If nms(iCountNames).Name <> "" Then + oTextToSave = oTextToSave & nms(iCountNames).Name & vbCrLf + End If + iCountNames = iCountNames + 1 + Next + On Error GoTo 0 + oTextToSave = oTextToSave & vbCrLf + ' Save the text content of the document oTextToSave = oTextToSave & objDoc.Content.Text & vbCrLf @@ -150,3 +264,18 @@ subcode = 1 End Function +' Returns complete path and name for a temporary file +Private Function CreateTempFile(sPrefix As String) As String + Dim sTmpPath As String * 512 + Dim sTmpName As String * 576 + Dim nRet As Long + + nRet = GetTempPath(512, sTmpPath) + If (nRet > 0 And nRet < 512) Then + nRet = GetTempFileName(sTmpPath, sPrefix, 0, sTmpName) + If nRet <> 0 Then + CreateTempFile = Left$(sTmpName, InStr(sTmpName, vbNullChar) - 1) + End If + End If +End Function + This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |