xref: /trunk/main/wizards/source/importwizard/API.xba (revision 3e02b54d)
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 &quot;advapi32.dll&quot; Alias &quot;RegOpenKeyExA&quot; _
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 &quot;advapi32.dll&quot; Alias &quot;RegQueryValueExA&quot; _
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 &quot;advapi32.dll&quot; Alias &quot;RegQueryValueExA&quot; _
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 &quot;advapi32.dll&quot; Alias &quot;RegQueryValueExA&quot; _
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 &quot;advapi32.dll&quot; Alias &quot;RegCloseKey&quot; _
55 (ByVal hKey As Long) As Long
56
57
58Public Const HKEY_CLASSES_ROOT = &amp;H80000000
59Public Const HKEY_CURRENT_USER = &amp;H80000001
60Public Const HKEY_LOCAL_MACHINE = &amp;H80000002
61Public Const HKEY_USERS = &amp;H80000003
62Public Const KEY_ALL_ACCESS = &amp;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&apos;Public Const KEY_READ = &amp;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&apos;	lRetValue = QueryValue(HKEY_LOCAL_MACHINE, &quot;SOFTWARE\Microsoft\Outlook Express\5.0\Default Settings&quot;, &quot;Revocation Checking&quot;)
86	If hKey &lt;&gt; 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 &apos; Windows
100			    sPath = QueryValue(HKEY_LOCAL_MACHINE, sKeyName(Index), sValueName(Index))
101			Else
102				sPath = &quot;&quot;
103			End If
104			If sPath = &quot;&quot; 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 &apos; Windows
127				&apos; Template directory of Office 97
128				sTemplateKeyName = &quot;Software\Microsoft\Office\8.0\Common\FileNew\LocalTemplates&quot;
129				sTemplateValueName = &quot;&quot;
130				sLocTemplatePath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName)
131
132				If sLocTemplatePath = &quot;&quot; Then
133					&apos; Retrieve the template directory of Office 2000
134					&apos; Unfortunately there is no existing note about the template directory in
135					&apos; the whole registry.
136
137					&apos; Programdirectory of Office 2000
138					sTemplateKeyName = &quot;Software\Microsoft\Office\9.0\Common\InstallRoot&quot;
139					sTemplateValueName = &quot;Path&quot;
140				    sLocProgrampath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName)
141					If sLocProgrampath &lt;&gt; &quot;&quot; Then
142					    If Right(sLocProgrampath, 1) &lt;&gt; &quot;\&quot; Then
143					    	sLocProgrampath = sLocProgrampath &amp; &quot;\&quot;
144			   			End If
145						PathList() = ArrayoutofString(sLocProgrampath,&quot;\&quot;,Maxindex)
146						Progstring = &quot;\&quot; &amp; PathList(Maxindex-1) &amp; &quot;\&quot;
147						OldsLocTemplatePath = DeleteStr(sLocProgramPath,Progstring)
148
149						sLocTemplatePath = OldsLocTemplatePath &amp; &quot;\&quot; &amp; &quot;Templates&quot;
150
151						&apos; Does this subdirectory &quot;templates&quot; exist at all
152            			If oUcb.Exists(sLocTemplatePath) Then
153							&apos; 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				&apos; Helper Application with no templates
167				GetTemplateDefaultPath = SOWorkPath
168			Else
169				GetTemplateDefaultPath = SOTemplatePath
170			End If
171	End Select
172NOVALIDSYSTEMPATH:
173	If Err &lt;&gt; 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&amp;, lType, 0&amp;, cch)
192    If lrc &lt;&gt; ERROR_NONE Then Error 5
193    Select Case lType
194        Case REG_SZ:
195            sValue = String(cch, 0)
196            lrc = RegQueryValueExString(lhKey, szValueName, 0&amp;, 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&amp;, 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         &apos; Returnvalue API-Call
220Dim hKey As Long            &apos; Onen key handle
221Dim vValue As String        &apos; 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