diff options
Diffstat (limited to 'wizards/source/importwizard/API.xba')
| -rw-r--r-- | wizards/source/importwizard/API.xba | 208 |
1 files changed, 0 insertions, 208 deletions
diff --git a/wizards/source/importwizard/API.xba b/wizards/source/importwizard/API.xba deleted file mode 100644 index d38ba68d8..000000000 --- a/wizards/source/importwizard/API.xba +++ /dev/null @@ -1,208 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> -<script:module xmlns:script="http://openoffice.org/2000/script" script:name="API" script:language="StarBasic">Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _ - (ByVal hKey As Long, _ - ByVal lpSubKey As String, _ - ByVal ulOptions As Long, _ - ByVal samDesired As Long, _ - phkResult As Long) As Long - -Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _ - (ByVal hKey As Long, _ - ByVal lpValueName As String, _ - ByVal lpReserved As Long, _ - lpType As Long, _ - lpData As String, _ - lpcbData As Long) As Long - -Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _ - (ByVal hKey As Long, _ - ByVal lpValueName As String, _ - ByVal lpReserved As Long, _ - lpType As Long, _ - lpData As Long, _ - lpcbData As Long) As Long - -Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _ - (ByVal hKey As Long, _ - ByVal lpValueName As String, _ - ByVal lpReserved As Long, _ - lpType As Long, _ - ByVal lpData As Long, _ - lpcbData As Long) As Long - -Declare Function RegCloseKeyA Lib "advapi32.dll" Alias "RegCloseKey" _ - (ByVal hKey As Long) As Long - - -Public Const HKEY_CLASSES_ROOT = &H80000000 -Public Const HKEY_CURRENT_USER = &H80000001 -Public Const HKEY_LOCAL_MACHINE = &H80000002 -Public Const HKEY_USERS = &H80000003 -Public Const KEY_ALL_ACCESS = &H3F -Public Const REG_OPTION_NON_VOLATILE = 0 -Public Const REG_SZ As Long = 1 -Public Const REG_DWORD As Long = 4 -Public Const ERROR_NONE = 0 -Public Const ERROR_BADDB = 1 -Public Const ERROR_BADKEY = 2 -Public Const ERROR_CANTOPEN = 3 -Public Const ERROR_CANTREAD = 4 -Public Const ERROR_CANTWRITE = 5 -Public Const ERROR_OUTOFMEMORY = 6 -Public Const ERROR_INVALID_PARAMETER = 7 -Public Const ERROR_ACCESS_DENIED = 8 -Public Const ERROR_INVALID_PARAMETERS = 87 -Public Const ERROR_NO_MORE_ITEMS = 259 -'Public Const KEY_READ = &H20019 - - -Function OpenRegKey(lBaseKey As Long, sKeyName As String) As Variant -Dim LocKeyValue -Dim hKey as Long -Dim lRetValue as Long - lRetValue = RegOpenKeyEx(lBaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) -' lRetValue = QueryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Outlook Express\5.0\Default Settings", "Revocation Checking") - If hKey <> 0 Then - RegCloseKeyA (hKey) - End If - OpenRegKey() = lRetValue -End Function - - -Function GetDefaultPath(CurOffice as Integer) As String -Dim sPath as String -Dim Index as Integer - Select Case Wizardmode - Case SBMICROSOFTMODE - Index = Applications(CurOffice,SBAPPLKEY) - If GetGUIType = 1 Then ' Windows - sPath = QueryValue(HKEY_LOCAL_MACHINE, sKeyName(Index), sValueName(Index)) - Else - sPath = "" - End If - If sPath = "" Then - sPath = SOWorkPath - End If - GetDefaultPath = sPath - Case SBXMLMODE - GetDefaultPath = SOWorkPath - End Select -End Function - - -Function GetTemplateDefaultPath(Index as Integer) As String -Dim sLocTemplatePath as String -Dim sLocProgrampath as String -Dim Progstring as String -Dim PathList()as String -Dim Maxindex as Integer -Dim OldsLocTemplatePath -Dim sTemplateKeyName as String -Dim sTemplateValueName as String - On Local Error Goto NOVAlIDSYSTEMPATH - Select Case WizardMode - Case SBMICROSOFTMODE - If GetGUIType = 1 Then ' Windows - ' Template directory of Office 97 - sTemplateKeyName = "Software\Microsoft\Office\8.0\Common\FileNew\LocalTemplates" - sTemplateValueName = "" - sLocTemplatePath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName) - - If sLocTemplatePath = "" Then - ' Retrieve the template directory of Office 2000 - ' Unfortunately there is no existing note about the template directory in - ' the whole registry. - - ' Programdirectory of Office 2000 - sTemplateKeyName = "Software\Microsoft\Office\9.0\Common\InstallRoot" - sTemplateValueName = "Path" - sLocProgrampath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName) - If sLocProgrampath <> "" Then - If Right(sLocProgrampath, 1) <> "\" Then - sLocProgrampath = sLocProgrampath & "\" - End If - PathList() = ArrayoutofString(sLocProgrampath,"\",Maxindex) - Progstring = "\" & PathList(Maxindex-1) & "\" - OldsLocTemplatePath = DeleteStr(sLocProgramPath,Progstring) - - sLocTemplatePath = OldsLocTemplatePath & "\" & "Templates" - - ' Does this subdirectory "templates" exist at all - If oUcb.Exists(sLocTemplatePath) Then - ' If Not the main directory of the office is the base - sLocTemplatePath = OldsLocTemplatePath - End If - Else - sLocTemplatePath = SOWorkPath - End If - End If - GetTemplateDefaultPath = ConvertToUrl(sLocTemplatePath) - Else - GetTemplateDefaultPath = SOWorkPath - End If - Case SBXMLMODE - If Index = 3 Then - ' Helper Application with no templates - GetTemplateDefaultPath = SOWorkPath - Else - GetTemplateDefaultPath = SOTemplatePath - End If - End Select -NOVALIDSYSTEMPATH: - If Err <> 0 Then - GetTemplateDefaultPath() = SOWorkPath - Resume ONITGOES - ONITGOES: - End If -End Function - - -Function QueryValueEx(ByVal lhKey, ByVal szValueName As String, vValue As String) As Long -Dim cch As Long -Dim lrc As Long -Dim lType As Long -Dim lValue As Long -Dim sValue As String -Dim Empty - - On Error GoTo QueryValueExError - - lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) - If lrc <> ERROR_NONE Then Error 5 - Select Case lType - Case REG_SZ: - sValue = String(cch, 0) - lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch) - If lrc = ERROR_NONE Then - vValue = Left$(sValue, cch) - Else - vValue = Empty - End If - Case REG_DWORD: - lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch) - If lrc = ERROR_NONE Then - vValue = lValue - End If - Case Else - lrc = -1 - End Select -QueryValueExExit: - QueryValueEx = lrc - Exit Function -QueryValueExError: - Resume QueryValueExExit -End Function - - -Function QueryValue(BaseKey As Long, sKeyName As String, sValueName As String) As Variant -Dim lRetVal As Long ' Returnvalue API-Call -Dim hKey As Long ' Onen key handle -Dim vValue As String ' Key value - - lRetVal = RegOpenKeyEx(BaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) - lRetVal = QueryValueEx(hKey, sValueName, vValue) - RegCloseKeyA (hKey) - QueryValue = vValue -End Function -</script:module>
\ No newline at end of file |