Function Version() As String
'-----------------------------------------------------------------------------------------
' Devuelve la versión de OpenOffice
  Dim oSet, oCfgProvider
  Dim aAux(0) As New com.sun.star.beans.PropertyValue
 
  oCfgProvider = createUnoService( _ 
     "com.sun.star.configuration.ConfigurationProvider")
  aAux(0).Name = "nodepath"
  aAux(0).Value = "/org.openoffice.Setup/Product"
  oSet = oCfgProvider.createInstanceWithArguments( _
     "com.sun.star.configuration.ConfigurationAccess", aAux())
  Version = oSet.getByName("ooSetupVersion")
End Function

Function Idioma( ByRef Idioma_Pais as string ) as string
'-----------------------------------------------------------------------------------------
' Devuelve el idioma y pais de la configuración regional de OpenOffice
  Dim oSet, oCfgProvider
  Dim aAux(0) As New com.sun.star.beans.PropertyValue
 
  oCfgProvider = createUnoService( _
      "com.sun.star.configuration.ConfigurationProvider")
  aAux(0).Name = "nodepath"
  aAux(0).Value = "/org.openoffice.Setup/L10N"
  oSet = oCfgProvider.createInstanceWithArguments( _
      "com.sun.star.configuration.ConfigurationAccess", aAux())
 
  Idioma_Pais = trim(oSet.getbyname("ooLocale"))   'es-AR
  Idioma = lCase(Left(Idioma_Pais,2))              'es
End Function

Sub Ejemplo()
'-----------------------------------------------------------------------------------------
  Dim Idioma_Pais as string
 
  MsgBox "El idioma es: " & Idioma( Idioma_Pais )
  MsgBox "El idioma y país (variación) es: " & Idioma_Pais
End Sub

Sub Deshacer()
'-----------------------------------------------------------------------------------------
' Ejecuta el comando undo (deshacer)
' Deshace la última acción realizada por el usuario
  Dim oDispatch
  Dim oFrame
  oFrame = ThisComponent.CurrentController.Frame
  oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
  oDispatch.executeDispatch(oFrame,".uno:Undo", "", 0, Array())
End Sub

Function GetTipoDocumento(optional oDoc as Object) As String
'-----------------------------------------------------------------------------------------
' Devuelve una cadena indicando el tipo de documento
' o una cadena vacía si no es detectado
 
If IsMissing( oDoc ) then oDoc = ThisComponent
 
On Local Error GoTo Error_NoDetectado
  If oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
    GetTipoDocumento = "scalc"
  ElseIf  oDoc.SupportsService("com.sun.star.text.TextDocument") Then
    GetTipoDocumento = "swriter"
  ElseIf  oDoc.SupportsService("com.sun.star.drawing.DrawingDocument") Then
    GetTipoDocumento = "sdraw"
  ElseIf  oDoc.SupportsService("com.sun.star.formula.FormulaProperties") Then
    GetTipoDocumento = "smath"
  ElseIf  oDoc.SupportsService("com.sun.star.presentation.PresentationDocument") Then
    GetTipoDocumento = "simpress"
  ElseIf  oDoc.SupportsService("com.sun.star.sdb.DatabaseDocument") Then
    GetTipoDocumento = "sbase"
  End If
 
Error_NoDetectado:
 
End Function

Function GetFiltroPDF(optional oDoc as Object) As String
'-----------------------------------------------------------------------------------------
' Precisa la función GetTipoDocumento
' Devuelve una cadena indicando el tipo de filtro de exportación
' según el tipo de documento o una cadena vacía si no es detectado
 
If IsMissing( oDoc ) then oDoc = ThisComponent
 
  Select Case lCase( GetTipoDocumento( oDoc ) )
  Case "scalc" 
    GetFiltroPDF = "calc_pdf_Export"
  Case "swriter"
    GetFiltroPDF = "writer_pdf_Export"
  Case "sdraw"
    GetFiltroPDF = "draw_pdf_Export"
  Case "smath"
    GetFiltroPDF = "math_pdf_Export"
  Case "simpress"
    GetFiltroPDF = "impress_pdf_Export"
  End Select
 
End Function

Sub FiltrosDisponibles()
'-----------------------------------------------------------------------------------------
  Dim oFiltros As Object, aFiltros() As string, xFiltro As Object
  Dim n As Integer, k As Integer
  Dim lFiltroExp As Boolean
  Dim cExport As String, cImport As String
 
  oFiltros = createUnoService( "com.sun.star.document.FilterFactory" )
  aFiltros = oFiltros.getElementNames()
 
  For n = LBound( aFiltros ) To UBound( aFiltros )
    lFiltroExp = False
    xFiltro = oFiltros.getByName( aFiltros(n) )
    For k = 0 To ubound( xFiltro )
      If xFiltro(k).Name = "Flags" Then
        lFiltroExp = ( xFiltro(k).Value mod 2 = 0 ) 
        Exit For
      End If
    Next
 
    If lFiltroExp Then
      cExport = cExport & aFiltros(n) & Chr(13)
    Else
      cImport = cImport & aFiltros(n) & Chr(13)
    End If
 
  Next
  MsgBox cExport
  MsgBox cImport
