Changeset 10628

Timestamp:

2005-09-23T11:26:43+12:00 (19 years ago)

Author:

chi

Message:

Modify VB script to use late binding technique to solve the problem of running the script for
Multiple Office versions.

Location:

trunk/winbin/bin

Files:

• pptextract.exe (modified) ( previous)
• pptextract.frm (modified) (11 diffs)
• pptextract.vbp (modified) (1 diff)

trunk/winbin/bin/pptextract.frm

@@ -35 +35 @@
 Attribute VB_Exposed = False
 Private Sub Form_Load()
-    Dim pa As PowerPoint.Application
-    Set pa = CreateObject("PowerPoint.Application")
-    pa.Visible = True
-    
-    Dim ppts As PowerPoint.Presentations
-    Set ppts = pa.Presentations
+    'For solving the backward compatability of MS Automation with VB script
+    'We need to use the late binding technique, in which mean that we need to
+    'define all Office Automation variable as an Object first and it can then
+    'to decide the office version at run-tim.
+    Dim objPA As Object
+    Set objPA = CreateObject("PowerPoint.Application")
+    objPA.Visible = True
+    
+    Dim objPPTs As Object
+    Set objPPTs = objPA.Presentations
             
     htm = False
@@ -49 +53 @@
     meta = False
     
-    'cmdln = "-g " & Chr(34) & "C:\chi\gsdl\collect\PPTTest2\import\16-A.ppt" & Chr(34) & Chr(34) & "C:\chi\gsdl\collect\PPTTest2\tmp\16-A" & Chr(34)
+    'cmdln = "-g " & Chr(34) & "H:\chi\gsdl\collect\PPTTest\import\LITA-2004.ppt" & Chr(34) & Chr(34) & "H:\chi\gsdl\collect\PPTTest\tmp\LITA-2004" & Chr(34)
     cmdln = LCase(Command())
     'MsgBox ("Command:" + cmdln)
@@ -55 +59 @@
     outputdir = getoutput(cmdln)
     File = Left(cmdln, InStr(cmdln, ".ppt") + 3)
-    'MsgBox ("File:" + File)
     item_file = Left(cmdln, InStr(cmdln, ".ppt"))
     args = getargs(File)
-    'MsgBox ("agr:" + args)
     direc = getdir(File)
-    'MsgBox ("direc:" + direc)
     File = getfile(File)
-    'MsgBox ("File:" + File)
-    
+       
     item_file = getfile(item_file)
-       
-    If InStr(args, "h") Then htm = True
+    'We don't use this script to convert the PPT to html, instead, we use
+    'the open source come with Greenstone package
     If InStr(args, "j") Then jpg = True
     If InStr(args, "g") Then gif = True
     If InStr(args, "p") Then png = True
-    If InStr(args, "o") Then old = True
-    If InStr(args, "m") Then meta = True
-
-    Dim item, text
-    'As Object
-    Dim fso
+    
+    Dim item, text As Object
+    Dim fso As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     
-    ' Modified for apply to GSII environment setting
-    'MsgBox ("OUTPUT_dir:" + outputdir)
+    'Modified for apply to GSII environment setting
     output_tmp = Left(outputdir, InStr(outputdir, "\tmp") + 3)
     'output_tmp = Mid(outputdir, 2, InStr(outputdir, "\tmp") + 3)
@@ -109 +105 @@
     Source = direc + File
     'MsgBox ("Src:" + Source)
-    ppts.Open (Source)
+    objPPTs.Open (Source)
                            
     'do stuff
@@ -115 +111 @@
     Dim slide_shape As Shape
     j = 2
-    For slide_count = 1 To ppts(1).Slides.Count
-        current_slide = ppts(1).Slides(slide_count).Name
+    For slide_count = 1 To objPPTs(1).Slides.Count
+        current_slide = objPPTs(1).Slides(slide_count).Name
         'generate a text version
         Set text = fso.CreateTextFile(outputdir + "\Slide" + CStr(slide_count) + ".txt", ForWriting, True)
-        'Set text = CreateObject("ADODB.Stream")
-        'text.Open
-        'text.Position = 0
-        'text.Charset = "UTF-8"
-        If (ppts(1).Slides(slide_count).Shapes.HasTitle) Then
-            slide_title = ppts(1).Slides(slide_count).Shapes.Title.TextFrame.TextRange
+        If (objPPTs(1).Slides(slide_count).Shapes.HasTitle) Then
+            slide_title = objPPTs(1).Slides(slide_count).Shapes.Title.TextFrame.TextRange
         Else
