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