summaryrefslogtreecommitdiff
path: root/migrationanalysis/src/wizard/Utilities.bas
blob: 8db22755a55bd3dcd84f65ee8aab4a38f83fa608 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
Attribute VB_Name = "Utilities"
'/*************************************************************************
' *
' * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
' * 
' * Copyright 2008 by Sun Microsystems, Inc.
' *
' * OpenOffice.org - a multi-platform office productivity suite
' *
' * $RCSfile: Utilities.bas,v $
' * $Revision: 1.11.66.1 $
' *
' * 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