1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
|
' ==========================================================================
' Name: PDF Metadata Editor
' Version: 1.1
' Last Modified: 2005-05-31
' Program URL: http://www.arilabs.com/software/pdfmeta/pdfmeta.vbs
' Filename: pdfmeta.vbs
' Author: Brian High <bkh AT arilabs DOT com>
' Copyright: Analytical Resources, Inc. (2005)
' License: GNU GPL version 2 (or greater). See LICENSE section below.
' Description: It allows you to edit Title, Author, Subject, and Keywords.
' It is an easy to use, but limited front end to pdftk.
' Requires: pdftk-1.12, VBScript language support (Windows Script Host)
' ==========================================================================
' ============
' Instructions
' ============
' (1) Requires this script (pdfmeta.vbs) to be in same folder as pdftk.exe.
' The easiest way to install pdftk is to install "PDFTK Builder" (free).
' http://users.on.net/~johnson/pdftkb/pdftkb_setup.exe
' PDFTK Builder is a GUI front end for pdftk and has many useful features.
' --Or-- you can unzip pdftk.exe from the zip file found here:
' http://www.accesspdf.com/pdftk/ (Click Download link and get zip.)
' (Place pdftk.exe in an appropriately named and located folder.)
' See also: http://hacks.oreilly.com/pub/h/2422
' (2) Place this script (pdfmeta.vbs) in the installation folder for the
' pdftk package. Make a shortcut to pdfmeta.vbs and place on your
' desktop, if you like.
' (3) USAGE: Just drag the source PDF file onto this VBS script (or a
' shortcut to it). Follow prompts. The temporary folder will open
' and the new PDF will be inside. Move the new PDF to its destination.
' ====================================================================
' LICENSE: GNU GPL v2 or greater: http://www.gnu.org/licenses/gpl.txt
' ====================================================================
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
Option Explicit
' Declare Variables
Dim sInfile, sFileName, sTempFile, sCurrentDir, sCurrentDrive, sScriptName
Dim sComSpec, sMeta, sTempPath, sCmd, sPdftk, sAppTitle, sTKCmd, args
' Configure application title and filename of PDFTK command
sAppTitle = "PDF Metadata Editor v1.1"
sTKCmd = "pdftk.exe"
' To use different metadata fields, change this array definition
Dim aFields(3,1)
aFields(0,0) = "Title"
aFields(1,0) = "Subject"
aFields(2,0) = "Author"
aFields(3,0) = "Keywords"
' Set flag for "dictionary not found"
Dim noDict
noDict = False
' Define Constants
Const Create = True, DontCreate = False
Const HideWindow = 0, ShowWindow = 1
Const ForReading = 1, ForWriting = 2, ForAppending = 3
' Main Routine
GetArguments()
OpenPDFFile()
GetCurrentDirectory()
TryToAccessPDFTK()
GetTempFolder()
DeleteMetaFile()
CreateDumpDataCmd()
WriteMetaData()
DisplayMetaData()
PromptForMetaData()
WriteNewMetaData()
WriteMetaDataIntoNewPDF()
' Subroutines
Private Sub GetArguments
Dim sErr, num, oShell
' Get script arguments and check for at least one (the file name)
Set oShell = WScript.CreateObject("WScript.Shell")
Set args = WScript.Arguments
sScriptName = WScript.ScriptFullName
num = args.Count
sErr = "Usage: [cscript | wscript] pdfmeta.vbs <filename>" & vbCRLF & _
"(Just drag a PDF file onto this script and follow the prompts.)"
If num = 0 Then
WScript.Echo sErr
WScript.Quit 1
End If
If InStr(UCase(args.Item(0)), ".PDF") = 0 Then
WScript.Echo sErr
WScript.Quit 1
End If
End Sub
Private Sub OpenPDFFile
Dim sErr, sFile, oFile, FSO
' Try to open the input file
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
sFile = args.Item(0)
sErr = sFile & " does not exist!"
If FSO.FileExists(sFile) Then
Set oFile = FSO.GetFile(sFile)
sInfile = oFile.path
sFileName = oFile.name
Else
WScript.Echo sErr
WScript.Quit 1
End If
End Sub
Private Sub GetCurrentDirectory
Dim aCurrentPath, FSO, sErr, oFile
' Get current directory (where script is located)
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Set oFile = FSO.GetFile(sScriptName)
sCurrentDir = oFile.path
aCurrentPath = split(sCurrentDir, ":")
sCurrentDrive = aCurrentPath(0)
sErr = "This program must reside on a local drive or mapped drive."
If Len(sCurrentDrive) <> 1 Then
WScript.Echo sErr
WScript.Quit 1
End If
sCurrentDir = aCurrentPath(1)
sCurrentDir = Mid(sCurrentDir, 1, Len(sCurrentDir) - Len(oFile.name))
sPdftk = sCurrentDrive & ":" & sCurrentDir & sTKCmd
End Sub
Private Sub TryToAccessPDFTK
Dim sErr, FSO
' Try to access the pdftk.exe program
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
sErr = sPdftk & " does not exist!"
If FSO.FileExists(sPdftk) Then
' Found pdftk.exe in current directory...
Else
WScript.Echo sErr
WScript.Quit 1
End If
End Sub
Private Sub GetTempFolder
Dim oShell
' Get the path of the temporary folder
set oShell = CreateObject("WScript.Shell")
sTempPath = oShell.ExpandEnvironmentStrings("%temp%")
sComSpec = oShell.ExpandEnvironmentStrings("%comspec%")
sTempFile = sTempPath & "\" & sFileName
End Sub
Private Sub DeleteMetaFile
Dim FSO, oOrigMetaFile
' Delete the metadata file if it already exists
sMeta = sTempPath & "\metadata.txt"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sMeta) Then
Set oOrigMetaFile = FSO.GetFile(sMeta)
oOrigMetaFile.Delete
End If
End Sub
Private Sub CreateDumpDataCmd
Dim oShell
' Create a command shell object and dump pdf info to metadata file
sCmd = sComSpec & " /c chdir /d """ & sCurrentDrive & ":" & sCurrentDir _
& """ & " & sTKCmd & " """ & sInfile & """ dump_data " _
& ">""" & sMeta & """ 2>&1"
Set oShell = WScript.CreateObject("Wscript.Shell")
oShell.Run sCmd, HideWindow, True
End Sub
Private Sub FixBrokenDictionary
Dim oShell
' Create a command shell object and "cat" pdf info new pdf
sCmd = """" & sPdftk & """" & " " & """" & sInfile & """" & _
" cat output " & """" & sTempFile & """" & " dont_ask"
Set oShell = WScript.CreateObject("Wscript.Shell")
oShell.Run sCmd, HideWindow, True
sCmd = sComSpec & " /c move /y " & """" & sTempFile & """" & " " & """" _
& sInfile & """"
Set oShell = WScript.CreateObject("Wscript.Shell")
oShell.Run sCmd, HideWindow, True
CreateDumpDataCmd()
WriteMetaData()
End Sub
Private Sub WriteMetaData
Dim RE, FSO, TSO, sErr
sErr = "Unable to repair info dictionary."
' Read from metadata file, test for expressions,
' and store metadata values
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sMeta) Then
Set TSO = FSO.OpenTextFile(sMeta, ForReading, DontCreate)
Set RE = New RegExp
Dim i, sLine
Do While Not TSO.AtEndOfStream
sLine = TSO.ReadLine
RE.Pattern = "no info dictionary found"
If RE.Test(sLine) Then
If noDict = True Then
WScript.Echo sErr
WScript.Quit 1
Else
noDict = True
' Close TextStreamObject
TSO.Close
FixBrokenDictionary()
Exit Sub
End If
Else
noDict = False
For i = LBound(aFields) to UBound(aFields)
RE.Pattern = "InfoKey: " & aFields(i,0)
If RE.Test(sLine) Then
sLine = TSO.ReadLine
aFields(i,1) = Mid(sLine, 12)
End If
Next
End If
Loop
' Close TextStreamObject
TSO.Close
End If
End Sub
Private Sub DisplayMetaData
Dim i, msg, tabs, retval
msg = "Your PDF file has the following properties:" & vbCRLF & vbCRLF
For i = LBound(aFields) to UBound(aFields)
If Len(aFields(i,0)) > 7 Then tabs = vbTab Else tabs = vbTab & vbTab
msg = msg & aFields(i,0) & ": " & tabs & aFields(i,1) & vbCRLF
Next
msg = msg & vbCRLF & vbCRLF & "Click OK to continue or Cancel to quit."
retval = msgbox (msg, vbOKCancel, sAppTitle )
If retval = vbCancel Then WScript.Quit 1
End Sub
Private Sub PromptForMetaData
' Prompt user for metadata, using metadata in original file as defaults
Dim i
For i = LBound(aFields) to UBound(aFields)
aFields(i,1) = _
InputBox("Enter the " & aFields(i,0) & ":", sAppTitle, aFields(i,1))
Next
End Sub
Private Sub WriteNewMetaData
Dim FSO, TSO
' Open a text file and write metadata to it
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TSO = FSO.OpenTextFile(sMeta, ForWriting, Create)
Dim i
For i = LBound(aFields) to UBound(aFields)
TSO.Write "InfoKey: " & aFields(i,0) & vbCrLf
TSO.Write "InfoValue: " & aFields(i,1) & vbCrLf
Next
' Close TextStreamObject
TSO.Close
End Sub
Private Sub WriteMetaDataIntoNewPDF
Dim oShell
' Create a command shell object and set pdftk command string variable
set oShell = WScript.CreateObject("Wscript.Shell")
sCmd = """" & sPdftk & """" & " " & """" & sInfile & """" & _
" update_info " & """" & sMeta & """" & " output " & """" _
& sTempFile & """" & " dont_ask"
Dim retval
' Run pdftk command and destroy local variables to release memory
oShell.run sCmd, HideWindow, True
retval = msgbox ( "Look for the output file in the temporary folder" & _
" which will open next." & vbCRLF & "The output file" & _
" will have the same name as the original file.", _
vbOKCancel, sAppTitle )
If retval = vbCancel Then WScript.Quit 1
' Open explorer to temp folder
oShell.run "Explorer " & sTempPath, 1, True
End Sub
|
