Plugins/dlls/CompareMSPowerPointFiles.sct

   1 <scriptlet>
   2 <implements type="Automation" id="dispatcher">
   3         <property name="PluginEvent">
   4                 <get/>
   5         </property>
   6         <property name="PluginDescription">
   7                 <get/>
   8         </property>
   9         <property name="PluginFileFilters">
  10                 <get/>
  11         </property>
  12         <property name="PluginIsAutomatic">
  13                 <get/>
  14         </property>
  15         <property name="PluginExtendedProperties">
  16                 <get/>
  17         </property>
  18         <method name="UnpackFile"/>
  19         <method name="PackFile"/>
  20         <method name="IsFolder"/>
  21         <method name="UnpackFolder"/>
  22         <method name="PackFolder"/>
  23         <method name="ShowSettingsDialog"/>
  24 </implements>
  25
  26 <script language="VBS">
  27
  28 '/////////////////////////////////////////////////////////////////////////////
  29 '    This is a plugin for WinMerge.
  30 '    It will display the text content of MS PowerPoint files.
  31 '    Copyright (C) 2016 Takashi Sawanaka
  32 '
  33 '    This program is free software; you can redistribute it and/or modify
  34 '    it under the terms of the GNU General Public License as published by
  35 '    the Free Software Foundation; either version 2 of the License, or
  36 '    (at your option) any later version.
  37 '
  38 '    This program is distributed in the hope that it will be useful,
  39 '    but WITHOUT ANY WARRANTY; without even the implied warranty of
  40 '    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  41 '    GNU General Public License for more details.
  42 '
  43 '    You should have received a copy of the GNU General Public License
  44 '    along with this program; if not, write to the Free Software
  45 '    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  46 '
  47
  48 Option Explicit
  49
  50 Const RegKeyPath = "HKCU\Software\Thingamahoochie\WinMerge\Plugins\CompareMSPowerPointFiles.sct\"
  51 Dim MsgCannotGetMacros
  52 MsgCannotGetMacros = "Cannot get Macros." & vbCrLf & _
  53         "   To allow WinMerge to compare macros, use MS Office to alter the settings in the Macro Security for the current application." & vbCrLf & _
  54         "   The Trust access to Visual Basic Project feature should be turned on to use this feature in WinMerge." & vbCrLf
  55
  56 Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
  57 Dim wsh: Set wsh = CreateObject("WScript.Shell")
  58
  59 Function isAccessibleVBAProject(prs)
  60         Dim count
  61         count = -1
  62         On Error Resume Next
  63         count = prs.VBProject.VBComponents.Count
  64         isAccessibleVBAProject = (count > 0)
  65 End Function
  66
  67 Function regRead(Key, DefaultValue)
  68         regRead = DefaultValue
  69         On Error Resume Next
  70         regRead = wsh.RegRead(Key)
  71 End Function
  72
  73 Function writeObjectProperties(fo, items)
  74         On Error Resume Next
  75         Dim o
  76         For Each o In items
  77                 fo.WriteLine o.Name & ": " & o.Value
  78         Next
  79 End Function
  80
  81 Function writeShape(fo, shp)
  82         Dim shp2, shpType, r, c
  83         On Error Resume Next
  84         shpType = -1
  85         shpType = shp.Type
  86         fo.Write shp.Name & ": "
  87         If shp.HasTable Then
  88                 For r = 1 To shp.Table.Rows.Count
  89                         For c = 1 To shp.Table.Columns.Count
  90                                 fo.Write "(" & r & ", " & c & "): "
  91                                 writeShape fo, shp.Table.Cell(r, c).Shape
  92                         Next
  93                 Next
  94         ElseIf shpType = 6 Then 'msoGroup = 6
  95                 For Each shp2 In shp.GroupItems
  96                     writeShape fo, shp2
  97                 Next
  98         ElseIf shp.HasTextFrame Then
  99                 fo.WriteLine shp.TextFrame.TextRange.Characters.Text
 100         Else
 101                 fo.WriteLine ""
 102         End If
 103 End Function
 104
 105 Function writeTextsInShapes(fo, shps)
 106         Dim shp
 107         On Error Resume Next
 108         For Each shp In shps
 109                 writeShape fo, shp
 110         Next
 111         On Error GoTo 0
 112 End Function
 113
 114 Function getModuleExtension(cmp)
 115         Select Case cmp.Type
 116         Case 2
 117                 getModuleExtension = ".cls"
 118         Case 3
 119                 getModuleExtension = ".frm"
 120         Case Else
 121                 getModuleExtension = ".bas"
 122         End Select
 123 End Function
 124
 125 Function saveSlideAsImage(sld, filename)
 126         sld.Export filename, "PNG"
 127 End Function
 128
 129 Function get_PluginEvent()
 130         get_PluginEvent = "FILE_FOLDER_PACK_UNPACK"
 131 End Function
 132
 133 Function get_PluginDescription()
 134         get_PluginDescription = "Display the text content of MS PowerPoint files"
 135 End Function
 136
 137 Function get_PluginFileFilters()
 138         get_PluginFileFilters = "\.ppt(\..*)?$;\.pptx(\..*)?$;\.pptm(\..*)?$;\.ppa(\..*)?$;\.ppam(\..*)?$;\.potx(\..*)?$;\.potm(\..*)?$"
 139 End Function
 140
 141 Function get_PluginIsAutomatic()
 142         get_PluginIsAutomatic = True
 143 End Function
 144
 145 Function get_PluginExtendedProperties()
 146         get_PluginExtendedProperties = "ProcessType=Content Extraction;FileType=MS-PowerPoint;MenuCaption=MS-PowerPoint"
 147 End Function
 148
 149 Function UnpackFile(fileSrc, fileDst, pbChanged, pSubcode)
 150         Dim fo
 151         Dim pp
 152         Dim prs
 153         Dim sld
 154         Dim cmp
 155
 156         Set fo = fso.CreateTextFile(fileDst, True, True)
 157
 158         Set pp = CreateObject("PowerPoint.Application")
 159         pp.Visible = True
 160         pp.DisplayAlerts = False
 161
 162         Set prs = pp.Presentations.Open(fileSrc)
 163
 164         On Error Resume Next
 165
 166         If regRead(RegKeyPath & "CompareDocumentProperties", False) Then
 167                 fo.WriteLine "[Document Properties]"
 168                 writeObjectProperties fo, prs.BuiltinDocumentProperties
 169                 fo.WriteLine ""
 170         End If
 171
 172         For Each sld In prs.Slides
 173                 If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
 174                         fo.WriteLine "[" & sld.Name & "]"
 175                         writeTextsInShapes fo, sld.Shapes
 176                         fo.WriteLine ""
 177                 End If
 178                 If regRead(RegKeyPath & "CompareTextsInNotesPage", True) Then
 179                         fo.WriteLine "[" & sld.Name & ".NotesPage]"
 180                         writeTextsInShapes fo, sld.NotesPage.Shapes
 181                         fo.WriteLine ""
 182                 End If
 183         Next
 184
 185         If regRead(RegKeyPath & "CompareVBAMacros", True) Then
 186                 If Not isAccessibleVBAProject(prs) Then
 187                         fo.WriteLine MsgCannotGetMacros
 188                 End If
 189                 For Each cmp In prs.VBProject.VBComponents
 190                         fo.WriteLine "[CodeModule." & cmp.Name & "]"
 191                         If cmp.CodeModule.CountOfLines > 0 Then
 192                                 fo.WriteLine cmp.CodeModule.Lines(1, cmp.CodeModule.CountOfLines)
 193                         End If
 194                         fo.WriteLine ""
 195                 Next
 196         End If
 197
 198         Set sld = Nothing
 199         prs.Close
 200         Set prs = Nothing
 201         pp.Quit
 202         Set pp = Nothing
 203         fo.Close
 204         Set fo = Nothing
 205
 206         pbChanged = True
 207         pSubcode = 0
 208         UnpackFile = True
 209
 210 End Function
 211
 212 Function PackFile(fileSrc, fileDst, pbChanged, pSubcode)
 213         PackFile = False
 214 End Function
 215
 216 Function IsFolder(file)
 217         IsFolder = regRead(RegKeyPath & "UnpackToFolder", False)
 218 End Function
 219
 220 Function UnpackFolder(fileSrc, folderDst, pbChanged, pSubcode)
 221         Dim fo
 222         Dim pp
 223         Dim prs
 224         Dim sld
 225         Dim cmp
 226
 227         If Not fso.FolderExists(folderDst) Then fso.CreateFolder folderDst
 228
 229         Set pp = CreateObject("PowerPoint.Application")
 230         pp.Visible = True
 231         pp.DisplayAlerts = False
 232
 233         Set prs = pp.Presentations.Open(fileSrc)
 234
 235         On Error Resume Next
 236
 237         If regRead(RegKeyPath & "CompareDocumentProperties", False) Then
 238                 Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "(0)DocumentProperties.txt"), True, True)
 239                 writeObjectProperties fo, prs.BuiltinDocumentProperties
 240                 fo.Close
 241         End If
 242
 243         For Each sld In prs.Slides
 244                 If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
 245                         Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, sld.Name & ".txt"), True, True)
 246                         writeTextsInShapes fo, sld.Shapes
 247                         fo.Close
 248                 End If
 249
 250                 If regRead(RegKeyPath & "CompareTextsInNotesPage", True) Then
 251                         Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, sld.Name & "_NotesPage.txt"), True, True)
 252                         writeTextsInShapes fo, sld.NotesPage.Shapes
 253                         fo.Close
 254                 End If
 255
 256                 If regRead(RegKeyPath & "CompareSlideAsImage", True) Then
 257                         saveSlideAsImage sld, fso.BuildPath(folderDst, sld.Name & ".png")
 258                 End If
 259         Next
 260         If regRead(RegKeyPath & "CompareVBAMacros", True) Then
 261                 If Not isAccessibleVBAProject(prs) Then
 262                         Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "CannotGetMacros.bas"), True, True)
 263                         fo.WriteLine MsgCannotGetMacros
 264                         fo.Close
 265                 End If
 266
 267                 For Each cmp In prs.VBProject.VBComponents
 268                         cmp.Export fso.BuildPath(folderDst, cmp.Name & getModuleExtension(cmp))
 269                 Next
 270         End If
 271
 272         Set sld = Nothing
 273         prs.Close
 274         Set prs = Nothing
 275         pp.Quit
 276         Set pp = Nothing
 277         Set fo = Nothing
 278
 279         pbChanged = True
 280         pSubcode = 0
 281         UnpackFolder = True
 282 End Function
 283
 284 Function PackFolder(fileSrc, folderDst, pbChanged, pSubcode)
 285         PackFolder = False
 286 End Function
 287
 288 Function ShowSettingsDialog()
 289         Dim tname: tname = fso.BuildPath(fso.GetSpecialFolder(2), fso.GetTempName() & ".hta")
 290         Dim tfile: Set tfile = fso.CreateTextFile(tname)
 291         Dim mshta
 292         tfile.Write getResource("dialog1")
 293         tfile.Close
 294         mshta = wsh.ExpandEnvironmentStrings("%SystemRoot%\mshta.exe")
 295         If Not fso.FileExists(mshta) Then
 296                 mshta = wsh.ExpandEnvironmentStrings("%SystemRoot%\SysWOW64\mshta.exe")
 297         End If
 298         Run wsh, """" & mshta & """ """ & tname & """"
 299         fso.DeleteFile tname
 300 End Function
 301
 302 Sub Run(sh, cmd)
 303         sh.Run cmd, 1, True
 304 End Sub
 305
 306 </script>
 307
 308 <resource id="dialog1">
 309 <![CDATA[
 310 <html>
 311   <head>
 312     <title>CompareMSPowerPointFiles.sct WinMerge Plugin Options</title>
 313     <meta content="text/html" charset="Shift_JIS">
 314     <style>
 315       body { background-color: lightgray; }
 316       ul { list-style:none; }
 317     </style>
 318     <script type="text/javascript">
 319       var REGKEY_PATH = "HKCU\\Software\\Thingamahoochie\\WinMerge\\Plugins\\CompareMSPowerPointFiles.sct\\";
 320
 321       function regRead(key, defaultValue) {
 322         try {
 323           return (new ActiveXObject("WScript.Shell")).RegRead(key);
 324         } catch (e) {
 325           return defaultValue;
 326         }
 327       }
 328
 329       function regWrite(key, value, type) {
 330         (new ActiveXObject("WScript.Shell")).RegWrite(key, value, type);
 331       }
 332
 333       function onload() {
 334
 335         var w = 600, h = 400;
 336         window.resizeTo(w, h);
 337         window.moveTo((screen.width - w) / 2, (screen.height - h) / 2);
 338
 339         cboLanguage.selectedIndex = navigator.browserLanguage.substr(0, 2) === 'ja' ? 1 : 0;
 340         setLanguage(navigator.browserLanguage);
 341         chkUnpackToFolder.checked = regRead(REGKEY_PATH + "UnpackToFolder", false);
 342         chkCompareDocumentProperties.checked = regRead(REGKEY_PATH + "CompareDocumentProperties", false);
 343         chkCompareSlideAsImage.checked = regRead(REGKEY_PATH + "CompareSlideAsImage", true);
 344         chkCompareTextsInShapes.checked = regRead(REGKEY_PATH + "CompareTextsInShapes", true);
 345         chkCompareTextsInNotesPage.checked = regRead(REGKEY_PATH + "CompareTextsInNotesPage", true);
 346         chkCompareVBAMacros.checked = regRead(REGKEY_PATH + "CompareVBAMacros", true);
 347         chkUnpackToFolder_onclick();
 348         chkCompareSlideAsImage_onclick();
 349       }
 350
 351       function setLanguage(lang) {
 352         var div = document.getElementById("language") || document.createElement('div')
 353         div.id = "language";
 354         var html = '&shy;<style>';
 355         if (lang.substr(0, 2).toLowerCase() === 'ja') {
 356           html += '.en { display: none } .ja { display: inline }';
 357         } else {
 358           html += '.ja { display: none } .en { display: inline }';
 359         }
 360         div.innerHTML = html;
 361         if (!document.getElementById("language"))
 362           document.body.appendChild(div);
 363       }
 364
 365       function cboLanguage_onclick() {
 366         setLanguage(cboLanguage.options[cboLanguage.selectedIndex].text);
 367       }
 368
 369       function chkUnpackToFolder_onclick() {
 370         if (!chkUnpackToFolder.checked)
 371           chkCompareSlideAsImage.checked = false;
 372       }
 373
 374       function chkCompareSlideAsImage_onclick() {
 375         if (chkCompareSlideAsImage.checked)
 376           chkUnpackToFolder.checked = true;
 377       }
 378
 379       function btnOk_onclick() {
 380         regWrite(REGKEY_PATH + "UnpackToFolder", chkUnpackToFolder.checked, "REG_DWORD");
 381         regWrite(REGKEY_PATH + "CompareDocumentProperties", chkCompareDocumentProperties.checked, "REG_DWORD");
 382         regWrite(REGKEY_PATH + "CompareSlideAsImage", chkCompareSlideAsImage.checked, "REG_DWORD");
 383         regWrite(REGKEY_PATH + "CompareTextsInShapes", chkCompareTextsInShapes.checked, "REG_DWORD");
 384         regWrite(REGKEY_PATH + "CompareTextsInNotesPage", chkCompareTextsInNotesPage.checked, "REG_DWORD");
 385         regWrite(REGKEY_PATH + "CompareVBAMacros", chkCompareVBAMacros.checked, "REG_DWORD"); window.close();
 386       }
 387
 388       function btnCancel_onclick() {
 389         window.close();
 390       }
 391
 392     </script>
 393   </head>
 394   <body onload="onload();">
 395     <div>
 396       <ul>
 397         <li>
 398           <label class="en">Language: </label>
 399           <label class="ja">\8c¾\8cê: </label>
 400           <select id="cboLanguage" onclick="cboLanguage_onclick();" >
 401             <option value="English">English</option>
 402             <option value="Japanese">Japanese</option>
 403           </select>
 404         </li>
 405       </ul>
 406       <ul>
 407         <li>
 408           <input id="chkUnpackToFolder" type="checkbox" onclick="chkUnpackToFolder_onclick();"/>
 409           <label class="en">Extract slide data to multiple files </label>
 410           <label class="ja">\83X\83\89\83C\83h\82Ì\8fî\95ñ\82ð\95¡\90\94\83t\83@\83C\83\8b\82É\93W\8aJ\82·\82é </label>
 411         </li>
 412         <li>
 413           <input id="chkCompareDocumentProperties" type="checkbox" />
 414           <label class="en">Compare document properties </label>
 415           <label class="ja">\83h\83L\83\85\83\81\83\93\83g\83v\83\8d\83p\83e\83B\82ð\94ä\8ar\82·\82é </label>
 416         </li>
 417         <li>
 418           <input id="chkCompareSlideAsImage" type="checkbox" onclick="chkCompareSlideAsImage_onclick();"/>
 419           <label class="en">Compare slides as image (very slow)</label>
 420           <label class="ja">\83X\83\89\83C\83h\82ð\89æ\91\9c\89»\82µ\82Ä\94ä\8ar\82·\82é (\8f\88\97\9d\8e\9e\8aÔ\91\9d\91å)</label>
 421         </li>
 422         <li>
 423           <input id="chkCompareTextsInShapes" type="checkbox" />
 424           <label class="en">Compare texts in shapes </label>
 425           <label class="ja">\90}\8c`\93à\82Ì\83e\83L\83X\83g\82ð\94ä\8ar\82·\82é </label>
 426         </li>
 427         <li>
 428           <input id="chkCompareTextsInNotesPage" type="checkbox" />
 429           <label class="en">Compare texts in notes page </label>
 430           <label class="ja">\83m\81[\83g\93à\82Ì\83e\83L\83X\83g\82ð\94ä\8ar\82·\82é </label>
 431         </li>
 432         <li>
 433           <input id="chkCompareVBAMacros" type="checkbox" />
 434           <label class="en">Compare VBA macros </label>
 435           <label class="ja">VBA \83}\83N\83\8d\82ð\94ä\8ar\82·\82é </label>
 436         </li>
 437       </ul>
 438       <ul>
 439         <li>
 440           <input class="en" type="button" onclick="btnOk_onclick();" value="OK" />
 441           <input class="en" type="button" onclick="btnCancel_onclick();" value="Cancel" />
 442           <input class="ja" type="button" onclick="btnOk_onclick();" value="OK" />
 443           <input class="ja" type="button" onclick="btnCancel_onclick();" value="\83L\83\83\83\93\83Z\83\8b" />
 444         </li>
 445       </ul>
 446     </div>
 447   </body>
 448 </html>
 449 ]]>
 450 </resource>
 451
 452 </scriptlet>