source: main/trunk/binaries/windows/bin/pptextract.frm@ 25756

Last change on this file since 25756 was 10628, checked in by chi, 19 years ago

Modify VB script to use late binding technique to solve the problem of running the script for
Multiple Office versions.
  • Property svn:keywords set to Author Date Id Revision
File size: 9.8 KB
Line 
1VERSION 5.00
2Begin VB.Form Form1
3 Caption = "Form1"
4 ClientHeight = 1380
5 ClientLeft = 60
6 ClientTop = 450
7 ClientWidth = 3825
8 LinkTopic = "Form1"
9 ScaleHeight = 1380
10 ScaleWidth = 3825
11 StartUpPosition = 3 'Windows Default
12 Begin VB.Label W
13 Alignment = 2 'Center
14 Caption = "Word to HTML"
15 BeginProperty Font
16 Name = "MS Sans Serif"
17 Size = 24
18 Charset = 0
19 Weight = 400
20 Underline = 0 'False
21 Italic = 0 'False
22 Strikethrough = 0 'False
23 EndProperty
24 Height = 615
25 Left = 360
26 TabIndex = 0
27 Top = 360
28 Width = 3375
29 End
30End
31Attribute VB_Name = "Form1"
32Attribute VB_GlobalNameSpace = False
33Attribute VB_Creatable = False
34Attribute VB_PredeclaredId = True
35Attribute VB_Exposed = False
36Private Sub Form_Load()
37 'For solving the backward compatability of MS Automation with VB script
38 'We need to use the late binding technique, in which mean that we need to
39 'define all Office Automation variable as an Object first and it can then
40 'to decide the office version at run-tim.
41 Dim objPA As Object
42 Set objPA = CreateObject("PowerPoint.Application")
43 objPA.Visible = True
44
45 Dim objPPTs As Object
46 Set objPPTs = objPA.Presentations
47
48 htm = False
49 jpg = False
50 gif = False
51 old = False
52 png = False
53 meta = False
54
55 '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)
56 cmdln = LCase(Command())
57 'MsgBox ("Command:" + cmdln)
58 'cmdln = "-g H:\chi\Visual Basic\ForumPres270404.ppt H:\chi\Visual Basic\tmp\ForumPres270404"
59 outputdir = getoutput(cmdln)
60 File = Left(cmdln, InStr(cmdln, ".ppt") + 3)
61 item_file = Left(cmdln, InStr(cmdln, ".ppt"))
62 args = getargs(File)
63 direc = getdir(File)
64 File = getfile(File)
65
66 item_file = getfile(item_file)
67 'We don't use this script to convert the PPT to html, instead, we use
68 'the open source come with Greenstone package
69 If InStr(args, "j") Then jpg = True
70 If InStr(args, "g") Then gif = True
71 If InStr(args, "p") Then png = True
72
73 Dim item, text As Object
74 Dim fso As Object
75 Set fso = CreateObject("Scripting.FileSystemObject")
76
77 'Modified for apply to GSII environment setting
78 output_tmp = Left(outputdir, InStr(outputdir, "\tmp") + 3)
79 'output_tmp = Mid(outputdir, 2, InStr(outputdir, "\tmp") + 3)
80 'MsgBox ("OUTPUT_TMP:" + output_tmp)
81
82 If Not fso.FolderExists(output_tmp) Then
83 fso.CreateFolder (output_tmp)
84 If Not fso.FolderExists(outputdir) Then
85 fso.CreateFolder (outputdir)
86 End If
87 Else
88 If Not fso.FolderExists(outputdir) Then
89 fso.CreateFolder (outputdir)
90 End If
91 End If
92
93 'generate document_name.item file
94 Set item = fso.CreateTextFile(outputdir + "\" + item_file + "item", ForWriting, True)
95 'Set item = CreateObject("ADODB.Stream")
96 'item.Open
97 'item.Position = 0
98 'item.Charset = "UTF-8"
99
100 'Print #3, "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "UTF-8" + Chr(34) + " standalone=" + Chr(34) + "no" + Chr(34) + "?>"
101 'Print #3, "<!DOCTYPE DirectoryMetadata SYSTEM " + Chr(34) + "http://greenstone.org/dtd/DirectoryMetadata/1.0/DirectoryMetadata.dtd" + Chr(34) + ">"
102 'Print #1, "<PagedDocument>"
103 item.WriteLine ("<PagedDocument>")
104 'item.WriteText "<PagedDocument>", 1
105 Source = direc + File
106 'MsgBox ("Src:" + Source)
107 objPPTs.Open (Source)
108
109 'do stuff
110 n = 1
111 Dim slide_shape As Shape
112 j = 2
113 For slide_count = 1 To objPPTs(1).Slides.Count
114 current_slide = objPPTs(1).Slides(slide_count).Name
115 'generate a text version
116 Set text = fso.CreateTextFile(outputdir + "\Slide" + CStr(slide_count) + ".txt", ForWriting, True)
117 If (objPPTs(1).Slides(slide_count).Shapes.HasTitle) Then
118 slide_title = objPPTs(1).Slides(slide_count).Shapes.Title.TextFrame.TextRange
119 Else
120 slide_title = objPPTs(1).Slides(slide_count).Name
121 End If
122 slide_text = ""
123 found_text = True
124 For iShape = 1 To objPPTs(1).Slides(slide_count).Shapes.Count
125 If (objPPTs(1).Slides(slide_count).Shapes(iShape).TextFrame.HasText) Then
126 slide_text = objPPTs(1).Slides(slide_count).Shapes(iShape).TextFrame.TextRange.text
127 'MsgBox ("Slide_text:" + slide_text)
128 If slide_text <> "" Then
129 text.WriteLine (slide_text)
130 'text.WriteText (slide_text)
131 Else
132 text.WriteLine ("This slide has no text")
133 End If
134 End If
135 Next iShape
136 'text_file = outputdir + "\Slide" + CStr(slide_count) + ".txt"
137 'text.SaveToFile text_file
138 'text.Close
139 'j = j + 1
140 If objPPTs(1).Slides.Count >= 1 And slide_count < objPPTs(1).Slides.Count Then
141 next_slide = objPPTs(1).Slides(slide_count + 1).Name
142 Else
143 nextf = " "
144 End If
145 If htm Then
146 'Not developed for converting to html yet
147 'Currently, if the user choose to convert the PPT to the html file
148 'We will only allow users to use the open source method through Greenstone
149 End If
150 If gif Then
151 current_slide = "Slide" + CStr(n)
152 If nextf <> " " Then
153 nextf = outputdir + "\" + "Slide" + CStr(n + 1)
154 End If
155 prevhtml = outputdir + "\" + current_slide + ".gif"
156 If slide_text = "" Then
157 itemxml item, current_slide + ".gif", "", n, slide_title
158 Else
159 itemxml item, current_slide + ".gif", current_slide + ".txt", n, slide_title
160 End If
161 End If
162 If jpg Then
163 current_slide = "Slide" + CStr(n)
164 If nextf <> " " Then
165 nextf = outputdir + "\" + "Slide" + CStr(n + 1)
166 End If
167 prevhtml = outputdir + "\" + current_slide + ".jpg"
168 If slide_text = "" Then
169 itemxml item, current_slide + ".jpg", "", n, slide_title
170 Else
171 itemxml item, current_slide + ".jpg", current_slide + ".txt", n, slide_title
172 End If
173 End If
174 If png Then
175 current_slide = "Slide" + CStr(n)
176 If nextf <> " " Then
177 nextf = outputdir + "\" + "Slide" + CStr(n + 1)
178 End If
179 prevhtml = outputdir + "\" + current_slide + ".png"
180 If slide_text = "" Then
181 itemxml item, current_slide + ".png", "", n, slide_title
182 Else
183 itemxml item, current_slide + ".png", current_slide + ".txt", n, slide_title
184 End If
185 End If
186 n = n + 1
187 item.WriteLine (" </Page>")
188 'item.WriteText " </Page>", 1
189 Next
190 i = 0
191 If htm Then
192 'ppts(1).SaveAs outputdir, ppSaveAsHTMLv3
193 ElseIf gif Then
194 objPPTs(1).SaveAs outputdir, ppSaveAsGIF
195 ElseIf jpg Then
196 objPPTs(1).SaveAs outputdir, ppSaveAsJPG
197 ElseIf png Then
198 objPPTs(1).SaveAs outputdir, ppSaveAsPNG
199 End If
200
201 item.WriteLine ("</PagedDocument>")
202 'item.WriteText "</PagedDocument>", 1
203 'objStream.SaveToFile pstrFile
204 'item.SaveToFile outputdir + "\" + item_file + "item"
205 item.Close
206 objPPTs(1).Close
207 Set fso = Nothing
208 Set text = Nothing
209 Set item = Nothing
210 objPA.Quit
211End
212End Sub
213Function getoutput(line)
214 cmdln = line
215 While InStr(cmdln, ".ppt")
216 cmdln = Trim(Right(cmdln, Len(cmdln) - (InStr(cmdln, ".ppt") + 4)))
217 cmdln = Trim(Mid(cmdln, 2, Len(cmdln) - 2))
218 Wend
219 getoutput = cmdln
220 End Function
221Function getargs(line)
222 x = LTrim(line)
223 If InStr(x, "-") = 1 Then
224 getargs = Left(line, InStr(line, " "))
225 End If
226End Function
227Function getdir(line)
228 x = LTrim(Right(line, Len(line) - Len(getargs(line)) - 1))
229 If InStr(x, ":") <> 2 Then
230 direc = CurDir
231 If Right(direc, 1) <> "\" Then direc = direc + "\"
232 End If
233
234 While InStr(x, "\")
235 direc = direc + Left(x, InStr(x, "\"))
236 x = Right(x, Len(x) - InStr(x, "\"))
237 Wend
238 getdir = direc
239End Function
240Function getfile(line)
241 x = LTrim(Right(line, Len(line) - Len(getargs(line))))
242 While InStr(x, "\")
243 x = Right(x, Len(x) - InStr(x, "\"))
244 Wend
245 getfile = x
246End Function
247Sub itemxml(out_item, thisfile, txtfile, num, slide_title)
248 out_item.WriteLine (" <Page pagenum=" + Chr(34) + CStr(num) + Chr(34) + " imgfile=" + Chr(34) + thisfile + Chr(34) + " txtfile=" + Chr(34) + txtfile + Chr(34) + ">")
249 'out_item.WriteText " <Page pagenum=" + Chr(34) + CStr(num) + Chr(34) + " imgfile=" + Chr(34) + thisfile + Chr(34) + " txtfile=" + Chr(34) + txtfile + Chr(34) + ">", 1
250 If slide_title <> "" Then
251 out_item.WriteLine (" <Metadata name=" + Chr(34) + "Title" + Chr(34) + ">" + slide_title + "</Metadata>")
252 'MsgBox ("Title:" + slide_title)
253 'out_item.WriteText " <Metadata name=" + Chr(34) + "Title" + Chr(34) + ">" + slide_title + "</Metadata>", 1
254 End If
255 End Sub
256Function checknext(filename, extention)
257 If filename = "" Then
258 checknext = ""
259 Else
260 checknext = filename + extention
261 End If
262End Function
263Function replaceStrings(f, c, W)
264s = f
265t = ""
266While InStr(s, c)
267 t = t + Left(s, InStr(s, c) - 1) + W
268 s = Right(s, Len(s) - (InStr(s, c) + Len(c)) + 1)
269Wend
270replaceStrings = t + s
271End Function
272Function fixnum(s)
273 fixnum = String(4 - Len(s), "0") + s
274End Function
Note: See TracBrowser for help on using the repository browser.