source: DRBLLiveHelper/Internationalization.bas @ 144

Last change on this file since 144 was 13, checked in by sunny, 17 years ago
File size: 6.7 KB
Line 
1Attribute VB_Name = "Internationalization"
2Option Explicit
3
4Dim Resources() As String
5Dim Languages() As String
6Dim LangPath() As String
7Dim lang_fname As String
8Dim isResLoaded As Boolean
9Dim isLangLoaded As Boolean
10Dim currLangPath As String
11Dim currLangIndex As Integer
12
13Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
14Private clsSatellite As Object
15
16Public Function LoadLocalizedResources_dll() As Boolean
17   Dim lLocalID As String
18
19   ' Find the LocalID.
20   lLocalID = Hex(GetUserDefaultLCID)
21
22   ' Load the Satellite DLL that contains the local
23   ' resource object to be used. If CreateObject
24   ' fails, there is no local version of the
25   ' resources.
26   
27   On Error GoTo NoLocalResource
28
29   ' Create a local object containing resources.
30   'Set clsSatellite = CreateObject("Language" & lLocalID & ".clsResources")
31   Set clsSatellite = CreateObject("Language.clsResources")
32   ' Return true, then read local resources.
33   LoadLocalizedResources_dll = True
34   Exit Function
35
36NoLocalResource:
37
38   ' There is no local satellite DLL. As a result, false is returned.
39
40   LoadLocalizedResources_dll = False
41
42End Function
43     
44' GetString will access the object and return the string
45' resources specific to the region. For this example, only
46' basic error handling is implemented.
47
48Public Function GetString_dll(StringIndex As Long) As String
49
50 ' Make sure there is a resource object.
51   If Not (clsSatellite Is Nothing) Then
52      ' Get the resource from the resource object.
53      GetString_dll = clsSatellite.GetResourceString(StringIndex)
54   Else
55     ' For this example, if there is no resource
56     ' object something is still returned.
57     GetString_dll = "Error : No Local Data"
58   End If
59End Function
60     
61Public Function LoadLocalizedResources() As Boolean
62   
63    'If isResLoaded Then
64       'Exit Function
65    'End If
66   
67    Dim isUniCode As Boolean
68   
69    If currLangPath = "" Or Not FileExists(currLangPath) Then
70      LoadLocalizedResources = False
71      Exit Function
72    End If
73   
74    isUniCode = IsUnicodeFile(currLangPath)
75   
76    If isUniCode Then
77       Resources = ParseUnicodeFile(currLangPath)
78    Else
79       Resources = ParseAsciiFile(currLangPath)
80    End If
81   
82    LoadLocalizedResources = True
83    isResLoaded = True
84   
85End Function
86
87
88Public Function GetString(StringIndex As Long) As String
89 
90   If UBound(Resources) > StringIndex Then
91      ' Get the resource from the resource array.
92      GetString = Resources(StringIndex)
93   Else
94     ' For this example, if there is no resource
95     ' array something is still returned.
96     GetString = "Error : No Local Data"
97   End If
98End Function
99
100
101   
102Public Function ParseUnicodeLangFile(ByVal fname As String)
103
104    Dim OutRec As String, uniCode As String, str() As String
105   
106    ReDim Languages(30)
107    ReDim LangPath(30)
108   
109    Dim pos As Integer
110   
111    Open fname For Binary As #1
112   
113    uniCode = InputB(2, #1)
114       
115    OutRec = ""
116    pos = 0
117   
118    Do While Not EOF(1)
119       
120        uniCode = InputB(2, #1)
121       
122        If EOF(1) Then
123           Exit Do
124        End If
125       
126        Select Case AscW(uniCode)
127            Case AscW(vbNewLine)
128                uniCode = InputB(2, #1)
129                             
130                If Trim$(OutRec) <> "" Then
131                   str = Split(OutRec, "=")
132             
133                   If UBound(str) > 0 Then
134                     
135                      If pos >= UBound(Languages) Or pos >= UBound(LangPath) Then
136                         ReDim Languages(pos + 10)
137                         ReDim LangPath(pos + 10)
138                      End If
139                      Languages(pos) = str(0)
140                      LangPath(pos) = str(1)
141                      pos = pos + 1
142                   End If
143                End If
144                   
145                OutRec = ""
146            Case Else
147                OutRec = OutRec & uniCode
148               
149        End Select
150   
151    Loop
152       
153   
154   
155    If Trim$(OutRec) <> "" Then
156        str = Split(OutRec, "=")
157             
158        If UBound(str) > 0 Then
159           Languages(pos) = str(0)
160           LangPath(pos) = str(1)
161        End If
162    End If
163       
164    Close #1
165
166
167End Function
168
169
170Public Function ParseAsciiLangFile(ByVal fname As String)
171    Dim OutRec As String
172    Dim str() As String
173   
174    ReDim Languages(30)
175    ReDim LangPath(30)
176    Dim pos As Integer
177   
178    Open fname For Input Access Read Shared As #1
179       
180    Do While Not EOF(1)
181       
182        Line Input #1, OutRec
183       
184       
185        If Trim$(OutRec) <> "" Then
186           str = Split(OutRec, "=")
187             
188           If UBound(str) > 0 Then
189              If pos >= UBound(Languages) Or pos >= UBound(LangPath) Then
190                 ReDim Languages(pos + 10)
191                 ReDim LangPath(pos + 10)
192              End If
193              Languages(pos) = str(0)
194              LangPath(pos) = str(1)
195              pos = pos + 1
196           End If
197         End If
198
199    Loop
200   
201    Close #1
202   
203   
204End Function
205
206Public Function LoadLanguages() As Boolean
207   
208    If isLangLoaded Then
209       LoadLanguages = True
210       Exit Function
211    End If
212   
213    Dim isUniCode As Boolean
214   
215    If lang_fname = "" Then
216       lang_fname = "languages\Language.txt"
217    End If
218   
219    If Not FileExists(lang_fname) Then
220      LoadLanguages = False
221      Exit Function
222    End If
223   
224    isUniCode = IsUnicodeFile(lang_fname)
225   
226    If isUniCode Then
227       ParseUnicodeLangFile (lang_fname)
228    Else
229       ParseAsciiLangFile (lang_fname)
230    End If
231   
232    LoadLanguages = True
233   
234End Function
235     
236Public Function GetLanguageName(StringIndex As Long) As String
237   
238   If UBound(Languages) > StringIndex And StringIndex >= 0 Then
239      GetLanguageName = Languages(StringIndex)
240   Else
241      GetLanguageName = "Error : No Language Data"
242   End If
243
244End Function
245     
246Public Function GetLanguagePath(StringIndex As Long) As String
247   
248   If UBound(LangPath) > StringIndex And StringIndex >= 0 Then
249      GetLanguagePath = LangPath(StringIndex)
250   Else
251      GetLanguagePath = "Error : No Language Data"
252   End If
253
254End Function
255
256Public Function GetLanguages() As String()
257   GetLanguages = Languages
258End Function
259
260Public Function SetCurrLangPath(ByVal path As String)
261   currLangPath = path
262End Function
263
264Public Function GetCurrLangPath() As String
265   GetCurrLangPath = currLangPath
266End Function
267
268Public Function GetCurrLangIndex() As Integer
269   GetCurrLangIndex = currLangIndex
270End Function
271
272Public Function SetCurrLangIndex(ByVal index As Integer)
273   currLangIndex = index
274End Function
Note: See TracBrowser for help on using the repository browser.