End Sub

Function aDocumentosAbiertos()
'-----------------------------------------------------------------------------------------
' devuelve una matriz con el título de todos los documentos abiertos
  Dim aDocs() as String, oDocs as Object, n as integer
  Dim oComponentes as Object
 
  oComponentes = StarDesktop.getComponents()
  oDocs = oComponentes.CreateEnumeration()
 
  Do While oDocs.hasMoreElements()
    oDoc = oDocs.NextElement()
    ReDim Preserve aDocs(n)
    aDocs(n) = oDoc.Title
    n = n + 1
  Loop
 
  aDocumentosAbiertos = aDocs
End Function

Sub Documento_GuardarConPassword( cRutayNombre As String, cClave As String )
'-----------------------------------------------------------------------------------------
' Guarda el documento actual con contraseña (clave, password)
  Dim aArgs(0) As New com.sun.star.beans.PropertyValue, cURL as string
 
  aArgs(0).Name  ="Password"
  aArgs(0).Value = cClave
  cURL = ConvertToURL( cRutayNombre )
  ThisComponent.storeToURL( cURL , aArgs() )
End Sub

Function Ejecutar( ByVal cRutayNombre as String , _
                   Optional ByVal cParametros as String, _
                   Optional nEstiloVentana as integer, _
                   Optional bSync as Boolean) as integer
'-----------------------------------------------------------------------------------------
' Ejecuta un comando y opcionalmente, con parámetros, 
' definiendo estado de la ventana y foco, y sincronismo
' Ejemplo:  cRutayNombre = "C:\Program Files\Mozilla Firefox\firefox.exe"
'           cParametros = "http://open-office.es"
'           nEstiloVentana: una de las siguientes opciones
'                  ventana Oculta Con Foco = 0
'                  ventana Estandar Con Foco = 1
'                  ventana Minimizada Con Foco = 2
'                  ventana Maximizada Con Foco = 3
'                  ventana Estandar Sin Foco = 4
'                  ventana Minimizada Sin Foco = 6
'                  ventana PantallaCompleta con Foco = 10
'           bSync: Falso (por defecto): el shell vuelve inmediatamente.
'                  True: todas las tareas de OO se detienen hasta que vuelva el shell
 
  cRutayNombre = ConvertToURL( cRutayNombre )
  cParametros = ConvertToURL( cParametros )
  If IsMissing( nEstiloVentana ) Then nEstiloVentana = 3
 
  On Local Error Goto Error_Ejecutar
  Shell( cRutayNombre, nEstiloVentana, cParametros, bSync )
  On Local Error Goto 0
  Exit Function
 
Error_Ejecutar:
  Ejecutar = Err
  MsgBox "Error " & Err & ": " & Error & chr(13) & chr(13) & _
         cRutayNombre & " " & cParametros, 16, "Función Ejecutar, línea " & Erl
 
End Function

Public Type NombreValor
  Nombre As String
  Valor As Variant
End Type
 
Public Type PropiedadesDocumento
  Autor As String           ' Autor del documento.  
  Aplicacion As String      ' Aplicación que creó o modificó por última vez el documento
  CreadoFecha As Date       ' Fecha y hora de creación del documento
  Titulo As String          ' Título del documento
  Tema As String            ' Tema del documento  
  Comentarios As String     ' Comentarios (multi-línea) del documento
  PalabrasClave() As String ' Lista de las palabras clave del documento
  Idioma As String          ' Idioma por defecto del documento  
  IdiomaPais As String      ' Idioma-País
  IdiomaVariante As String  ' Idioma-Variante
  ModificadoPor             ' Nombre del usuario que modificó el documento la última vez
  ModificadoFecha           ' Fecha y hora de la última modificación
  ImpresoPor                ' Nombre del usuario que imprimió el documento la última vez
  ImpresoFecha              ' Fecha y hora de la última impresión
  Plantilla                 ' Nombre de la plantilla que creó el documento
  PlantillaURL              ' URL de la plantilla
  PlantillaFecha            ' Fecha y hora de creación o última actualización
                            ' con la plantilla
  AutoloadURL               ' Contains the URL to load automatically at a specified 
                            ' time after the document is loaded into a desktop frame.  
  AutoloadSecs              ' Contains the number of seconds after which a specified 
                            ' URL is to be loaded after the document is loaded
                            ' into a desktop frame.  
  DefaultTarget             ' Contains the name of the default frame into which   
                            ' links should be loaded if no target is specified.  
  EdicionCiclos             ' Describe las veces que el documento ha sido
                            ' guardado o modificado  
  EdicionSegundos           ' Contiene el tiempo total de edición del documento
                            ' en segundos 
  PropiedadesUsuario() As NombreValor ' Matriz con las propiedades de usuario  
  Estadisticas() as NombreValor ' Contiene las estadísticas del documento
