1VERSION 1.0 CLASS 2BEGIN 3 MultiUse = -1 'True 4END 5Attribute VB_Name = "StringDataManager" 6Attribute VB_GlobalNameSpace = False 7Attribute VB_Creatable = False 8Attribute VB_PredeclaredId = False 9Attribute VB_Exposed = True 10'************************************************************************* 11' 12' Licensed to the Apache Software Foundation (ASF) under one 13' or more contributor license agreements. See the NOTICE file 14' distributed with this work for additional information 15' regarding copyright ownership. The ASF licenses this file 16' to you under the Apache License, Version 2.0 (the 17' "License"); you may not use this file except in compliance 18' with the License. You may obtain a copy of the License at 19' 20' http://www.apache.org/licenses/LICENSE-2.0 21' 22' Unless required by applicable law or agreed to in writing, 23' software distributed under the License is distributed on an 24' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 25' KIND, either express or implied. See the License for the 26' specific language governing permissions and limitations 27' under the License. 28' 29'************************************************************************* 30 31Option Explicit 32Private langDict As Scripting.Dictionary 33Private mFileName As String 34 35Const C_PRODUCTNAME = "<PRODUCTNAME>" 36Const C_PRODUCTVERSION = "<PRODUCTVERSION>" 37Const C_NEXTPRODUCTVERSION = "<NEXTPRODUCTVERSION>" 38Const C_NEWLINE = "<CR>" 39 40' Load strings from the data file (in the form "id=string") into 41' dictionary object. 42Function InitStringData(fileName As String) As Boolean 43 On Error GoTo HandleErrors 44 Dim stringFile As TextStream 45 Dim aLine As String 46 Dim valueOffset As Long 47 Dim id, Str As String 48 Dim fso As FileSystemObject 49 50 'Make sure the string data file exists before opening. 51 Set fso = New Scripting.FileSystemObject 52 If Not fso.FileExists(fileName) Then 53 InitStringData = False 54 Exit Function 55 End If 56 Set stringFile = fso.OpenTextFile(fileName, ForReading, False, TristateTrue) 57 If IsEmpty(stringFile) Then 58 'WriteDebug 59 End If 60 mFileName = fileName 61 62 'Read each line and parse the id and string, then put into dictionary 63 Do While Not stringFile.AtEndOfStream 64 aLine = stringFile.ReadLine 65 valueOffset = InStr(aLine, "=") 66 id = Left(aLine, valueOffset - 1) 67 Str = Right(aLine, Len(aLine) - valueOffset) 68 langDict.Add id, Str 69 Loop 70 stringFile.Close 71 72 Dim aProductName As String 73 Dim aProductVersion As String 74 Dim aNextProductVersion As String 75 Dim aKey As Variant 76 Dim aItem As String 77 Dim aOldItem As String 78 79 aProductName = langDict.item("RID_STR_COMMON_PRODUCTNAME") 80 aProductVersion = langDict.item("RID_STR_COMMON_PRODUCTVERSION") 81 aNextProductVersion = langDict.item("RID_STR_COMMON_NEXTPRODUCTVERSION") 82 83 For Each aKey In langDict 84 aOldItem = langDict.item(aKey) 85 aItem = ReplaceTopicTokens(aOldItem, C_PRODUCTNAME, aProductName) 86 aItem = ReplaceTopicTokens(aItem, C_PRODUCTVERSION, aProductVersion) 87 aItem = ReplaceTopicTokens(aItem, C_NEXTPRODUCTVERSION, aNextProductVersion) 88 aItem = ReplaceTopicTokens(aItem, C_NEWLINE, vbLF) 89 If (Not (aOldItem = aItem)) Then 90 langDict.item(aKey) = aItem 91 End If 92 Next 93 94 InitStringData = True 95 96FinalExit: 97 Exit Function 98HandleErrors: 99 WriteDebug "InitStringData : " & Err.Number & " " & Err.Description & " " & Err.Source 100 InitStringData = False 101End Function 102 103'Set String Data from an existing dictionary 104Public Property Set StringData(data As Scripting.Dictionary) 105 Set langDict = data 106End Property 107 108'Get String Data dictionary 109Public Property Get StringData() As Scripting.Dictionary 110 Set StringData = langDict 111End Property 112 113'Initialize a given string variable by id 114Function InitString(ByRef resRef As String, resName As String) 115 resRef = langDict.item(resName) 116End Function 117 118Private Sub Class_Initialize() 119 Set langDict = New Scripting.Dictionary 'Allocate the string dictonary 120End Sub 121 122Private Sub Class_Terminate() 123 langDict.RemoveAll 124 Set langDict = Nothing 'Empty the dictionary and remove the instance 125End Sub 126