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