wizards/source/importwizard/API.xba

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