diff options
Diffstat (limited to 'migrationanalysis/src/wizard/Utilities.bas')
| -rw-r--r-- | migrationanalysis/src/wizard/Utilities.bas | 552 |
1 files changed, 552 insertions, 0 deletions
diff --git a/migrationanalysis/src/wizard/Utilities.bas b/migrationanalysis/src/wizard/Utilities.bas new file mode 100644 index 000000000000..163435563c33 --- /dev/null +++ b/migrationanalysis/src/wizard/Utilities.bas @@ -0,0 +1,552 @@ +Attribute VB_Name = "Utilities"
+'/*************************************************************************
+' *
+' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +' +' Copyright 2000, 2010 Oracle and/or its affiliates. +' +' OpenOffice.org - a multi-platform office productivity suite +' +' This file is part of OpenOffice.org. +' +' OpenOffice.org is free software: you can redistribute it and/or modify +' it under the terms of the GNU Lesser General Public License version 3 +' only, as published by the Free Software Foundation. +' +' OpenOffice.org is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU Lesser General Public License version 3 for more details +' (a copy is included in the LICENSE file that accompanied this code). +' +' You should have received a copy of the GNU Lesser General Public License +' version 3 along with OpenOffice.org. If not, see +' <http://www.openoffice.org/license.html> +' for a copy of the LGPLv3 License. +' +' ************************************************************************/
+Option Explicit
+
+Public Const LOCALE_ILANGUAGE As Long = &H1 'language id
+Public Const LOCALE_SLANGUAGE As Long = &H2 'localized name of lang
+Public Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of lang
+Public Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated lang name
+Public Const LOCALE_SNATIVELANGNAME As Long = &H4 'native name of lang
+Public Const LOCALE_ICOUNTRY As Long = &H5 'country code
+Public Const LOCALE_SCOUNTRY As Long = &H6 'localized name of country
+Public Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country
+Public Const LOCALE_SABBREVCTRYNAME As Long = &H7 'abbreviated country name
+Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 'native name of country
+Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl monetary symbol
+Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9 'def language id
+Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA 'def country code
+Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB 'def oem code page
+Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004 'def ansi code page
+Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011 'def mac code page
+
+Public Const LOCALE_IMEASURE As Long = &HD '0 = metric, 1 = US
+Public Const LOCALE_SSHORTDATE As Long = &H1F 'short date format string
+
+'#if(WINVER >= &H0400)
+Public Const LOCALE_SISO639LANGNAME As Long = &H59 'ISO abbreviated language name
+Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'ISO abbreviated country name
+'#endif /* WINVER >= as long = &H0400 */
+
+'#if(WINVER >= &H0500)
+Public Const LOCALE_SNATIVECURRNAME As Long = &H1008 'native name of currency
+Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012 'default ebcdic code page
+Public Const LOCALE_SSORTNAME As Long = &H1013 'sort name
+'#endif /* WINVER >= &H0500 */
+
+Public Const CSTR_LOG_FILE_NAME = "analysis.log"
+
+Public Declare Function GetThreadLocale Lib "kernel32" () As Long
+
+Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
+Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
+Public Declare Function GetUserDefaultLangID Lib "kernel32" () As Long
+Public Declare Function GetSystemDefaultLangID Lib "kernel32" () As Long
+
+Public Declare Function GetLocaleInfo Lib "kernel32" _
+ Alias "GetLocaleInfoA" _
+ (ByVal Locale As Long, _
+ ByVal LCType As Long, _
+ ByVal lpLCData As String, _
+ ByVal cchData As Long) As Long
+
+Private Const VER_PLATFORM_WIN32s = 0
+Private Const VER_PLATFORM_WIN32_WINDOWS = 1
+Private Const VER_PLATFORM_WIN32_NT = 2
+
+Private Type OSVERSIONINFO
+ OSVSize As Long 'size, in bytes, of this data structure
+ dwVerMajor As Long 'ie NT 3.51, dwVerMajor = 3; NT 4.0, dwVerMajor = 4.
+ dwVerMinor As Long 'ie NT 3.51, dwVerMinor = 51; NT 4.0, dwVerMinor= 0.
+ dwBuildNumber As Long 'NT: build number of the OS
+ 'Win9x: build number of the OS in low-order word.
+ ' High-order word contains major & minor ver nos.
+ PlatformID As Long 'Identifies the operating system platform.
+ szCSDVersion As String * 128 'NT: string, such as "Service Pack 3"
+ 'Win9x: string providing arbitrary additional information
+End Type
+
+Public Type RGB_WINVER
+ PlatformID As Long
+ VersionName As String
+ VersionNo As String
+ ServicePack As String
+ BuildNo As String
+End Type
+
+'defined As Any to support OSVERSIONINFO and OSVERSIONINFOEX
+Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
+ (lpVersionInformation As Any) As Long
+
+Private Declare Function GetDesktopWindow Lib "user32" () As Long
+
+Private Declare Function ShellExecute Lib "shell32" _
+ Alias "ShellExecuteA" _
+ (ByVal hWnd As Long, _
+ ByVal lpOperation As String, _
+ ByVal lpFile As String, _
+ ByVal lpParameters As String, _
+ ByVal lpDirectory As String, _
+ ByVal nShowCmd As Long) As Long
+
+Public Const SW_SHOWNORMAL As Long = 1
+Public Const SW_SHOWMAXIMIZED As Long = 3
+Public Const SW_SHOWDEFAULT As Long = 10
+Public Const SE_ERR_NOASSOC As Long = 31
+
+Public Const CNO_OPTIONAL_PARAM = "_NoOptionalParam_"
+Private Declare Function WritePrivateProfileString Lib "kernel32" _
+ Alias "WritePrivateProfileStringA" _
+ (ByVal lpSectionName As String, _
+ ByVal lpKeyName As Any, _
+ ByVal lpString As Any, _
+ ByVal lpFileName As String) As Long
+
+
+Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
+Public Const HKEY_CLASSES_ROOT = &H80000000
+Private Const ERROR_MORE_DATA = 234
+Private Const ERROR_SUCCESS As Long = 0
+Private Const KEY_QUERY_VALUE As Long = &H1
+Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
+Private Const KEY_NOTIFY As Long = &H10
+Private Const STANDARD_RIGHTS_READ As Long = &H20000
+Private Const SYNCHRONIZE As Long = &H100000
+Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
+ KEY_QUERY_VALUE Or _
+ KEY_ENUMERATE_SUB_KEYS Or _
+ KEY_NOTIFY) And _
+ (Not SYNCHRONIZE))
+
+Private 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
+
+Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
+ Alias "RegQueryValueExA" _
+ (ByVal hKey As Long, _
+ ByVal lpValueName As String, _
+ ByVal lpReserved As Long, _
+ lpType As Long, _
+ lpData As Any, _
+ lpcbData As Long) As Long
+
+Private Declare Function RegCloseKey Lib "advapi32.dll" _
+ (ByVal hKey As Long) As Long
+
+Private Declare Function lstrlenW Lib "kernel32" _
+ (ByVal lpString As Long) As Long
+
+Private Type ShortItemId
+ cb As Long
+ abID As Byte
+End Type
+
+Private Type ITEMIDLIST
+ mkid As ShortItemId
+End Type
+
+Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
+ (ByVal pidl As Long, ByVal pszPath As String) As Long
+
+Private Declare Function SHGetSpecialFolderLocation Lib _
+ "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder _
+ As Long, pidl As ITEMIDLIST) As Long
+
+
+Public Function IsWin98Plus() As Boolean
+ 'returns True if running Windows 2000 or later
+ Dim osv As OSVERSIONINFO
+
+ osv.OSVSize = Len(osv)
+
+ If GetVersionEx(osv) = 1 Then
+
+ Select Case osv.PlatformID 'win 32
+ Case VER_PLATFORM_WIN32s:
+ IsWin98Plus = False
+ Exit Function
+ Case VER_PLATFORM_WIN32_NT: 'win nt, 2000, xp
+ IsWin98Plus = True
+ Exit Function
+ Case VER_PLATFORM_WIN32_WINDOWS:
+ Select Case osv.dwVerMinor
+ Case 0: 'win95
+ IsWin98Plus = False
+ Exit Function
+ Case 90: 'Windows ME
+ IsWin98Plus = True
+ Exit Function
+ Case 10: ' Windows 98
+ If osv.dwBuildNumber >= 2222 Then 'second edition
+ IsWin98Plus = True
+ Exit Function
+ Else
+ IsWin98Plus = False
+ Exit Function
+ End If
+ End Select
+ Case Else
+ IsWin98Plus = False
+ Exit Function
+ End Select
+
+ End If
+
+End Function
+
+Public Function GetWinVersion(WIN As RGB_WINVER) As String
+
+'returns a structure (RGB_WINVER)
+'filled with OS information
+
+ #If Win32 Then
+
+ Dim osv As OSVERSIONINFO
+ Dim pos As Integer
+ Dim sVer As String
+ Dim sBuild As String
+
+ osv.OSVSize = Len(osv)
+
+ If GetVersionEx(osv) = 1 Then
+
+ 'PlatformId contains a value representing the OS
+ WIN.PlatformID = osv.PlatformID
+
+ Select Case osv.PlatformID
+ Case VER_PLATFORM_WIN32s: WIN.VersionName = "Win32s"
+ Case VER_PLATFORM_WIN32_NT: WIN.VersionName = "Windows NT"
+
+ Select Case osv.dwVerMajor
+ Case 4: WIN.VersionName = "Windows NT"
+ Case 5:
+ Select Case osv.dwVerMinor
+ Case 0: WIN.VersionName = "Windows 2000"
+ Case 1: WIN.VersionName = "Windows XP"
+ End Select
+ End Select
+
+ Case VER_PLATFORM_WIN32_WINDOWS:
+
+ 'The dwVerMinor bit tells if its 95 or 98.
+ Select Case osv.dwVerMinor
+ Case 0: WIN.VersionName = "Windows 95"
+ Case 90: WIN.VersionName = "Windows ME"
+ Case Else: WIN.VersionName = "Windows 98"
+ End Select
+
+ End Select
+
+
+ 'Get the version number
+ WIN.VersionNo = osv.dwVerMajor & "." & osv.dwVerMinor
+
+ 'Get the build
+ WIN.BuildNo = (osv.dwBuildNumber And &HFFFF&)
+
+ 'Any additional info. In Win9x, this can be
+ '"any arbitrary string" provided by the
+ 'manufacturer. In NT, this is the service pack.
+ pos = InStr(osv.szCSDVersion, Chr$(0))
+ If pos Then
+ WIN.ServicePack = Left$(osv.szCSDVersion, pos - 1)
+ End If
+
+ End If
+
+ #Else
+
+ 'can only return that this does not
+ 'support the 32 bit call, so must be Win3x
+ WIN.VersionName = "Windows 3.x"
+ #End If
+ GetWinVersion = WIN.VersionName
+
+End Function
+
+Public Sub RunShellExecute(sTopic As String, _
+ sFile As Variant, _
+ sParams As Variant, _
+ sDirectory As Variant, _
+ nShowCmd As Long)
+
+ Dim hWndDesk As Long
+ Dim success As Long
+
+ 'the desktop will be the
+ 'default for error messages
+ hWndDesk = GetDesktopWindow()
+
+ 'execute the passed operation
+ success = ShellExecute(hWndDesk, sTopic, sFile, sParams, sDirectory, nShowCmd)
+
+ 'This is optional. Uncomment the three lines
+ 'below to have the "Open With.." dialog appear
+ 'when the ShellExecute API call fails
+ If success = SE_ERR_NOASSOC Then
+ Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & sFile, vbNormalFocus)
+ End If
+
+End Sub
+
+Public Sub WriteToLog(key As String, value As String, _
+ Optional path As String = CNO_OPTIONAL_PARAM, _
+ Optional section As String = WIZARD_NAME)
+
+ Static logFile As String
+
+ If logFile = "" Then
+ logFile = GetLogFilePath
+ End If
+
+ If path = "" Then
+ Exit Sub
+ End If
+
+ If path = CNO_OPTIONAL_PARAM Then
+ path = logFile
+ End If
+ Call WritePrivateProfileString(section, key, value, path)
+End Sub
+
+Public Sub WriteDebug(value As String)
+ Static ErrCount As Long
+ Static logFile As String
+ Static debugLevel As Long
+
+ If logFile = "" Then
+ logFile = GetLogFilePath
+ End If
+
+ Dim sSection As String
+ sSection = WIZARD_NAME & "Debug"
+
+ Call WritePrivateProfileString(sSection, "Analysis" & "_debug" & ErrCount, _
+ value, logFile)
+ ErrCount = ErrCount + 1
+End Sub
+
+Public Function GetDebug(section As String, key As String) As String
+ Static logFile As String
+
+ If logFile = "" Then
+ logFile = GetLogFilePath
+ End If
+
+ GetDebug = ProfileGetItem(section, key, "", logFile)
+End Function
+
+Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String
+
+ Dim sReturn As String
+ Dim r As Long
+
+ 'call the function passing the Locale type
+ 'variable to retrieve the required size of
+ 'the string buffer needed
+ r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
+
+ 'if successful..
+ If r Then
+
+ 'pad the buffer with spaces
+ sReturn = Space$(r)
+
+ 'and call again passing the buffer
+ r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
+
+ 'if successful (r > 0)
+ If r Then
+
+ 'r holds the size of the string
+ 'including the terminating null
+ GetUserLocaleInfo = Left$(sReturn, r - 1)
+
+ End If
+
+ End If
+
+End Function
+
+Public Function GetRegistryInfo(sHive As String, sSubKey As String, sKey As String) As String
+ GetRegistryInfo = ""
+ Dim hKey As Long
+
+ hKey = OpenRegKey(sHive, sSubKey)
+
+ If hKey <> 0 Then
+ GetRegistryInfo = GetRegValue(hKey, sKey)
+
+ 'the opened key must be closed
+ Call RegCloseKey(hKey)
+ End If
+End Function
+
+
+Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String
+
+ Dim lpValue As String 'value retrieved
+ Dim lpcbData As Long 'length of retrieved string
+
+ 'if valid
+ If hSubKey <> 0 Then
+
+ 'Pass an zero-length string to
+ 'obtain the required buffer size
+ 'required to return the result.
+ 'If the key passed exists, the call
+ 'will return error 234 (more data)
+ 'and lpcbData will indicate the
+ 'required buffer size (including
+ 'the terminating null).
+ lpValue = ""
+ lpcbData = 0
+ If RegQueryValueEx(hSubKey, _
+ sKeyName, _
+ 0&, _
+ 0&, _
+ ByVal lpValue, _
+ lpcbData) = ERROR_MORE_DATA Then
+
+ lpValue = Space$(lpcbData)
+
+ 'retrieve the desired value
+ If RegQueryValueEx(hSubKey, _
+ sKeyName, _
+ 0&, _
+ 0&, _
+ ByVal lpValue, _
+ lpcbData) = ERROR_SUCCESS Then
+
+ GetRegValue = TrimNull(lpValue)
+
+ End If 'If RegQueryValueEx (second call)
+ End If 'If RegQueryValueEx (first call)
+ End If 'If hSubKey
+
+End Function
+
+Private Function OpenRegKey(ByVal hKey As Long, _
+ ByVal lpSubKey As String) As Long
+ Dim hSubKey As Long
+ Dim retval As Long
+
+ retval = RegOpenKeyEx(hKey, lpSubKey, _
+ 0, KEY_READ, hSubKey)
+
+ If retval = ERROR_SUCCESS Then
+ OpenRegKey = hSubKey
+ End If
+End Function
+
+
+Private Function TrimNull(startstr As String) As String
+
+ TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
+
+End Function
+
+Function GetLogFilePath() As String
+
+ Dim fso As New FileSystemObject
+ Dim TempPath As String
+
+ TempPath = fso.GetSpecialFolder(TemporaryFolder).path
+
+ If (TempPath = "") Then
+ TempPath = "."
+ End If
+
+ GetLogFilePath = fso.GetAbsolutePathName(TempPath & "\" & CSTR_LOG_FILE_NAME)
+End Function
+
+Function GetIniFilePath() As String
+
+ Dim fso As New FileSystemObject
+ Dim AppDataDir As String
+
+ AppDataDir = GetAppDataFolder
+ If (AppDataDir = "") Then
+ AppDataDir = CBASE_RESOURCE_DIR
+ Else
+ If Not fso.FolderExists(AppDataDir) Then
+ fso.CreateFolder (AppDataDir)
+ End If
+ AppDataDir = AppDataDir & "\Sun"
+ If Not fso.FolderExists(AppDataDir) Then
+ fso.CreateFolder (AppDataDir)
+ End If
+ AppDataDir = AppDataDir & "\AnalysisWizard"
+ If Not fso.FolderExists(AppDataDir) Then
+ fso.CreateFolder (AppDataDir)
+ End If
+ End If
+
+ GetIniFilePath = fso.GetAbsolutePathName(AppDataDir & "\" & CANALYSIS_INI_FILE)
+End Function
+
+' This function returns the Application Data Folder Path
+Function GetAppDataFolder() As String
+ Dim idlstr As Long
+ Dim sPath As String
+ Dim IDL As ITEMIDLIST
+ Const NOERROR = 0
+ Const MAX_LENGTH = 260
+ Const CSIDL_APPDATA = &H1A
+
+ On Error GoTo Err_GetFolder
+
+ ' Fill the idl structure with the specified folder item.
+ idlstr = SHGetSpecialFolderLocation(0, CSIDL_APPDATA, IDL)
+
+ If idlstr = NOERROR Then
+ ' Get the path from the idl list, and return
+ ' the folder with a slash at the end.
+ sPath = Space$(MAX_LENGTH)
+ idlstr = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
+ If idlstr Then
+ GetAppDataFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
+ End If
+ End If
+
+Exit_GetFolder:
+ Exit Function
+
+Err_GetFolder:
+ MsgBox "An Error was Encountered" & Chr(13) & Err.Description, _
+ vbCritical Or vbOKOnly
+ Resume Exit_GetFolder
+
+End Function
+
+
+
|