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 30Declare 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 38Declare 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 46Declare 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 54Declare Function RegCloseKeyA Lib "advapi32.dll" Alias "RegCloseKey" _ 55 (ByVal hKey As Long) As Long 56 57 58Public Const HKEY_CLASSES_ROOT = &H80000000 59Public Const HKEY_CURRENT_USER = &H80000001 60Public Const HKEY_LOCAL_MACHINE = &H80000002 61Public Const HKEY_USERS = &H80000003 62Public Const KEY_ALL_ACCESS = &H3F 63Public Const REG_OPTION_NON_VOLATILE = 0 64Public Const REG_SZ As Long = 1 65Public Const REG_DWORD As Long = 4 66Public Const ERROR_NONE = 0 67Public Const ERROR_BADDB = 1 68Public Const ERROR_BADKEY = 2 69Public Const ERROR_CANTOPEN = 3 70Public Const ERROR_CANTREAD = 4 71Public Const ERROR_CANTWRITE = 5 72Public Const ERROR_OUTOFMEMORY = 6 73Public Const ERROR_INVALID_PARAMETER = 7 74Public Const ERROR_ACCESS_DENIED = 8 75Public Const ERROR_INVALID_PARAMETERS = 87 76Public Const ERROR_NO_MORE_ITEMS = 259 77'Public Const KEY_READ = &H20019 78 79 80Function OpenRegKey(lBaseKey As Long, sKeyName As String) As Variant 81Dim LocKeyValue 82Dim hKey as Long 83Dim 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 90End Function 91 92 93Function GetDefaultPath(CurOffice as Integer) As String 94Dim sPath as String 95Dim 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 111End Function 112 113 114Function GetTemplateDefaultPath(Index as Integer) As String 115Dim sLocTemplatePath as String 116Dim sLocProgrampath as String 117Dim Progstring as String 118Dim PathList()as String 119Dim Maxindex as Integer 120Dim OldsLocTemplatePath 121Dim sTemplateKeyName as String 122Dim 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 172NOVALIDSYSTEMPATH: 173 If Err <> 0 Then 174 GetTemplateDefaultPath() = SOWorkPath 175 Resume ONITGOES 176 ONITGOES: 177 End If 178End Function 179 180 181Function QueryValueEx(ByVal lhKey, ByVal szValueName As String, vValue As String) As Long 182Dim cch As Long 183Dim lrc As Long 184Dim lType As Long 185Dim lValue As Long 186Dim sValue As String 187Dim 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 210QueryValueExExit: 211 QueryValueEx = lrc 212 Exit Function 213QueryValueExError: 214 Resume QueryValueExExit 215End Function 216 217 218Function QueryValue(BaseKey As Long, sKeyName As String, sValueName As String) As Variant 219Dim lRetVal As Long ' Returnvalue API-Call 220Dim hKey As Long ' Onen key handle 221Dim 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 227End Function 228</script:module> 229