WaBis

walter.bislins.ch

Datei: xlang.inc

Inhalt der Datei: ./asp/xlang/xlang.inc
<%
' xlang.inc: Copyright (C) 2010 Walter Bislin
' http://walter.bislins.ch/doku/xlang
'
' message translation functions.
'
' Dependencies: none!
'
' Note: The binary files containing translated messages are
' generated by the application xlang.asp
'
' usage:
' Lang.SetLanguage "de"
' Response.Write xMsg("Translate this to german")
' Response.Write xMsg1("Translate this to $1", "DE")

const XLANG_BINFILENAME = "xlang.po"
const XLANG_FOLDER      = "lang"

class CxLang
  public  ConvertHtmlTagsToXhtml
  private mKeys  ' Array of String
  private mTexts ' Array of String

  private sub Class_Initialize()
    mKeys = Array()
    mTexts = Array()
    ConvertHtmlTagsToXhtml = false
  end sub

  sub SetLanguage( aLang )
    dim s, p, binFileName
    binFileName = XLANG_FOLDER & "/" & aLang & "/" & XLANG_BINFILENAME
    if FileExists(binFileName) then
      s = ReadFile(binFileName)
      p = 1
      mKeys = DataGetStrArray( s, p )
      mTexts = DataGetStrArray( s, p )
    else
      mKeys = Array()
      mTexts = Array()
    end if
  end sub

  function Translate( aKey )
    dim i
    i = Find(aKey)
    if i >= 0 then
      Translate = mTexts(i)
      if Translate = "" then
        ' fallback (Note: in binaries there should not be empty text at all!)
        Translate = aKey
      end if
    else
      ' use aKey as translation
      Translate = aKey
    end if
    if ConvertHtmlTagsToXhtml then
      Translate = Replace( Translate, "<br>", "<br />" )
    end if
  end function

  private function FileExists( aRelPath )
    dim fso
    on error resume next
    set fso = Server.CreateObject("Scripting.FileSystemObject")
    FileExists = fso.FileExists(Server.MapPath(aRelPath))
    if Err <> 0 then
      FileExists = false
      Err.Clear
    end if
  end function

  private function ReadFile( aRelPath )
    ' Require FileExists(aRelPath), "CFileSystem.ReadFile", "Nonexistent file, aRelPath = " & aRelPath
    dim file, tstream, fso
    set fso = Server.CreateObject("Scripting.FileSystemObject")
    set file = fso.GetFile(Server.MapPath(aRelPath))
    set tstream = file.OpenAsTextStream(1)
    if tstream.AtEndOfStream then
      ReadFile = ""
    else
      ReadFile = tstream.Readall
    end if
  end function

  private function DataGetNumD( aData, aDefault, byref aPos )
    dim p, s
    DataGetNumD = aDefault
    if aData = "" then exit function
    p = InStr(aPos,aData,"|")
    if p > 0 then
      s = Mid(aData,aPos,p-aPos)
      if IsNumeric(s) then
        DataGetNumD = CLng(s)
        aPos = p + 1
      end if
    end if
  end function

  private function DataGetStrD( aData, aDefaultStr, byref aPos )
    dim n
    DataGetStrD = aDefaultStr
    if aData = "" then exit function
    n = DataGetNumD(aData,-1,aPos)
    if n = 0 then
      DataGetStrD = ""
    elseif n > 0 and aPos+n <= Len(aData) then
      DataGetStrD = Mid(aData,aPos,n)
      aPos = aPos + n + 1
    end if
  end function

  private function DataGetStrArray( aData, byRef aPos )
    dim sz, i, arr
    sz = DataGetNumD(aData,0,aPos)
    if sz <= 0  then
      DataGetStrArray = Array()
    else
      redim arr(sz-1)
      for i = 0 to sz-1
        arr(i) = DataGetStrD(aData,"",aPos)
      next
      DataGetStrArray = arr
    end if
  end function

  private function Find( aKey )
    ' binary search for aKey
    dim lo, hi, last, curr, cmp
    Find = -1
    lo = 0
    hi = UBound(mKeys)+1
    if hi <= lo then exit function
    last = -1
    curr = (lo+hi) \ 2
    while curr <> last
      cmp = StrComp(mKeys(curr),aKey,1)
      if cmp = 0 then
        Find = curr
        exit function
      end if
      if cmp < 0 then
        lo = curr
      else
        hi = curr
      end if
      last = curr
      curr = (lo+hi) \ 2
    wend
  end function

end class

'--------------------------------

dim Lang
set Lang = new CxLang

function xMsg( aMessage )
  xMsg = Lang.Translate(aMessage)
end function

function xMsg1( aMessage, aVal1 )
  dim s
  s = Lang.Translate(aMessage)
  s = Replace( s, "$1", aVal1 )
  xMsg1 = s
end function

function xMsg2( aMessage, aVal1, aVal2 )
  dim s
  s = Lang.Translate(aMessage)
  s = Replace( s, "$1", aVal1 )
  s = Replace( s, "$2", aVal2 )
  xMsg2 = s
end function

function xMsgD( aStr )
  ' returns aStr
  ' this function is a dummy and only used for marking Messages for the xlang parser
  xMsgD = aStr
end function

%>


Weitere Infos zur Seite
Erzeugt Montag, 17. Oktober 2011
von wabis
Zum Seitenanfang
Geändert Montag, 12. Oktober 2015
von wabis