' Name: OpenOffice.org PDF Converter
' Version: 0.1
' Date: July 10, 2007
' Author: Takamichi Akiyama <tora@openoffice.org>
' Licence: LGPL

' 使い方その１
' このファイルのアイコンへ、PDF変換したい元のファイルをドラッグアンドドロップします。
'
' 使い方その２
' このファイルを実行すると、ファイルを開くダイアログが表示されますので、PDF変換したいファイルを選択します。
'
' どちらの方法でも、１つ以上のファイルを一度に処理できます。

Public oServiceManager, oCoreReflection
Set oServiceManager = WScript.CreateObject("com.sun.star.ServiceManager")
Set oCoreReflection = oServiceManager.createInstance("com.sun.star.reflection.CoreReflection")

Call Main

Sub Main
	Dim oArgs, sPath, sURL, sURLs, sPDF, I
	Set oArgs = WScript.Arguments
	If oArgs.Count > 0 Then
		' Drag and Drop Interface
		For I = 0 to oArgs.Count - 1
			sPath = oArgs(I)
			sURL = convertToURL(sPath)
			sPDF = getPDFURL(sURL)
			convert_into_PDF sURL, sPDF
		Next
	Else
		' File Selection Dialog Interface
		sURLs = getURLs_for_Open()
		For I = 0 To UBound(sURLs)
			sURL = sURLs(I)
			sPDF = getPDFURL(sURL)
			convert_into_PDF sURL, sPDF
		Next
	End If
End Sub

Function convertToURL(sPath)
	Dim regEx, sURL
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Global = True
	regEx.Pattern = "\\"
	sURL = "file:///" + regEx.Replace(sPath, "/")
	convertToURL = sURL
End Function

Function getPDFURL(sURL)
	Dim regEx, sPDF
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Global = False
	regEx.Pattern = "\.[a-z]+$"
	If regEx.Test(sURL) Then
		sPDF = regEx.Replace(sURL, ".pdf")
	Else
		sPDF = sURL + ".pdf"
	End If
	getPDFURL = sPDF
End Function

Function getURLs_for_Open()
	Dim oFilePicker, sFiles
	Set oFilePicker = oServiceManager.createInstance("com.sun.star.ui.dialogs.FilePicker")
	Dim args(0)
	args(0) = 0 'com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
	With oFilePicker
		.initialize(args)
		.setTitle "PDF変換元のファイルを選んでください。ShiftやCtrlキーを押しながら、複数のファイルを一度に選択できます。"
		.AppendFilter "すべてのファイル (*.*)", "*.*"
		.SetCurrentFilter "すべてのファイル (*.*)"
		.setMultiSelectionMode(True)
	End With
	If oFilePicker.execute() = False Then
		Wscript.Quit
	End If
	sFiles = oFilePicker.getFiles()
	Dim sPath
	If UBound(sFiles) > 1 Then
		ReDim sPath(UBound(sFiles) - 1)
		For I = 1 To UBound(sFiles)
			sPath(I - 1) = sFiles(0) & sFiles(I)
		Next
	Else
		ReDim sPath(0)
		sPath(0) = sFiles(0)
	End If
	getURLs_for_Open = sPath
End Function

Sub convert_into_PDF(sURL, sPDF)
	'MsgBox sURL & vbCRLF & sPDF

	Dim classSize
	Set classSize = oCoreReflection.forName("com.sun.star.beans.PropertyValue")

	Dim oDesktop, oDoc
	Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")

	Dim args1(0)
	classSize.createObject args1(0)
	args1(0).Name = "Hidden"
	args1(0).Value = true

	On Error Resume Next
	Set oDoc = oDesktop.loadComponentFromURL(sURL, "_default", 0, args1)
	On Error Goto 0

	If Not IsObject(oDoc) Then
		MsgBox "ファイル " & sURL & " を開けませんでした。", vbOKOnly + vbCritical, "エラー発生!"
		Exit Sub
	End If

	Select Case True
	Case oDoc.supportsService("com.sun.star.text.GlobalDocument")
		sFilter = "writer_globaldocument_pdf_Export"
	Case oDoc.supportsService("com.sun.star.text.WebDocument")
		sFilter = "writer_web_pdf_Export"
	Case oDoc.supportsService("com.sun.star.text.TextDocument")
		sFilter = "writer_pdf_Export"
	Case oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument")
		sFilter = "calc_pdf_Export"
	Case oDoc.supportsService("com.sun.star.presentation.PresentationDocument")
		sFilter = "impress_pdf_Export"
	Case oDoc.supportsService("com.sun.star.drawing.DrawingDocument")
		sFilter = "draw_pdf_Export"
	Case oDoc.supportsService("com.sun.star.formula.FormulaPropertyies")
		sFilter = "math_pdf_Export"
	Case Else
		oDoc.close False
		MsgBox "ファイル " & sURL & " は、予期していないファイルであるため、PDF変換 できませんでした。", bOKOnly + vbCritical, "エラー発生!"
		Exit Sub
	End Select  

	Dim args3(0)
	classSize.createObject args3(0)
	args3(0).Name = "InitialView"
	args3(0).Value = 0

	Dim args2(2)
	classSize.createObject args2(0)
	classSize.createObject args2(1)
	classSize.createObject args2(2)
	args2(0).Name = "FilterName"
	args2(0).Value = sFilter
	args2(1).Name = "Overwrite"
	args2(1).Value = True
	args2(2).Name = "FilterData"
	args2(2).Value = args3

	oDoc.storeToURL sPDF, args2

	oDoc.close False

	MsgBox "ファイル " & sURL & " を PDF変換 しました。", bOKOnly + vbInformation, "PDF変換 正常終了"
End Sub

' End Of File