' ==========================================================================
' 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