migrationanalysis/src/wizard/Wizard.bas

   1 Attribute VB_Name = "modWizard"
   2 '/*************************************************************************
   3 ' *
   4 ' * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   5 ' *
   6 ' * Copyright 2008 by Sun Microsystems, Inc.
   7 ' *
   8 ' * OpenOffice.org - a multi-platform office productivity suite
   9 ' *
  10 ' * $RCSfile: Wizard.bas,v $
  11 ' * $Revision: 1.28.66.2 $
  12 ' *
  13 ' * This file is part of OpenOffice.org.
  14 ' *
  15 ' * OpenOffice.org is free software: you can redistribute it and/or modify
  16 ' * it under the terms of the GNU Lesser General Public License version 3
  17 ' * only, as published by the Free Software Foundation.
  18 ' *
  19 ' * OpenOffice.org is distributed in the hope that it will be useful,
  20 ' * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ' * GNU Lesser General Public License version 3 for more details
  23 ' * (a copy is included in the LICENSE file that accompanied this code).
  24 ' *
  25 ' * You should have received a copy of the GNU Lesser General Public License
  26 ' * version 3 along with OpenOffice.org.  If not, see
  27 ' * <http://www.openoffice.org/license.html>
  28 ' * for a copy of the LGPLv3 License.
  29 ' *
  30 ' ************************************************************************/
  31 Option Explicit
  32
  33 Global Const WIZARD_NAME = "Analysis"
  34
  35 'Implementation details - not required for localisation
  36 Public Const CWORD_DRIVER_FILE = "_OOoDocAnalysisWordDriver.doc"
  37 Public Const CEXCEL_DRIVER_FILE = "_OOoDocAnalysisExcelDriver.xls"
  38 Public Const CPP_DRIVER_FILE = "_OOoDocAnalysisPPTDriver.ppt"
  39 Public Const CRESULTS_TEMPLATE_FILE = "results.xlt"
  40 Public Const CISSUES_LIST_FILE = "issues.list"
  41 Public Const CANALYSIS_INI_FILE = "analysis.ini"
  42 Public Const CLAUNCH_DRIVERS_EXE = "LaunchDrivers.exe"
  43 Public Const CMSO_KILL_EXE = "msokill.exe"
  44 Public Const CRESOURCE_DLL = "Resources.dll"
  45
  46 ' Preparation String ID's from DocAnalysisWizard.rc
  47 Public Const RID_STR_ENG_TITLE_PREP_ID = 1030
  48 Public Const RID_STR_ENG_SIDEBAR_ANALYZE_PREP_ID = 1074
  49
  50 Public Const RID_STR_ENG_INTRODUCTION_INTRO1_PREP_ID = 1131
  51 Public Const RID_STR_ENG_INTRODUCTION_INTRO2_PREP_ID = 1132
  52 Public Const RID_STR_ENG_INTRODUCTION_INTRO3_PREP_ID = 1134
  53
  54 Public Const RID_STR_ENG_DOCUMENTS_CHOOSE_DOCUMENTS_PREP_ID = 1230
  55 Public Const RID_STR_ENG_DOCUMENTS_CHOOSE_DOC_TYPES_PREP_ID = 1236
  56 Public Const RID_STR_ENG_DOCUMENTS_INCLUDE_SUBDIRECTORIES_PREP_ID = 1232
  57
  58 Public Const RID_STR_IGNORE_OLDER_CB_ID = 1231
  59 Public Const RID_STR_IGNORE_OLDER_3_MONTHS_ID = 1233
  60 Public Const RID_STR_IGNORE_OLDER_6_MONTHS_ID = 1234
  61 Public Const RID_STR_IGNORE_OLDER_12_MONTHS_ID = 1235
  62
  63 Public Const RID_STR_ENG_RESULTS_CHOOSE_OPTIONS_PREP_ID = 1330
  64 Public Const RID_STR_ENG_RESULTS_ANALYSIS_XLS_PREP_ID = 1332
  65
  66 Public Const RID_STR_ENG_ANALYZE_NUM_DOCS_PREP_ID = 1431
  67 Public Const RID_STR_ENG_ANALYZE_SETUP_COMPLETE_PREP_ID = 1430
  68 Public Const RID_STR_ENG_ANALYZE_IGNORED_DOCS_ID = 1435
  69 Public Const RID_STR_ENG_ANALYZE_START_ID = 1413
  70 Public Const RID_STR_ENG_ANALYZE_COMPLETED_ID = 1412
  71 Public Const RID_STR_ENG_ANALYZE_VIEW_NOW_ID = 1414
  72 Public Const RID_STR_ENG_ANALYZE_VIEW_LATER_ID = 1415
  73 Public Const RID_STR_ENG_ANALYSE_NOT_RUN = 1416
  74
  75 Public Const RID_STR_ENG_OTHER_PLEASE_REFER_TO_README_PREP_ID = 1838
  76 Public Const RID_STR_ENG_OTHER_XML_RESULTS_PREP_ID = 1845
  77 Public Const RID_STR_ENG_OTHER_PREPARE_PROMPT_PREP_ID = 1846
  78 Public Const RID_STR_ENG_OTHER_PREPARE_COMPLETED_PREP_ID = 1847
  79
  80 'Resource Strings Codes
  81 ' NOTE: to make a resource the default it must be the first string table inserted
  82 ' in the resource table - if it is not, just create several new string tables and
  83 ' copy what you want as default into the first new one you create, copy the others
  84 ' then delete the originals.
  85 '
  86 ' To provide same string table for all English variants or all German variants
  87 ' I have added code to set LANG_BASE_ID dependent on current locale
  88 ' Refer to p.414 VBA in a Nutshell, Lomax
  89 ' I now have a single string table with each lang variant suitably offset:
  90 ' New locale - increase ofsets by 1000 - refer to DocAnalysisWizard.rc
  91 '
  92 '  English - eng - Start at 1000
  93 '  German - ger - Start at 2000
  94 '  BrazilianPortugese - por - Start at 4000
  95 '  French - fre - Start at 5000
  96 '  Italian - ita - Start at 6000
  97 '  Spanish - spa - Start at 7000
  98 '  Swedish - swe - Start at 8000
  99
 100
 101 ' String ID's must match those in DocAnalysisWizard.rc
 102 Const LANG_BASE_ID = 1000
 103 Const INTERNAL_RESOURCE_BASE_ID = LANG_BASE_ID + 800
 104
 105 ' Setup Doc Preparation specific strings
 106 #If PREPARATION Then
 107 Global Const gBoolPreparation = True
 108
 109 Public Const TITLE_ID = RID_STR_ENG_TITLE_PREP_ID
 110 Public Const CHK_SUBDIRS_ID = RID_STR_ENG_DOCUMENTS_INCLUDE_SUBDIRECTORIES_PREP_ID
 111 Public Const SETUP_ANALYSIS_XLS_ID = RID_STR_ENG_RESULTS_ANALYSIS_XLS_PREP_ID
 112 Public Const ANALYZE_TOTAL_NUM_DOCS_ID = RID_STR_ENG_ANALYZE_NUM_DOCS_PREP_ID
 113 Public Const XML_RESULTS_ID = RID_STR_ENG_OTHER_XML_RESULTS_PREP_ID
 114
 115 #Else
 116 Global Const gBoolPreparation = False
 117
 118 Public Const TITLE_ID = LANG_BASE_ID + 0
 119 Public Const CHK_SUBDIRS_ID = LANG_BASE_ID + 202
 120 Public Const SETUP_ANALYSIS_XLS_ID = LANG_BASE_ID + 302
 121 Public Const ANALYZE_TOTAL_NUM_DOCS_ID = LANG_BASE_ID + 401
 122 Public Const XML_RESULTS_ID = INTERNAL_RESOURCE_BASE_ID + 15
 123 #End If
 124
 125 Public Const PRODUCTNAME_ID = LANG_BASE_ID + 1
 126 Public Const LBL_STEPS_ID = LANG_BASE_ID + 40
 127 Public Const INTRO1_ID = LANG_BASE_ID + 101
 128
 129 Public Const ANALYZE_DOCUMENTS_ID = LANG_BASE_ID + 402
 130 Public Const ANALYZE_TEMPLATES_ID = LANG_BASE_ID + 403
 131 Public Const ANALYZE_DOCUMENTS_XLS_ID = LANG_BASE_ID + 408
 132 Public Const ANALYZE_DOCUMENTS_PPT_ID = LANG_BASE_ID + 409
 133 Public Const RUNBTN_START_ID = LANG_BASE_ID + 404
 134 Public Const PREPAREBTN_START_ID = LANG_BASE_ID + 411
 135
 136 Public Const README_FILE_ID = INTERNAL_RESOURCE_BASE_ID + 5 'Readme.doc
 137 Public Const BROWSE_FOR_DOC_DIR_ID = INTERNAL_RESOURCE_BASE_ID + 6
 138 Public Const BROWSE_FOR_RES_DIR_ID = INTERNAL_RESOURCE_BASE_ID + 7
 139 Public Const RUNBTN_RUNNING_ID = INTERNAL_RESOURCE_BASE_ID + 10
 140
 141 Public Const PROGRESS_CAPTION = INTERNAL_RESOURCE_BASE_ID + 20
 142 Public Const PROGRESS_ABORTING = INTERNAL_RESOURCE_BASE_ID + 21
 143 Public Const PROGRESS_PATH_LABEL = INTERNAL_RESOURCE_BASE_ID + 22
 144 Public Const PROGRESS_FILE_LABEL = INTERNAL_RESOURCE_BASE_ID + 23
 145 Public Const PROGRESS_INFO_LABEL = INTERNAL_RESOURCE_BASE_ID + 24
 146 Public Const PROGRESS_WAIT_LABEL = INTERNAL_RESOURCE_BASE_ID + 25
 147
 148 Public Const SEARCH_PATH_LABEL = PROGRESS_PATH_LABEL
 149 Public Const SEARCH_CAPTION = INTERNAL_RESOURCE_BASE_ID + 26
 150 Public Const SEARCH_INFO_LABEL = INTERNAL_RESOURCE_BASE_ID + 27
 151 Public Const SEARCH_FOUND_LABEL = INTERNAL_RESOURCE_BASE_ID + 28
 152
 153 Public Const TERMINATE_CAPTION = INTERNAL_RESOURCE_BASE_ID + 30
 154 Public Const TERMINATE_INFO = INTERNAL_RESOURCE_BASE_ID + 31
 155 Public Const TERMINATE_YES = INTERNAL_RESOURCE_BASE_ID + 32
 156 Public Const TERMINATE_NO = INTERNAL_RESOURCE_BASE_ID + 33
 157
 158 'Error Resource Strings Codes
 159 Const ERROR_BASE_ID = LANG_BASE_ID + 900
 160 Public Const ERR_MISSING_RESULTS_DOC = ERROR_BASE_ID + 0
 161 Public Const ERR_NO_DOC_DIR = ERROR_BASE_ID + 1
 162 Public Const ERR_NO_DOC_TYPES = ERROR_BASE_ID + 2
 163 Public Const ERR_NO_RES_DIR = ERROR_BASE_ID + 3
 164 Public Const ERR_CREATE_DIR = ERROR_BASE_ID + 4
 165 Public Const ERR_MISSING_RESULTS_TEMPLATE = ERROR_BASE_ID + 5
 166 Public Const ERR_MISSING_EXCEL_DRIVER = ERROR_BASE_ID + 6
 167 Public Const ERR_EXCEL_DRIVER_CRASH = ERROR_BASE_ID + 7
 168 Public Const ERR_MISSING_WORD_DRIVER = ERROR_BASE_ID + 8
 169 Public Const ERR_WORD_DRIVER_CRASH = ERROR_BASE_ID + 9
 170 Public Const ERR_MISSING_README = ERROR_BASE_ID + 10
 171 Public Const ERR_MISSING_PP_DRIVER = ERROR_BASE_ID + 11
 172 Public Const ERR_PP_DRIVER_CRASH = ERROR_BASE_ID + 12
 173 Public Const ERR_SUPPORTED_VERSION = ERROR_BASE_ID + 13
 174 Public Const ERR_ISSUES_VERSION_MISMATCH = ERROR_BASE_ID + 14
 175 Public Const ERR_ISSUES_LIST_MISSING = ERROR_BASE_ID + 15
 176 Public Const ERR_SUPPORTED_OSVERSION = ERROR_BASE_ID + 16
 177 Public Const ERR_OPEN_RESULTS_SPREADSHEET = ERROR_BASE_ID + 17
 178 Public Const ERR_EXCEL_OPEN = ERROR_BASE_ID + 18
 179 Public Const ERR_NO_ACCESS_TO_VBPROJECT = ERROR_BASE_ID + 19
 180 Public Const ERR_AUTOMATION_FAILURE = ERROR_BASE_ID + 20
 181 Public Const ERR_NO_RESULTS_DIRECTORY = ERROR_BASE_ID + 21
 182 Public Const ERR_CREATE_FILE = ERROR_BASE_ID + 22
 183 Public Const ERR_XML_RESULTS_ONLY = ERROR_BASE_ID + 23
 184 Public Const ERR_NOT_INSTALLED = ERROR_BASE_ID + 24
 185 Public Const ERR_CDROM_NOT_ALLOWED = ERROR_BASE_ID + 25
 186 Public Const ERR_CDROM_NOT_READY = ERROR_BASE_ID + 26
 187 Public Const ERR_NO_WRITE_TO_READ_ONLY_FOLDER = ERROR_BASE_ID + 27
 188 Public Const ERR_APPLICATION_IN_USE = ERROR_BASE_ID + 28
 189 Public Const ERR_MISSING_IMPORTANT_FILE = ERROR_BASE_ID + 29
 190
 191
 192 Private Const LOCALE_ILANGUAGE             As Long = &H1     'language id
 193 Private Const LOCALE_SLANGUAGE             As Long = &H2     'localized name of language
 194 Private Const LOCALE_SENGLANGUAGE          As Long = &H1001  'English name of language
 195 Private Const LOCALE_SABBREVLANGNAME       As Long = &H3     'abbreviated language name
 196 Private Const LOCALE_SCOUNTRY              As Long = &H6     'localized name of country
 197 Private Const LOCALE_SENGCOUNTRY           As Long = &H1002  'English name of country
 198 Private Const LOCALE_SABBREVCTRYNAME       As Long = &H7     'abbreviated country name
 199 Private Const LOCALE_SISO639LANGNAME       As Long = &H59    'ISO abbreviated language name
 200 Private Const LOCALE_SISO3166CTRYNAME      As Long = &H5A    'ISO abbreviated country name
 201
 202 Private Const LOCALE_JAPAN                 As Long = &H411
 203 Private Const LOCALE_KOREA                 As Long = &H412
 204 Private Const LOCALE_ZH_CN                 As Long = &H404
 205 Private Const LOCALE_ZH_TW                 As Long = &H804
 206
 207 Private Const RES_PREFIX = ".\Resources\Resources.dll"
 208
 209 Declare Function GetLocaleInfo Lib "kernel32" Alias _
 210 "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _
 211 ByVal cchData As Long) As Long
 212
 213 Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal fileName$)
 214 Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
 215 Private Declare Function LoadString Lib "user32" Alias "LoadStringA" _
 216    (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, _
 217     ByVal nBufferMax As Long) As Long
 218
 219 'WinHelp Commands
 220 'Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
 221 'Public Const HELP_QUIT = &H2              '  Terminate help
 222 'Public Const HELP_CONTENTS = &H3&         '  Display index/contents
 223 'Public Const HELP_CONTEXT = &H1           '  Display topic in ulTopic
 224 'Public Const HELP_INDEX = &H3             '  Display index
 225
 226 Public Const CBASE_RESOURCE_DIR = ".\resources"
 227 Private mStrTrue As String
 228 Private mLocaleDir As String
 229 Private ghInst As Long
 230
 231
 232 Function getLocaleDir() As String
 233     If mLocaleDir = "" Then
 234         getLocaleLangBaseIDandSetLocaleDir
 235     End If
 236     getLocaleDir = mLocaleDir
 237 End Function
 238
 239 Public Function GetLocaleLanguage() As String
 240     Dim lReturn As Long
 241     Dim lLocID As Long
 242     Dim sData As String
 243     Dim lDataLen As Long
 244
 245     lDataLen = 0
 246     lReturn = GetLocaleInfo(lLocID, LOCALE_SENGLANGUAGE, sData, lDataLen)
 247     sData = String(lReturn, 0) & vbNullChar
 248     lDataLen = lReturn
 249     lReturn = GetLocaleInfo(lLocID, LOCALE_SENGLANGUAGE, sData, lDataLen)
 250
 251 End Function
 252
 253 Function getLocaleLangBaseIDandSetLocaleDir() As Integer
 254     On Error GoTo HandleErrors
 255     Dim currentFunctionName As String
 256     currentFunctionName = "getLocaleLangBaseIDandSetLocaleDir"
 257
 258     Dim baseID As Long
 259     Dim bUseLocale As Boolean
 260     Dim fso As FileSystemObject
 261     Set fso = New FileSystemObject
 262
 263     Dim isoLangStr As String
 264     Dim isoCountryStr As String
 265     Dim langStr As String
 266
 267     Dim userLCID As Long
 268     userLCID = GetUserDefaultLCID()
 269     Dim sysLCID As Long
 270     sysLCID = GetSystemDefaultLCID()
 271
 272     isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME)
 273     isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME)
 274     langStr = GetUserLocaleInfo(sysLCID, LOCALE_SENGLANGUAGE)
 275
 276     baseID = 0
 277     mLocaleDir = ""
 278
 279     If fso.FileExists(fso.GetAbsolutePathName("debug.ini")) Then
 280         Dim overrideLangStr As String
 281         overrideLangStr = ProfileGetItem("debug", "langoverride", "", fso.GetAbsolutePathName("debug.ini"))
 282         If overrideLangStr <> "" Then
 283             Debug.Print "Overriding language " & isoLangStr & " with " & overrideLangStr & "\n"
 284             isoLangStr = overrideLangStr
 285         End If
 286     End If
 287
 288     'check for locale dirs in following order:
 289     '   CBASE_RESOURCE_DIR & "\" & isoLangStr
 290     '   CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr
 291     '   CBASE_RESOURCE_DIR & "\" & "eng"
 292     'If fso.FolderExists(fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & isoLangStr)) Then
 293     '    mLocaleDir = CBASE_RESOURCE_DIR & "\" & isoLangStr
 294     '    baseID = getBaseID(isoLangStr)
 295     'ElseIf fso.FolderExists(fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr)) Then
 296     '    mLocaleDir = CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr
 297     '    baseID = getBaseID(isoLangStr & "-" & isoCountryStr)
 298     'Else
 299         mLocaleDir = CBASE_RESOURCE_DIR
 300         baseID = 1000
 301     'End If
 302
 303     getLocaleLangBaseIDandSetLocaleDir = CInt(baseID)
 304
 305 FinalExit:
 306     Set fso = Nothing
 307
 308     Exit Function
 309
 310 HandleErrors:
 311     Debug.Print currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
 312     Resume FinalExit
 313 End Function
 314 '--------------------------------------------------------------------------
 315 'this sub must be executed from the immediate window
 316 'it will add the entry to VBADDIN.INI if it doesn't already exist
 317 'so that the add-in is on available next time VB is loaded
 318 '--------------------------------------------------------------------------
 319 Sub AddToINI()
 320     Debug.Print WritePrivateProfileString("Add-Ins32", WIZARD_NAME & ".Wizard", "0", "VBADDIN.INI")
 321 End Sub
 322
 323 Function GetResString(nRes As Integer) As String
 324     Dim sTmp As String
 325     Dim sRes As String * 1024
 326     Dim sRetStr As String
 327     Dim nRet As Long
 328
 329     Do
 330         'sTmp = LoadResString(nRes)
 331         nRet = LoadString(ghInst, nRes, sRes, 1024)
 332         sTmp = Left$(sRes, nRet)
 333
 334         If Right(sTmp, 1) = "_" Then
 335             sRetStr = sRetStr + VBA.Left(sTmp, Len(sTmp) - 1)
 336         Else
 337             sRetStr = sRetStr + sTmp
 338         End If
 339         nRes = nRes + 1
 340     Loop Until Right(sTmp, 1) <> "_"
 341     GetResString = sRetStr
 342
 343 End Function
 344
 345 Function GetField(sBuffer As String, sSep As String) As String
 346     Dim p As Integer
 347
 348     p = InStr(sBuffer & sSep, sSep)
 349     GetField = VBA.Left(sBuffer, p - 1)
 350     sBuffer = Mid(sBuffer, p + Len(sSep))
 351
 352 End Function
 353 ' Parts of the following code are from:
 354 ' http://support.microsoft.com/default.aspx?scid=kb;en-us;232625&Product=vb6
 355
 356 Private Function GetCharSet(sCdpg As String) As Integer
 357    Select Case sCdpg
 358       Case "932" ' Japanese
 359          GetCharSet = 128
 360       Case "936" ' Simplified Chinese
 361          GetCharSet = 134
 362       Case "949" ' Korean
 363          GetCharSet = 129
 364       Case "950" ' Traditional Chinese
 365          GetCharSet = 136
 366       Case "1250" ' Eastern Europe
 367          GetCharSet = 238
 368       Case "1251" ' Russian
 369          GetCharSet = 204
 370       Case "1252" ' Western European Languages
 371          GetCharSet = 0
 372       Case "1253" ' Greek
 373          GetCharSet = 161
 374       Case "1254" ' Turkish
 375          GetCharSet = 162
 376       Case "1255" ' Hebrew
 377          GetCharSet = 177
 378       Case "1256" ' Arabic
 379          GetCharSet = 178
 380       Case "1257" ' Baltic
 381          GetCharSet = 186
 382       Case Else
 383          GetCharSet = 0
 384    End Select
 385 End Function
 386
 387 Private Function StripNullTerminator(sCP As String)
 388    Dim posNull As Long
 389    posNull = InStr(sCP, Chr$(0))
 390    StripNullTerminator = Left$(sCP, posNull - 1)
 391 End Function
 392
 393 Private Function GetResourceDataFileName() As String
 394     On Error GoTo HandleErrors
 395     Dim currentFunctionName As String
 396     currentFunctionName = "GetResourceDataFileName"
 397
 398     Dim fileName As String
 399     Dim fso As FileSystemObject
 400     Set fso = New FileSystemObject
 401
 402     GetResourceDataFileName = fso.GetAbsolutePathName(RES_PREFIX)
 403
 404     GoTo FinalExit
 405
 406     ' use the following code when we have one resource file for each language
 407     Dim isoLangStr As String
 408     Dim isoCountryStr As String
 409
 410     Dim userLCID As Long
 411     userLCID = GetUserDefaultLangID()
 412     Dim sysLCID As Long
 413     sysLCID = GetSystemDefaultLangID()
 414
 415     isoLangStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME)
 416     isoCountryStr = GetUserLocaleInfo(userLCID, LOCALE_SISO3166CTRYNAME)
 417
 418     'check for locale data in following order:
 419     '  user language
 420     '   isoLangStr & "_" & isoCountryStr & ".dll"
 421     '   isoLangStr & ".dll"
 422     '  system language
 423     '   isoLangStr & "_" & isoCountryStr & ".dll"
 424     '   isoLangStr & ".dll"
 425     '   "en_US" & ".dll"
 426
 427     fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & "-" & isoCountryStr & ".dll")
 428     If fso.FileExists(fileName) Then
 429         GetResourceDataFileName = fileName
 430     Else
 431         fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & ".dll")
 432         If fso.FileExists(fileName) Then
 433             GetResourceDataFileName = fileName
 434         Else
 435             isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME)
 436             isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME)
 437
 438             fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & "-" & isoCountryStr & ".dll")
 439             If fso.FileExists(fileName) Then
 440                 GetResourceDataFileName = fileName
 441             Else
 442                 fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & ".dll")
 443                 If fso.FileExists(fileName) Then
 444                     GetResourceDataFileName = fileName
 445                 Else
 446                     GetResourceDataFileName = fso.GetAbsolutePathName(RES_PREFIX & "en-US.dll")
 447                 End If
 448             End If
 449         End If
 450     End If
 451 FinalExit:
 452     Set fso = Nothing
 453     Exit Function
 454
 455 HandleErrors:
 456     WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
 457     Resume FinalExit
 458 End Function
 459
 460 Sub LoadResStrings(frm As Form)
 461     Dim ctl As Control
 462     Dim obj As Object
 463
 464     Dim LCID As Long, X As Long
 465     Dim sCodePage As String
 466     Dim nCharSet As Integer
 467     Dim currentFunctionName As String
 468     currentFunctionName = "LoadResStrings"
 469
 470     On Error GoTo HandleErrors
 471     ghInst = LoadLibrary(GetResourceDataFileName())
 472
 473     On Error Resume Next
 474
 475     sCodePage = String$(16, " ")
 476     LCID = GetThreadLocale() 'Get Current locale
 477
 478     X = GetLocaleInfo(LCID, LOCALE_IDEFAULTANSICODEPAGE, _
 479         sCodePage, Len(sCodePage))  'Get code page
 480     sCodePage = StripNullTerminator(sCodePage)
 481     nCharSet = GetCharSet(sCodePage)  'Convert code page to charset
 482
 483     'set the form's caption
 484     If IsNumeric(frm.Tag) Then
 485         frm.Caption = LoadResString(CInt(frm.Tag))
 486     End If
 487
 488     'set the controls' captions using the caption
 489     'property for menu items and the Tag property
 490     'for all other controls
 491     For Each ctl In frm.Controls
 492         Err = 0
 493         If (nCharSet <> 0) Then
 494             ctl.Font.Charset = nCharSet
 495         End If
 496         If TypeName(ctl) = "Menu" Then
 497             If IsNumeric(ctl.Caption) Then
 498                 ctl.Caption = LoadResString(CInt(ctl.Caption))
 499             End If
 500         ElseIf TypeName(ctl) = "TabStrip" Then
 501             For Each obj In ctl.Tabs
 502                 If IsNumeric(obj.Tag) Then
 503                     obj.Caption = LoadResString(CInt(obj.Tag))
 504                 End If
 505                 'check for a tooltip
 506                 If IsNumeric(obj.ToolTipText) Then
 507                     If Err = 0 Then
 508                         obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
 509                     End If
 510                 End If
 511             Next
 512         ElseIf TypeName(ctl) = "Toolbar" Then
 513             For Each obj In ctl.Buttons
 514                 If IsNumeric(obj.Tag) Then
 515                     obj.ToolTipText = LoadResString(CInt(obj.Tag))
 516                 End If
 517             Next
 518         ElseIf TypeName(ctl) = "ListView" Then
 519             For Each obj In ctl.ColumnHeaders
 520                 If IsNumeric(obj.Tag) Then
 521                     obj.Text = LoadResString(CInt(obj.Tag))
 522                 End If
 523             Next
 524         ElseIf TypeName(ctl) = "TextBox" Then
 525             If IsNumeric(ctl.Tag) Then
 526                 ctl.Text = LoadResString(CInt(ctl.Tag))
 527             End If
 528         Else
 529             If IsNumeric(ctl.Tag) Then
 530                 ctl.Caption = GetResString(CInt(ctl.Tag))
 531             End If
 532             'check for a tooltip
 533             If IsNumeric(ctl.ToolTipText) Then
 534                 If Err = 0 Then
 535                     ctl.ToolTipText = LoadResString(CInt(ctl.ToolTipText))
 536                 End If
 537             End If
 538         End If
 539     Next
 540
 541 FinalExit:
 542     Exit Sub
 543
 544 HandleErrors:
 545     WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
 546     Resume FinalExit
 547
 548 End Sub
 549
 550 '==================================================
 551 'Purpose: Replace the sToken string(s) in
 552 '         res file string for correct placement
 553 '         of localized tokens
 554 '
 555 'Inputs:  sString = String to search and replace in
 556 '         sToken = token to replace
 557 '         sReplacement = String to replace token with
 558 '
 559 'Outputs: New string with token replaced throughout
 560 '==================================================
 561 Function ReplaceTopicTokens(sString As String, _
 562                             sToken As String, _
 563                             sReplacement As String) As String
 564     On Error Resume Next
 565
 566     Dim p As Integer
 567     Dim sTmp As String
 568
 569     sTmp = sString
 570     Do
 571         p = InStr(sTmp, sToken)
 572         If p Then
 573             sTmp = VBA.Left(sTmp, p - 1) + sReplacement + Mid(sTmp, p + Len(sToken))
 574         End If
 575     Loop While p
 576
 577
 578     ReplaceTopicTokens = sTmp
 579
 580 End Function
 581 '==================================================
 582 'Purpose: Replace the sToken1 and sToken2 strings in
 583 '         res file string for correct placement
 584 '         of localized tokens
 585 '
 586 'Inputs:  sString = String to search and replace in
 587 '         sToken1 = 1st token to replace
 588 '         sReplacement1 = 1st String to replace token with
 589 '         sToken2 = 2nd token to replace
 590 '         sReplacement2 = 2nd String to replace token with
 591 '
 592 'Outputs: New string with token replaced throughout
 593 '==================================================
 594 Function ReplaceTopic2Tokens(sString As String, _
 595                             sToken1 As String, _
 596                             sReplacement1 As String, _
 597                             sToken2 As String, _
 598                             sReplacement2 As String) As String
 599     On Error Resume Next
 600
 601     ReplaceTopic2Tokens = _
 602         ReplaceTopicTokens(ReplaceTopicTokens(sString, sToken1, sReplacement1), _
 603         sToken2, sReplacement2)
 604 End Function
 605
 606
 607 Public Function GetResData(sResName As String, sResType As String) As String
 608     Dim sTemp As String
 609     Dim p As Integer
 610
 611     sTemp = StrConv(LoadResData(sResName, sResType), vbUnicode)
 612     p = InStr(sTemp, vbNullChar)
 613     If p Then sTemp = VBA.Left$(sTemp, p - 1)
 614     GetResData = sTemp
 615 End Function
 616
 617 Function AddToAddInCommandBar(VBInst As Object, sCaption As String, oBitmap As Object) As Object   'Office.CommandBarControl
 618     On Error GoTo AddToAddInCommandBarErr
 619
 620     Dim c As Integer
 621     Dim cbMenuCommandBar As Object   'Office.CommandBarControl  'command bar object
 622     Dim cbMenu As Object
 623
 624     'see if we can find the Add-Ins menu
 625     Set cbMenu = VBInst.CommandBars("Add-Ins")
 626     If cbMenu Is Nothing Then
 627         'not available so we fail
 628         Exit Function
 629     End If
 630
 631     'add it to the command bar
 632     Set cbMenuCommandBar = cbMenu.Controls.add(1)
 633     c = cbMenu.Controls.count - 1
 634     If cbMenu.Controls(c).BeginGroup And _
 635         Not cbMenu.Controls(c - 1).BeginGroup Then
 636         'this s the first addin being added so it needs a separator
 637         cbMenuCommandBar.BeginGroup = True
 638     End If
 639     'set the caption
 640     cbMenuCommandBar.Caption = sCaption
 641     'undone:set the onaction (required at this point)
 642     cbMenuCommandBar.OnAction = "hello"
 643     'copy the icon to the clipboard
 644     Clipboard.SetData oBitmap
 645     'set the icon for the button
 646     cbMenuCommandBar.PasteFace
 647
 648     Set AddToAddInCommandBar = cbMenuCommandBar
 649
 650     Exit Function
 651 AddToAddInCommandBarErr:
 652
 653 End Function
 654