home *** CD-ROM | disk | FTP | other *** search
/ Freelog 125 / Freelog_MarsAvril2015_No125.iso / Bureautique / OpenOffice / Apache_OpenOffice_4.1.1_Win_x86_install_fr.exe / openoffice1.cab / API.xba < prev    next >
Extensible Markup Language  |  2014-02-25  |  8KB  |  229 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <!--***********************************************************
  4.  * 
  5.  * Licensed to the Apache Software Foundation (ASF) under one
  6.  * or more contributor license agreements.  See the NOTICE file
  7.  * distributed with this work for additional information
  8.  * regarding copyright ownership.  The ASF licenses this file
  9.  * to you under the Apache License, Version 2.0 (the
  10.  * "License"); you may not use this file except in compliance
  11.  * with the License.  You may obtain a copy of the License at
  12.  * 
  13.  *   http://www.apache.org/licenses/LICENSE-2.0
  14.  * 
  15.  * Unless required by applicable law or agreed to in writing,
  16.  * software distributed under the License is distributed on an
  17.  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  18.  * KIND, either express or implied.  See the License for the
  19.  * specific language governing permissions and limitations
  20.  * under the License.
  21.  * 
  22.  ***********************************************************-->
  23. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="API" script:language="StarBasic">Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
  24.  (ByVal hKey As Long, _
  25.   ByVal lpSubKey As String, _
  26.   ByVal ulOptions As Long, _
  27.   ByVal samDesired As Long, _
  28.   phkResult As Long) As Long
  29.  
  30. Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
  31.  (ByVal hKey As Long, _
  32.   ByVal lpValueName As String, _
  33.   ByVal lpReserved As Long, _
  34.   lpType As Long, _
  35.   lpData As String, _
  36.   lpcbData As Long) As Long
  37.  
  38. Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
  39.  (ByVal hKey As Long, _
  40.   ByVal lpValueName As String, _
  41.   ByVal lpReserved As Long, _
  42.   lpType As Long, _
  43.   lpData As Long, _
  44.   lpcbData As Long) As Long
  45.  
  46. Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
  47.  (ByVal hKey As Long, _
  48.   ByVal lpValueName As String, _
  49.   ByVal lpReserved As Long, _
  50.   lpType As Long, _
  51.   ByVal lpData As Long, _
  52.   lpcbData As Long) As Long
  53.  
  54. Declare Function RegCloseKeyA Lib "advapi32.dll" Alias "RegCloseKey" _
  55.  (ByVal hKey As Long) As Long
  56.  
  57.  
  58. Public Const HKEY_CLASSES_ROOT = &H80000000
  59. Public Const HKEY_CURRENT_USER = &H80000001
  60. Public Const HKEY_LOCAL_MACHINE = &H80000002
  61. Public Const HKEY_USERS = &H80000003
  62. Public Const KEY_ALL_ACCESS = &H3F
  63. Public Const REG_OPTION_NON_VOLATILE = 0
  64. Public Const REG_SZ As Long = 1
  65. Public Const REG_DWORD As Long = 4
  66. Public Const ERROR_NONE = 0
  67. Public Const ERROR_BADDB = 1
  68. Public Const ERROR_BADKEY = 2
  69. Public Const ERROR_CANTOPEN = 3
  70. Public Const ERROR_CANTREAD = 4
  71. Public Const ERROR_CANTWRITE = 5
  72. Public Const ERROR_OUTOFMEMORY = 6
  73. Public Const ERROR_INVALID_PARAMETER = 7
  74. Public Const ERROR_ACCESS_DENIED = 8
  75. Public Const ERROR_INVALID_PARAMETERS = 87
  76. Public Const ERROR_NO_MORE_ITEMS = 259
  77. 'Public Const KEY_READ = &H20019
  78.  
  79.  
  80. Function OpenRegKey(lBaseKey As Long, sKeyName As String) As Variant
  81. Dim LocKeyValue
  82. Dim hKey as Long
  83. Dim lRetValue as Long
  84.     lRetValue = RegOpenKeyEx(lBaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  85. '    lRetValue = QueryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Outlook Express\5.0\Default Settings", "Revocation Checking")
  86.     If hKey <> 0 Then
  87.         RegCloseKeyA (hKey)
  88.     End If
  89.     OpenRegKey() = lRetValue
  90. End Function
  91.  
  92.  
  93. Function GetDefaultPath(CurOffice as Integer) As String
  94. Dim sPath as String
  95. Dim Index as Integer
  96.     Select Case Wizardmode
  97.         Case SBMICROSOFTMODE
  98.             Index = Applications(CurOffice,SBAPPLKEY)
  99.             If GetGUIType = 1 Then ' Windows
  100.                 sPath = QueryValue(HKEY_LOCAL_MACHINE, sKeyName(Index), sValueName(Index))
  101.             Else
  102.                 sPath = ""
  103.             End If
  104.             If sPath = "" Then
  105.                 sPath = SOWorkPath
  106.             End If
  107.             GetDefaultPath = sPath
  108.         Case SBXMLMODE
  109.             GetDefaultPath = SOWorkPath
  110.     End Select
  111. End Function
  112.  
  113.  
  114. Function GetTemplateDefaultPath(Index as Integer) As String
  115. Dim sLocTemplatePath as String
  116. Dim sLocProgrampath as String
  117. Dim Progstring as String
  118. Dim PathList()as String
  119. Dim Maxindex as Integer
  120. Dim OldsLocTemplatePath
  121. Dim sTemplateKeyName as String
  122. Dim sTemplateValueName as String
  123.     On Local Error Goto NOVAlIDSYSTEMPATH
  124.     Select Case WizardMode
  125.         Case SBMICROSOFTMODE
  126.             If GetGUIType = 1 Then ' Windows
  127.                 ' Template directory of Office 97
  128.                 sTemplateKeyName = "Software\Microsoft\Office\8.0\Common\FileNew\LocalTemplates"
  129.                 sTemplateValueName = ""
  130.                 sLocTemplatePath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName)
  131.  
  132.                 If sLocTemplatePath = "" Then
  133.                     ' Retrieve the template directory of Office 2000
  134.                     ' Unfortunately there is no existing note about the template directory in
  135.                     ' the whole registry.
  136.  
  137.                     ' Programdirectory of Office 2000
  138.                     sTemplateKeyName = "Software\Microsoft\Office\9.0\Common\InstallRoot"
  139.                     sTemplateValueName = "Path"
  140.                     sLocProgrampath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName)
  141.                     If sLocProgrampath <> "" Then
  142.                         If Right(sLocProgrampath, 1) <> "\" Then
  143.                             sLocProgrampath = sLocProgrampath & "\"
  144.                            End If
  145.                         PathList() = ArrayoutofString(sLocProgrampath,"\",Maxindex)
  146.                         Progstring = "\" & PathList(Maxindex-1) & "\"
  147.                         OldsLocTemplatePath = DeleteStr(sLocProgramPath,Progstring)
  148.  
  149.                         sLocTemplatePath = OldsLocTemplatePath & "\" & "Templates"
  150.  
  151.                         ' Does this subdirectory "templates" exist at all
  152.                         If oUcb.Exists(sLocTemplatePath) Then
  153.                             ' If Not the main directory of the office is the base
  154.                             sLocTemplatePath = OldsLocTemplatePath
  155.                         End If
  156.                     Else
  157.                         sLocTemplatePath = SOWorkPath
  158.                     End If
  159.                 End If
  160.                 GetTemplateDefaultPath = ConvertToUrl(sLocTemplatePath)
  161.             Else
  162.                 GetTemplateDefaultPath = SOWorkPath
  163.             End If
  164.         Case SBXMLMODE
  165.             If Index = 3 Then
  166.                 ' Helper Application with no templates
  167.                 GetTemplateDefaultPath = SOWorkPath
  168.             Else
  169.                 GetTemplateDefaultPath = SOTemplatePath
  170.             End If
  171.     End Select
  172. NOVALIDSYSTEMPATH:
  173.     If Err <> 0 Then
  174.         GetTemplateDefaultPath() = SOWorkPath
  175.         Resume ONITGOES
  176.         ONITGOES:
  177.     End If    
  178. End Function
  179.  
  180.  
  181. Function QueryValueEx(ByVal lhKey, ByVal szValueName As String, vValue As String) As Long
  182. Dim cch As Long
  183. Dim lrc As Long
  184. Dim lType As Long
  185. Dim lValue As Long
  186. Dim sValue As String
  187. Dim Empty
  188.  
  189.     On Error GoTo QueryValueExError
  190.  
  191.     lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
  192.     If lrc <> ERROR_NONE Then Error 5
  193.     Select Case lType
  194.         Case REG_SZ:
  195.             sValue = String(cch, 0)
  196.             lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
  197.             If lrc = ERROR_NONE Then
  198.                 vValue = Left$(sValue, cch)
  199.             Else
  200.                 vValue = Empty
  201.             End If
  202.         Case REG_DWORD:
  203.             lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
  204.             If lrc = ERROR_NONE Then
  205.                 vValue = lValue
  206.             End If
  207.         Case Else
  208.             lrc = -1
  209.     End Select
  210. QueryValueExExit:
  211.     QueryValueEx = lrc
  212.     Exit Function
  213. QueryValueExError:
  214.     Resume QueryValueExExit
  215. End Function
  216.  
  217.  
  218. Function QueryValue(BaseKey As Long, sKeyName As String, sValueName As String) As Variant
  219. Dim lRetVal As Long         ' Returnvalue API-Call
  220. Dim hKey As Long            ' Onen key handle
  221. Dim vValue As String        ' Key value
  222.  
  223.     lRetVal = RegOpenKeyEx(BaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  224.     lRetVal = QueryValueEx(hKey, sValueName, vValue)
  225.     RegCloseKeyA (hKey)
  226.     QueryValue = vValue
  227. End Function
  228. </script:module>
  229.