source: DRBLLiveHelper/Internationalization.bas @ 144

Attribute VB_Name = "Internationalization"
Option Explicit

Dim Resources() As String
Dim Languages() As String
Dim LangPath() As String
Dim lang_fname As String
Dim isResLoaded As Boolean
Dim isLangLoaded As Boolean
Dim currLangPath As String
Dim currLangIndex As Integer

Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private clsSatellite As Object

Public Function LoadLocalizedResources_dll() As Boolean
   Dim lLocalID As String

   ' Find the LocalID.
   lLocalID = Hex(GetUserDefaultLCID)

   ' Load the Satellite DLL that contains the local
   ' resource object to be used. If CreateObject
   ' fails, there is no local version of the
   ' resources.
    
   On Error GoTo NoLocalResource

   ' Create a local object containing resources.
   'Set clsSatellite = CreateObject("Language" & lLocalID & ".clsResources")
   Set clsSatellite = CreateObject("Language.clsResources")
   ' Return true, then read local resources.
   LoadLocalizedResources_dll = True
   Exit Function

NoLocalResource:

   ' There is no local satellite DLL. As a result, false is returned.

   LoadLocalizedResources_dll = False

End Function
      
' GetString will access the object and return the string
' resources specific to the region. For this example, only
' basic error handling is implemented.

Public Function GetString_dll(StringIndex As Long) As String

 ' Make sure there is a resource object.
   If Not (clsSatellite Is Nothing) Then
      ' Get the resource from the resource object.
      GetString_dll = clsSatellite.GetResourceString(StringIndex)
   Else
     ' For this example, if there is no resource
     ' object something is still returned.
     GetString_dll = "Error : No Local Data"
   End If
End Function
      
Public Function LoadLocalizedResources() As Boolean
   
    'If isResLoaded Then
       'Exit Function
    'End If
    
    Dim isUniCode As Boolean
    
    If currLangPath = "" Or Not FileExists(currLangPath) Then
      LoadLocalizedResources = False
      Exit Function
    End If
    
    isUniCode = IsUnicodeFile(currLangPath)
    
    If isUniCode Then
       Resources = ParseUnicodeFile(currLangPath)
    Else
       Resources = ParseAsciiFile(currLangPath)
    End If
    
    LoadLocalizedResources = True
    isResLoaded = True
    
End Function


Public Function GetString(StringIndex As Long) As String
 
   If UBound(Resources) > StringIndex Then
      ' Get the resource from the resource array.
      GetString = Resources(StringIndex)
   Else
     ' For this example, if there is no resource
     ' array something is still returned.
     GetString = "Error : No Local Data"
   End If
End Function


    
Public Function ParseUnicodeLangFile(ByVal fname As String)

    Dim OutRec As String, uniCode As String, str() As String
    
    ReDim Languages(30)
    ReDim LangPath(30)
    
    Dim pos As Integer
    
    Open fname For Binary As #1
    
    uniCode = InputB(2, #1)
        
    OutRec = ""
    pos = 0
    
    Do While Not EOF(1)
        
        uniCode = InputB(2, #1)
        
        If EOF(1) Then
           Exit Do
        End If
        
        Select Case AscW(uniCode)
            Case AscW(vbNewLine)
                uniCode = InputB(2, #1)
                              
                If Trim$(OutRec) <> "" Then
                   str = Split(OutRec, "=")
             
                   If UBound(str) > 0 Then
                      
                      If pos >= UBound(Languages) Or pos >= UBound(LangPath) Then
                         ReDim Languages(pos + 10)
                         ReDim LangPath(pos + 10)
                      End If
                      Languages(pos) = str(0)
                      LangPath(pos) = str(1)
                      pos = pos + 1
                   End If
                End If
                   
                OutRec = ""
            Case Else
                OutRec = OutRec & uniCode
                
        End Select
    
    Loop
        
    
    
    If Trim$(OutRec) <> "" Then
        str = Split(OutRec, "=")
             
        If UBound(str) > 0 Then
           Languages(pos) = str(0)
           LangPath(pos) = str(1)
        End If
    End If
        
    Close #1


End Function


Public Function ParseAsciiLangFile(ByVal fname As String)
    Dim OutRec As String
    Dim str() As String
    
    ReDim Languages(30)
    ReDim LangPath(30)
    Dim pos As Integer
    
    Open fname For Input Access Read Shared As #1
       
    Do While Not EOF(1)
        
        Line Input #1, OutRec
        
        
        If Trim$(OutRec) <> "" Then
           str = Split(OutRec, "=")
             
           If UBound(str) > 0 Then
              If pos >= UBound(Languages) Or pos >= UBound(LangPath) Then
                 ReDim Languages(pos + 10)
                 ReDim LangPath(pos + 10)
              End If
              Languages(pos) = str(0)
              LangPath(pos) = str(1)
              pos = pos + 1
           End If
         End If

    Loop
    
    Close #1
    
    
End Function

Public Function LoadLanguages() As Boolean
    
    If isLangLoaded Then
       LoadLanguages = True
       Exit Function
    End If
    
    Dim isUniCode As Boolean
    
    If lang_fname = "" Then
       lang_fname = "languages\Language.txt"
    End If
    
    If Not FileExists(lang_fname) Then
      LoadLanguages = False
      Exit Function
    End If
    
    isUniCode = IsUnicodeFile(lang_fname)
    
    If isUniCode Then
       ParseUnicodeLangFile (lang_fname)
    Else
       ParseAsciiLangFile (lang_fname)
    End If
    
    LoadLanguages = True
    
End Function
      
Public Function GetLanguageName(StringIndex As Long) As String
   
   If UBound(Languages) > StringIndex And StringIndex >= 0 Then
      GetLanguageName = Languages(StringIndex)
   Else
      GetLanguageName = "Error : No Language Data"
   End If

End Function
      
Public Function GetLanguagePath(StringIndex As Long) As String
   
   If UBound(LangPath) > StringIndex And StringIndex >= 0 Then
      GetLanguagePath = LangPath(StringIndex)
   Else
      GetLanguagePath = "Error : No Language Data"
   End If

End Function

Public Function GetLanguages() As String()
   GetLanguages = Languages
End Function

Public Function SetCurrLangPath(ByVal path As String)
   currLangPath = path
End Function

Public Function GetCurrLangPath() As String
   GetCurrLangPath = currLangPath
End Function

Public Function GetCurrLangIndex() As Integer
   GetCurrLangIndex = currLangIndex
End Function

Public Function SetCurrLangIndex(ByVal index As Integer)
   currLangIndex = index
End Function