End Type
 
Function DocumentoPropiedades() as PropiedadesDocumento
'-----------------------------------------------------------------------------------------
  Dim oPropUsuario as Object
  Dim oPropiedades as Object
  Dim Estadisticas() as NombreValor, PropUsuario() as NombreValor
  Dim aTmp(), n as integer
  Dim dp as PropiedadesDocumento  
 
  oPropiedades = ThisComponent.getDocumentProperties()
 
  With oPropiedades
    aTmp = .DocumentStatistics
    For n = LBound(aTmp) To UBound(aTmp)
      ReDim Preserve Estadisticas(n)
      Estadisticas(n).Nombre = aTmp(n).Name
      Estadisticas(n).Valor = aTmp(n).Value
    Next
 
    n = 0
    For Each oPropUsuario In oPropiedades.UserDefinedProperties.PropertyValues
      With oPropUsuario
        ReDim Preserve PropUsuario(n)
        If IsUnoStruct(.Value)  Then
          PropUsuario(n).Nombre = .Name
          PropUsuario(n).Valor =  .Value.Day & "/" & .Value.Month & "/" & .Value.Year  
        Else
          PropUsuario(n).Nombre = .Name
          PropUsuario(n).Valor =  .Value
        End If
        n = n + 1
      End With
    Next      
 
    dp.Autor = .Author
    dp.Aplicacion = .Generator
    dp.CreadoFecha = DateStruct2String(.CreationDate)
    dp.Titulo = .Title 	
    dp.Tema = .Subject
    dp.Comentarios = .Description
    dp.PalabrasClave() = .KeyWords
    dp.Idioma = .Language.Language
    dp.IdiomaPais = .Language.Country
    dp.IdiomaVariante = .Language.Variant
    dp.ModificadoPor = .ModifiedBy
    dp.ModificadoFecha = .ModificationDate
    dp.ImpresoPor = .PrintedBy
    dp.ImpresoFecha = DateStruct2String(.PrintDate)
    dp.Plantilla = .TemplateName
    dp.PlantillaURL = .TemplateURL
    dp.PlantillaFecha = DateStruct2String(.TemplateDate)
    dp.AutoloadURL = .AutoloadURL 
    dp.AutoloadSecs = .AutoloadSecs
    dp.DefaultTarget = .DefaultTarget
    dp.Estadisticas = Estadisticas()
    dp.EdicionCiclos = .EditingCycles
    dp.EdicionSegundos = .EditingDuration
    dp.PropiedadesUsuario = PropUsuario()    
  End With
 
  GetDocumentoPropiedades = dp
 
End Function
 
Function DateStruct2String(dS) As String
  DateStruct2String() =  dS.Day & "/" & _
     dS.Month & "/" & dS.Year & " " & _
     dS.Hours & ":" & dS.Minutes & ":" & _
     dS.Seconds & "," & dS.HundredthSeconds
End Function

function ListaDocumentosRecientes( optional nLargoLista as integer ) as integer
'-----------------------------------------------------------------------------------------
' Basado en un documento de Ariel Constenla-Haile
Dim sProvider as string, sAccess as string, EsLeer as boolean
Dim oProvider as object, oConfig as object
Dim aAux(2) As New com.sun.star.beans.PropertyValue
 
  EsLeer = IsMissing( nLargoLista )
 
  sProvider = "com.sun.star.configuration.ConfigurationProvider"
  If EsLeer Then
    sAccess = "com.sun.star.configuration.ConfigurationAccess"
  Else
    sAccess = "com.sun.star.configuration.ConfigurationUpdateAccess"
  End If	
 
  aAux(0).Name = "Locale"
  aAux(0).Value = "*"
  aAux(1).Name = "EnableAsync"
  aAux(1).Value = false
  aAux(2).Name = "nodepath"
  aAux(2).Value = "/org.openoffice.Office.Common/History"
 
  oProvider = createUNOService(sProvider)
  oConfig = oProvider.createInstanceWithArguments(sAccess, aAux())
 
  if EsLeer then
    ListaDocumentosRecientes = oConfig.PickListSize
  else
    if nLargoLista < 0  then nLargoLista = 0
    oConfig.PickListSize = nLargoLista
    oConfig.CommitChanges()
  end if
End function

Sub Main
'-----------------------------------------------------------------------------------------
  msgbox "Configurado para " & ListaDocumentosRecientes  & " documentos"
  ListaDocumentosRecientes 15 ' cambia a 15 el número de documentos
  msgbox "Cambiado a " & ListaDocumentosRecientes  & " documentos"
end sub