-            slide_title = ppts(1).Slides(slide_count).Name
+            slide_title = objPPTs(1).Slides(slide_count).Name
         End If
         slide_text = ""
         found_text = True
-        For iShape = 1 To ppts(1).Slides(slide_count).Shapes.Count
-            If (ppts(1).Slides(slide_count).Shapes(iShape).TextFrame.HasText) Then
-                slide_text = ppts(1).Slides(slide_count).Shapes(iShape).TextFrame.TextRange.text
+        For iShape = 1 To objPPTs(1).Slides(slide_count).Shapes.Count
+            If (objPPTs(1).Slides(slide_count).Shapes(iShape).TextFrame.HasText) Then
+                slide_text = objPPTs(1).Slides(slide_count).Shapes(iShape).TextFrame.TextRange.text
                 'MsgBox ("Slide_text:" + slide_text)
                 If slide_text <> "" Then
@@ -139 +131 @@
                 Else
                     text.WriteLine ("This slide has no text")
-                    'text.WriteText ("This slide has no text")
                 End If
             End If
@@ -147 +138 @@
         'text.Close
         'j = j + 1
-        If ppts(1).Slides.Count >= 1 And slide_count < ppts(1).Slides.Count Then
-            next_slide = ppts(1).Slides(slide_count + 1).Name
+        If objPPTs(1).Slides.Count >= 1 And slide_count < objPPTs(1).Slides.Count Then
+            next_slide = objPPTs(1).Slides(slide_count + 1).Name
         Else
             nextf = " "
         End If
         If htm Then
-            ' Not developed for convert to html yet
+            'Not developed for converting to html yet
             'Currently, if the user choose to convert the PPT to the html file
-            'We will only allow users to use the open source method
+            'We will only allow users to use the open source method through Greenstone
         End If
         If gif Then
@@ -201 +192 @@
         'ppts(1).SaveAs outputdir, ppSaveAsHTMLv3
     ElseIf gif Then
-        ppts(1).SaveAs outputdir, ppSaveAsGIF
+        objPPTs(1).SaveAs outputdir, ppSaveAsGIF
     ElseIf jpg Then
-        ppts(1).SaveAs outputdir, ppSaveAsJPG
+        objPPTs(1).SaveAs outputdir, ppSaveAsJPG
     ElseIf png Then
-        ppts(1).SaveAs outputdir, ppSaveAsPNG
+        objPPTs(1).SaveAs outputdir, ppSaveAsPNG
     End If
                 
@@ -213 +204 @@
     'item.SaveToFile outputdir + "\" + item_file + "item"
     item.Close
-    ppts(1).Close
+    objPPTs(1).Close
     Set fso = Nothing
     Set text = Nothing
     Set item = Nothing
-    pa.Quit
+    objPA.Quit
 End
 End Sub
 Function getoutput(line)
-    'MsgBox ("CMDLN:" + line)
     cmdln = line
     While InStr(cmdln, ".ppt")
-        'cmdln = LTrim(RTrim(Right(cmdln, Len(cmdln) - (InStr(cmdln, ".ppt") + 4))))
         cmdln = Trim(Right(cmdln, Len(cmdln) - (InStr(cmdln, ".ppt") + 4)))
         cmdln = Trim(Mid(cmdln, 2, Len(cmdln) - 2))
     Wend
     getoutput = cmdln
-    'MsgBox ("OUTPUTDIR:" + getoutput)
-End Function
+    End Function
 Function getargs(line)
     x = LTrim(line)
@@ -249 +237 @@
     Wend
     getdir = direc
-    'MsgBox ("GetDIr:" + getdir)
 End Function
 Function getfile(line)
@@ -257 +244 @@
     Wend
     getfile = x
-    End Function
+End Function
 Sub itemxml(out_item, thisfile, txtfile, num, slide_title)
     out_item.WriteLine ("   <Page pagenum=" + Chr(34) + CStr(num) + Chr(34) + " imgfile=" + Chr(34) + thisfile + Chr(34) + " txtfile=" + Chr(34) + txtfile + Chr(34) + ">")

trunk/winbin/bin/pptextract.vbp

@@ -1 +1 @@
 Type=Exe
-Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\STDOLE2.TLB#OLE Automation
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation
 Reference=*\G{91493440-5A91-11CF-8700-00AA0060263B}#2.6#0#C:\Program Files\Microsoft Office\OFFICE11\MSPPT.OLB#Microsoft PowerPoint 9.0 Object Library
 Form=pptextract.frm
-IconForm="Form1"
 Startup="Form1"
 ExeName32="pptextract.exe"