'
' soplayer.vbs - StarOffice Presentation Player
'
' Version 0.3 written in VBScript             - December 13, 2007  by Takamichi Akiyama <tora@openoffice.org> 
' Version 0.2 written in OpenOffice.org BASIC - December 13, 2007  by Takamichi Akiyama <tora@openoffice.org> 
' Version 0.1 - July 30, 2004 by Takamichi Akiyama <tora@openoffice.org> 
' License: GNU LGPL
'
' この VBScript は、プレゼンテーションのファイルを開いて、プレゼンテーションを開始します。
' プレゼンテーションが終了すると、自動的にファイルを閉じます。

' 使い方その１
' このファイルのアイコンへ、プレゼンテーションのファイルをドラッグアンドドロップします。
'
' 使い方その２
' このファイルを実行すると、ファイルを開くダイアログが表示されますので、プレゼンテーションのファイルを選択します。
'
' どちらの方法でも、１つ以上のファイルを指定できます。その場合は、順番にプレゼンテーションが表示されます。
'

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

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)
			play sURL
		Next
	Else
		' File Selection Dialog Interface
		sURLs = getURLs_for_Open()
		For I = 0 To UBound(sURLs)
			sURL = sURLs(I)
			play sURL
		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 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 "プレゼンテーションのファイルを選んでください。ShiftやCtrlキーを押しながら、複数のファイルを一度に選択できます。"
		.AppendFilter "プレゼンテーションのファイル (*.odp;*.sxi;*.ppt)", "*.odp;*.sxi;*.ppt"
		.SetCurrentFilter "プレゼンテーションのファイル (*.odp;*.sxi;*.ppt)"
		.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 play(sURL)
	'MsgBox sURL

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

	Dim oDoc

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

	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

	If Not oDoc.supportsService("com.sun.star.presentation.PresentationDocument") Then
		oDoc.close False
		MsgBox "ファイル " & sURL & " は、プレゼンテーションのファイルではありません。", bOKOnly + vbCritical, "エラー発生!"
		Exit Sub
	End If

	StartPresentation oDoc
	if (oDoc.Presentation.IsFullScreen) Then
		do
			WScript.Sleep 1000
		loop While (isOnGoing(oDoc))
		oDoc.close True
	End If

End Sub

Function isOnGoing(oDoc)
	Dim sTitle
	Dim oComponents
	Dim nCount
	Dim oEnumeration
	Dim oElement

	sTitle = getTitle(oDoc)
	nCount = 0
	Set oComponents = oDesktop.getComponents()
	if oComponents.hasElements() Then
		Set oEnumeration = oComponents.createEnumeration()
		do while (oEnumeration.hasMoreElements())
			Set oElement = oEnumeration.nextElement()
			if oElement.supportsService("com.sun.star.presentation.PresentationDocument") Then
				If getTitle(oElement) = sTitle Then
					nCount = nCount + 1
				End If
			end if
		loop
	End If
	isOnGoing = (nCount >= 2)
End Function

Function getTitle(oElement)
	Dim xController
	Dim xFrame

	Set xController = oElement.getCurrentController()
	Set xFrame = xController.getFrame()
	getTitle = xFrame.Title
End Function

Sub StartPresentation(oDoc)
	Dim oPresentation
	Set oPresentation = oDoc.getPresentation()
	' http://api.openoffice.org/docs/common/ref/com/sun/star/presentation/Presentation.html
	oPresentation.AllowAnimations = True
	oPresentation.CustomShow = ""
	oPresentation.FirstPage = ""
	oPresentation.IsAlwaysOnTop = True
	oPresentation.IsAutomatic = False
	oPresentation.IsEndless = False
	oPresentation.IsFullScreen = True
	'oPresentation.IsLivePresentation = 
	oPresentation.IsMouseVisible = True
	'oPresentation.IsShowAll = True
	oPresentation.IsTransitionOnClick = True
	oPresentation.IsShowLogo = False
	oPresentation.Pause = 1
	oPresentation.StartWithNavigator = False
	oPresentation.UsePen = True
	oPresentation.Start()
End Sub