<% Option Explicit %>
<%
' xlang.asp: Copyright (C) 2010 Walter Bislin
' http://walter.bislins.ch/doku/xlang

const XLANG_TEMPLATE = "xlang.txt"
const XLANG_FOLDER = "lang"
const XLANG_INCLUDE_SRC = "*.inc;*.asp" ' no spaces!
const XLANG_EXCLUDE_SRC = "*/xlang.*"   ' no spaces!

' util -----------------------------------------------------

function TestPattern( aString, aPattern, bIgnoreCase )
  dim re
  set re = new RegExp
  re.Multiline = false
  re.IgnoreCase = bIgnoreCase
  re.Global = false
  re.Pattern = aPattern
  TestPattern = re.Test(aString)
end function

function ReplacePattern( aString, aPattern, aReplace, bIgnoreCase )
  dim re
  set re = new RegExp
  re.Global = true
  re.Multiline = true
  re.IgnoreCase = bIgnoreCase
  re.Pattern = aPattern
  ReplacePattern = re.Replace( aString, aReplace )
end function

function DataGetNumD( aData, aDefault, byref aPos )
  dim p, s
  DataGetNumD = aDefault
  if Len(aData) = 0 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

function DataGetStrD( aData, aDefaultStr, byref aPos )
  dim n
  DataGetStrD = aDefaultStr
  if Len(aData) = 0 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

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

function DataAddNum( aData, aNum )
  DataAddNum = aData & aNum & "|"
end function

function DataAddStr( aData, aStr )
  dim l, s
  l = Len(aStr)
  s = DataAddNum(aData,l)
  if l > 0 then
    s = s & aStr & "|"
  end if
  DataAddStr = s
end function

function DataAddStrArray( aData, aStrArray )
  dim i, s
  s = DataAddNum(aData,UBound(aStrArray)+1)
  for i = 0 to UBound(aStrArray)
    s = DataAddStr(s,aStrArray(i))
  next
  DataAddStrArray = s
end function

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

class CFileSystem
  private mFSO

  private sub Class_Initialize()
    set mFSO = Server.CreateObject("Scripting.FileSystemObject")
  end sub

  function MapPath( aRelativePath )
    ' returns the absolute path to aRelativePath
    if Len(aRelativePath) = 0 then
      MapPath = Server.MapPath(".")
    else
      MapPath = Server.MapPath(aRelativePath)
    end if
  end function

  function AppendSlash( aPath )
    AppendSlash = aPath
    if InStrRev(AppendSlash,"/") <> Len(AppendSlash) then
      AppendSlash = AppendSlash & "/"
    end if
  end function

  function AppendName( aPath, aName )
    AppendName = AppendSlash(aPath) & aName
  end function

  function GetFileName( aPath )
    dim p, name
    name = aPath
    p = InStrRev(name,"\")
    if p <= 1 then p = InStrRev(name,"/")
    if p > 0 then name = Right(name,Len(name)-p)
    GetFileName = name
  end function

  function GetBaseName( aPath )
    dim p, name
    name = GetFileName(aPath)
    p = InStrRev(name,".")
    if p > 0 then name = Left(name,p-1)
    GetBaseName = name
  end function

  function GetFolder( aRelPath )
    ' returns a Folder object
    set GetFolder = mFSO.GetFolder(MapPath(aRelPath))
  end function

  function FolderExists( aRelPath )
    on error resume next
    FolderExists = mFSO.FolderExists(MapPath(aRelPath))
    if Err <> 0 then
      FolderExists = false
      Err.Clear
    end if
  end function

  sub CreateFolder( aRelPath )
    dim path
    path = MapPath(aRelPath)
    if not mFSO.FolderExists(path) then
      mFSO.CreateFolder(path)
    end if
  end sub

  function FileExists( aRelPath )
    on error resume next
    FileExists = mFSO.FileExists(MapPath(aRelPath))
    if Err <> 0 then
      FileExists = false
      Err.Clear
    end if
  end function

  sub WriteFile( aRelPath, aText )
    dim file
    set file = mFSO.OpenTextFile(MapPath(aRelPath), 2, True)
    file.Write aText
    file.Close
  end sub

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

  function OpenFileForWriting( aRelPath )
    set OpenFileForWriting = mFSO.OpenTextFile(MapPath(aRelPath), 2, True)
  end function

  sub CopyFile( aRelSrcPath, aRelDestPath )
    dim srcPath, destPath
    srcPath = MapPath(aRelSrcPath)
    destPath = MapPath(aRelDestPath)
    if mFSO.FileExists(srcPath) then
      mFSO.CopyFile srcPath, destPath, true
    end if
  end sub

end class

dim FS
set FS = new CFileSystem

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

sub QuickSortX(aQuickSortable)
  if aQuickSortable.LastIx <= 0 then exit sub
  QuickSortRangeX aQuickSortable, aQuickSortable.FirstIx, aQuickSortable.LastIx
end sub

sub QuickSortRangeX( aQuickSortable, lo, hi )
  dim i, j, x
  i = lo
  j = hi
  x = CLng((lo+hi)/2)
  do while i <= j
    do while aQuickSortable.Compare(i,x) < 0
      i = i + 1
    loop
    do while aQuickSortable.Compare(j,x) > 0
      j = j - 1
    loop
    if i <= j then
      if i <> j then
        aQuickSortable.Exchange i, j
        if i = x then
          x = j
        elseif j = x then
          x = i
        end if
      end if
      i = i + 1
      j = j - 1
    end if
  loop
  ' recursion
  if lo < j then QuickSortRangeX aQuickSortable, lo, j
  if i < hi then QuickSortRangeX aQuickSortable, i, hi
end sub

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

const CDA_MIN_CHUNK_SIZE = 128
const CDA_MAX_CHUNK_INCREMENT = 4096

function NewDynArray( aSizeEstimate )
  ' set aSizeEstimate = 0 if final size is not known
  set NewDynArray = new CDynArray
  if aSizeEstimate > 0 then NewDynArray.SetSizeEstimate aSizeEstimate
end function

class CDynArray
  private Chunk ' Array of any
  private ChunkSize
  private ChunkFill

  property Get LastIx
    LastIx = ChunkFill - 1
  end property

  property Get Size
    Size = ChunkFill
  end property

  private sub Class_Initialize()
    Clear
  end sub

  sub Clear()
    Chunk = Array()
    ChunkSize = 0
    ChunkFill = 0
  end sub

  sub SetSizeEstimate( aSize )
    ' give a hint how big the array could grow, if you know
    ' clears the DynArray!
    ' require aSize > 0
    ChunkSize = aSize
    redim Chunk( ChunkSize-1 )
    ChunkFill = 0
  end sub

  private sub EnlargeArray()
    dim increment
    ' resize chunk
    increment = ChunkSize
    if increment < CDA_MIN_CHUNK_SIZE then increment = CDA_MIN_CHUNK_SIZE
    if increment > CDA_MAX_CHUNK_INCREMENT then increment = CDA_MAX_CHUNK_INCREMENT
    ChunkSize = ChunkSize + increment
    redim preserve Chunk(ChunkSize-1)
  end sub

  sub AddItem( aItem )
    ' assert ChunkFill <= ChunkSize
    if ChunkFill = ChunkSize then EnlargeArray
    ' assert ChunkFill < ChunkSize
    Chunk(ChunkFill) = aItem
    ChunkFill = ChunkFill + 1
  end sub

  sub AddObject( aObject )
    ' use this function for object type items instead of AddItem()
    ' assert ChunkFill <= ChunkSize
    if ChunkFill = ChunkSize then EnlargeArray
    ' assert ChunkFill < ChunkSize
    set Chunk(ChunkFill) = aObject
    ChunkFill = ChunkFill + 1
  end sub

  function GetItem( aIx )
    ' require ValidIndex(aIx)
    GetItem = Chunk(aIx)
  end function

  function GetObject( aIx )
    ' use this function for object type items instead of GetItem()
    ' require ValidIndex(aIx)
    set GetObject = Chunk(aIx)
  end function

  function ValidIndex( aIx )
    ValidIndex = (aIx >= 0 and aIx < ChunkFill)
  end function

  function GetArray( bClear )
    ' returns all added items in an array of the correct size
    ' clears the DynArray if bClear is true
    if ChunkSize > ChunkFill then
      redim preserve Chunk( ChunkFill-1 )
      ChunkSize = ChunkFill
    end if
    GetArray = Chunk
    if bClear then Clear
  end function

  function JoinItems( aSep, bClear )
    ' joins all items and returns the resulting big string
    ' clears the DynArray if bClear = true!
    ' note: if bClear is false, the array can be further expanded!
    JoinItems = Join( GetArray(bClear), aSep )
  end function
end class

' appli --------------------------------------------------

class CxLangItem
  public Src
  public Key
  public Text

  private sub Class_Initialize()
    Src = ""
    Key = ""
    Text = ""
  end sub
end class

class CxLangCollection
  private mItems    ' as CDynArray of CxLangItem
  private mItemDict ' as Dictionary of CxLangItem

  private sub Class_Initialize()
    set mItems = NewDynArray(0)
    set mItemDict = Server.CreateObject("Scripting.Dictionary")
    mItemDict.CompareMode = VBTextCompare
  end sub

  sub Clear()
    mItems.Clear
    mItemDict.RemoveAll
  end sub

  sub ParseSrcFile( aPath )
    ' search aPath for xMsg() messages and adds them to mItems if not already there
    dim squot, equot, dquot, qquot, lines, lineNr, i, line, p, item, oldItem, srcName
    dquot = Chr(1)
    squot = Chr(2)
    equot = Chr(3)
    qquot = equot & squot
    lines = Split( FS.ReadFile( aPath ), vbCRLF )
    lineNr = 1
    for i = 0 to UBound(lines)
      ' convert double quots in strings to squot char for easier parsing
      line = lines(i)
      line = ReplacePattern( line, """([^""]*)""", squot & "$1" & equot, false )
      line = Replace( line, qquot, dquot )
      line = Replace( line, squot, """" )
      line = Replace( line, equot, """" )
      p = 1
      do
        set item = ParseNextItem( line, p )
        if not item is Nothing then
          srcName = Replace( aPath, "./", "" )
          item.Key = ReplacePattern( item.Key, "\x01", """", false )
          item.Src = srcName & ": " & lineNr
          ' check if new
          if mItemDict.Exists(item.Key) then
            ' update src
            set oldItem = mItemDict.Item(item.Key)
            if InStr( oldItem.Src, srcName ) then
              oldItem.Src = oldItem.Src & "," & lineNr
            else
              oldItem.Src = oldItem.Src & "; " & item.Src
            end if
          else
            ' insert new item
            mItemDict.Add item.Key, item
            mItems.AddObject item
          end if
        end if
      loop until item is Nothing
      lineNr = lineNr + 1
    next
  end sub

  private function NextNoSpace( aLine, aLen, aPos )
    dim c, l
    NextNoSpace = -1
    while aPos <= aLen
      c = Mid(aLine,aPos,1)
      if c <> " " and c <> Chr(9) then
        NextNoSpace = aPos
        exit function
      end if
      aPos = aPos + 1
    wend
  end function

  private function IsValidItem( aLine, aLen, byRef aPos )
    ' returns position of first String " in aPos if IsValidItem = true
    dim ps, pe, c
    IsValidItem = false
    if aPos <= 0 then exit function
    ps = aPos + 4
    if ps > aLen then exit function
    c = Mid(aLine,ps,1)
    if IsNumeric(c) or c = "D" then
      ps = ps + 1
      if ps > aLen then exit function
    end if
    ps = NextNoSpace( aLine, aLen, ps )
    if ps <= 0 then exit function
    if Mid(aLine,ps,1) <> "(" then exit function
    ps = NextNoSpace( aLine, aLen, ps+1 )
    if ps <= 0 then exit function
    if Mid(aLine,ps,1) <> """" then exit function
    aPos = ps
    IsValidItem = true
  end function

  private function ParseNextItem( aLine, byRef aPos )
    ' parse 'xMsg' [any] '(' '"' [any] '"'
    ' e.g. xMsg("text"), xMsg1("text",var)
    dim ps, pe, l
    l = Len(aLine)
    set ParseNextItem = Nothing
    if aPos <= 0 then exit function
    ps = InStr( aPos, aLine, "xMsg" )
    while ps > 0
      if IsValidItem(aLine,l,ps) then
        ps = ps + 1
        pe = Instr( ps, aLine, """" )
        if pe <= 0 then exit function
        aPos = pe
        set ParseNextItem = new CxLangItem
        ParseNextItem.Key = Mid( aLine, ps, pe-ps )
        exit function
      end if
      ps = InStr( ps+4, aLine, "xMsg" )
    wend
  end function

  sub Load( aPath, bClearSrc )
    ' loads contents of file aPath (textfile) and adds its items
    ' Note: aPath only containes unique keys
    ' use bClearSrc to clear each Src field of the parsed file
    dim lines, item, oldItem, i, line, p, k, v
    lines = Split( FS.ReadFile( aPath ), vbCRLF )
    set item = new CxLangItem
    for i = 0 to UBound(lines)
      line = Trim(lines(i))
      if Len(line) > 0 then
        if Mid(line,1,1) <> "/" then
          p = InStr(line,"=")
          if p > 1 then
            k = Trim(Left(line,p-1))
            v = Trim(Right(line,Len(line)-p))
            if k = "Src" then
              set item = new CxLangItem
              if not bClearSrc then item.Src = v
            elseif k = "Key" then
              item.Key = Unmask(v)
            elseif k = "Txt" then
              item.Text = Unmask(v)
              ' check if new
              if mItemDict.Exists(item.Key) then
                ' update src (Note: keys should not be found more than once at all!)
                if not bClearSrc then
                  set oldItem = mItemDict.Item(item.Key)
                  if Len(oldItem.Src) > 0 then oldItem.Src = oldItemSrc & "; "
                  oldItem.Src = oldItem.Src & item.Src
                end if
              else
                mItemDict.Add item.Key, item
                mItems.AddObject item
              end if
            end if
          end if
        end if
      end if
    next
  end sub

  sub Save( aPath )
    dim file, i, items
    items = mItems.GetArray(false)
    set file = FS.OpenFileForWriting( aPath )
    for i = 0 to UBound(items)
      if Len(items(i).Src) = 0 then
        file.Write "Src = ?" & vbCRLF
      else
        file.Write "Src = " & items(i).Src & vbCRLF
      end if
      file.Write "Key = " & Mask(items(i).Key) & vbCRLF
      file.Write "Txt = " & Mask(items(i).Text) & vbCRLF
      file.Write vbCRLF
    next
    file.Close
  end sub

  sub SaveBinary( aPath )
    dim bin
    set bin = new CxLangBinary
    bin.InitFromItemList mItems.GetArray(false)
    bin.Save aPath
  end sub

  private function Mask( aStr )
    ' Mask some special keys and texts to keep blanks and quots like:
    ' [] -> [?]
    ' [ xxx ] -> [" xxx "]
    ' ["xxx"] -> [""xxx""]
    dim cs, ce
    if aStr = "" then
      Mask = "?"
    else
      cs = Mid(aStr,1,1)
      ce = Mid(aStr,Len(aStr),1)
      if cs = " " or cs = """" or ce = " " or ce = """" then
        Mask = """" & aStr & """"
      else
        Mask = aStr
      end if
    end if
  end function

  private function Unmask( aStr )
    dim cs, ce
    if aStr = "?" then
      Unmask = ""
    elseif aStr <> "" then
      cs = Mid(aStr,1,1)
      ce = Mid(aStr,Len(aStr),1)
      if cs = """" and ce = """" then
        Unmask = Mid(aStr,2,Len(aStr)-2)
      else
        Unmask = aStr
      end if
    else
      Unmask = ""
    end if
  end function

end class

class CxLangBinary
  private mKeys  ' Array of String
  private mTexts ' Array of String

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

  sub InitFromItemList( aItems )
    ' aItems as Array of CxLangItem
    dim c, i, k, p
    ' optimize entries: skip entries with no source and make auto translation of entries like "[spec] key" -> "key"
    c = 0
    for i = 0 to UBound(aItems)
      if aItems(i).Src = "" or aItems(i).Src = "?" then
        aItems(i).Text = ""
      else
        if aItems(i).Text = "" then
          ' Auto translate
          k = aItems(i).Key
          if Mid(k,1,1) = "[" then
            p = InStr(k,"]")
            if p > 0 then
              aItems(i).Text = Right(k,Len(k)-p-1)
            end if
          end if
        end if
      end if
      ' count active items (Text <> "")
      if aItems(i).Text <> "" then c = c + 1
    next
    ' redimension
    redim mKeys(c-1)
    redim mTexts(c-1)
    ' fill
    c = 0
    for i = 0 to UBound(aItems)
      if aItems(i).Text <> "" then
        mKeys(c) = aItems(i).Key
        mTexts(c) = aItems(i).Text
        c = c + 1
      end if
    next
    ' sort
    QuickSortX Me
  end sub

  sub Load( aPath )
    ' Require FS.FileExists(aPath)
    dim s, p
    s = FS.ReadFile( aPath )
    p = 1
    mKeys = DataGetStrArray( s, p )
    mTexts = DataGetStrArray( s, p )
  end sub

  sub Save( aPath )
    dim s1, s2
    s1 = DataAddStrArray( "", mKeys )
    s2 = DataAddStrArray( "", mTexts )
    FS.WriteFile aPath, s1 & s2
  end sub

  function Translate( aKey )
    dim i
    i = Find(aKey)
    if i >= 0 then
      Translate = mTexts(i)
      if Len(Translate) = 0 then Translate = aKey
    else
      Translate = aKey
    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)
    if hi < lo then exit function
    last = -1
    curr = CLng((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 = CLng((lo+hi)/2)
    wend
  end function

  ' QuickSortable Interface

  property Get FirstIx()
    FirstIx = 0
  end property

  property Get LastIx()
    LastIx = UBound(mKeys)
  end property

  function Compare(i,j)
    dim a, b
    a = mKeys(i)
    b = mKeys(j)
    Compare = StrComp(a,b,1)
  end function

  sub Exchange(i,j)
    dim tmp
    tmp = mKeys(i)
    mKeys(i) = mKeys(j)
    mKeys(j) = tmp
    tmp = mTexts(i)
    mTexts(i) = mTexts(j)
    mTexts(j) = tmp
  end sub

end class

class CxLangApplication
  private mItems ' as CxLangCollection
  private mInclPattern
  private mExclPattern

  private sub Class_Initialize()
    set mItems = new CxLangCollection
    mInclPattern = FilePatternToRegExPattern(XLANG_INCLUDE_SRC)
    mExclPattern = FilePatternToRegExPattern(XLANG_EXCLUDE_SRC)
  end sub

  sub NewLanguage( aLang )
    dim templateFileName, langFolderName, langFileName
    if not FS.FolderExists(XLANG_FOLDER) then
      MakeTemplate
    end if
    templateFileName = FS.AppendName( XLANG_FOLDER, XLANG_TEMPLATE )
    if not FS.FileExists(templateFileName) then
      MakeTemplate
    end if
    ' assert template file exists
    langFolderName = FS.AppendName( XLANG_FOLDER, aLang )
    if not FS.FolderExists(langFolderName) then
      Response.Write "Creating Language Folder: " & langFolderName & "<br>" & vbCRLF
      Response.Flush
      FS.CreateFolder(langFolderName)
    end if
    langFileName = FS.AppendName( langFolderName, XLANG_TEMPLATE )
    if not FS.FileExists(langFileName) then
      Response.Write "Copying Template File to Language Folder. File is: " & langFileName & "<br>" & vbCRLF
      Response.Flush
      FS.CopyFile templateFileName, langFileName
    else
      Response.Write "Language File already exists: " & langFileName & "<br>" & vbCRLF
      Response.Flush
    end if
  end sub

  sub UpdateLanguage( aLang, bUpdateTemplate )
    dim templateFileName, langFolderName, langFileName
    if bUpdateTemplate then MakeTemplate
    templateFileName = FS.AppendName( XLANG_FOLDER, XLANG_TEMPLATE )
    langFolderName = FS.AppendName( XLANG_FOLDER, aLang )
    if not FS.FolderExists(langFolderName) then
      Response.Write "Language not found: " & aLang & "<br>" & vbCRLF
      Response.Flush
      exit sub
    end if
    langFileName = FS.AppendName( langFolderName, XLANG_TEMPLATE )
    if FS.FileExists(langFileName) then
      Response.Write "Updating Message file: " & langFileName & "<br>" & vbCRLF
      Response.Flush
      mItems.Clear
      mItems.Load langFileName, true
      mItems.Load templateFileName, false
      mItems.Save langFileName
    else
      Response.Write "Creating new Message file: " & langFileName & "<br>" & vbCRLF
      Response.Flush
      FS.CopyFile templateFileName, langFileName
    end if
  end sub

  sub UpdateAll()
    dim langHomeFolder, langFolders, folder
    MakeTemplate
    Response.Write "<br>Updating all Message Files:<br>" & vbCRLF
    Response.Flush
    set langHomeFolder = FS.GetFolder(XLANG_FOLDER)
    set langFolders = langHomeFolder.SubFolders
    for each folder in langFolders
      UpdateLanguage folder.Name, false
    next
  end sub

  sub CompileLanguage( aLang )
    dim langFolderName, langFileName, langBinFileName
    langFolderName = FS.AppendName( XLANG_FOLDER, aLang )
    if not FS.FolderExists(langFolderName) then
      Response.Write "Language not found: " & aLang & "<br>" & vbCRLF
      Response.Flush
      exit sub
    end if
    langFileName = FS.AppendName( langFolderName, XLANG_TEMPLATE )
    if FS.FileExists(langFileName) then
      Response.Write "Compiling Message file: " & langFileName & "<br>" & vbCRLF
      Response.Flush
      mItems.Clear
      mItems.Load langFileName, false
      langBinFileName = FS.AppendName( langFolderName, FS.GetBaseName(XLANG_TEMPLATE) & ".po" )
      mItems.SaveBinary langBinFileName
    else
      Response.Write "Message File not found: " & langFileName & "<br>" & vbCRLF
      Response.Flush
    end if
  end sub

  sub CompileAll()
    dim langHomeFolder, langFolders, folder
    Response.Write "<br>Compiling all Message Files:<br>" & vbCRLF
    Response.Flush
    set langHomeFolder = FS.GetFolder(XLANG_FOLDER)
    set langFolders = langHomeFolder.SubFolders
    for each folder in langFolders
      CompileLanguage folder.Name
    next
  end sub

  sub MakeTemplate()
    dim fileNames, i
    if not FS.FolderExists(XLANG_FOLDER) then
      Response.Write "Creating folder " & XLANG_FOLDER & "<br>" & vbCRLF
      Response.Flush
      FS.CreateFolder(XLANG_FOLDER)
    end if
    fileNames = GetSrcFileNames()
    for i = 0 to UBound(fileNames)
      Response.Write "Parsing " & Replace(fileNames(i),"./","") & "<br>" & vbCRLF
      Response.Flush
      mItems.ParseSrcFile fileNames(i)
    next
    Response.Write "Writing template file " & FS.AppendName( XLANG_FOLDER, XLANG_TEMPLATE ) & "<br>" & vbCRLF
    Response.Flush
    mItems.Save FS.AppendName( XLANG_FOLDER, XLANG_TEMPLATE )
  end sub

  private function GetSrcFileNames()
    dim fileNames
    set fileNames = NewDynArray(0)
    GetSrcFileNamesOfFolder ".", fileNames
    GetSrcFileNames = fileNames.GetArray(false)
  end function

  private sub GetSrcFileNamesOfFolder( aFolder, aFileNamesRet )
    ' returns all matching files names of aFolder and his subfolders recursively in aFileNamesRet
    ' aFolder as String: rel Path
    ' aFileNameret as CDynArray
    dim inclPattern, exclPattern, currFolder, subfolders, folder, files, fileNames, file, fileName

    ' first search for files in current folder
    set currFolder = FS.GetFolder(aFolder)
    set files = currFolder.Files
    for each file in files
      fileName = FS.AppendName( aFolder, file.Name )
      if TestPattern( fileName, mInclPattern, true ) then
        if not TestPattern( fileName, mExclPattern, true ) then
          aFileNamesRet.AddItem fileName
        end if
      end if
    next

    ' recursively scan subfolders for more files
    set subfolders = currFolder.SubFolders
    for each folder in subfolders
      GetSrcFileNamesOfFolder FS.AppendName( aFolder, folder.Name ), aFileNamesRet
    next
  end sub

  private function FilePatternToRegExPattern( aFilePattern )
    dim pat
    pat = aFilePattern
    pat = Replace( pat, ".", "\." )
    pat = Replace( pat, "*", ".*" )
    pat = Replace( pat, ";", "$|^" )
    pat = "^" & pat & "$"
    FilePatternToRegExPattern = pat
  end function
end class

' Main --------------------------------

sub ShowMenu()
  Response.Write "<h1>xlang: Message Translation Admin</h1>" & vbCRLF
  Response.Write "<p>Use this page to manage Message Files which contain translations of application messages.</p>"
  Response.Write "<p>See <a href=""http://walter.bislins.ch/doku/xlang"">xlang Documentation and Download</a>.</p>"
  Response.Write "<form name=""frm"" action=""xlang.asp"" method=""post"">" & vbCRLF

  Response.Write "<h2>Update Message Files</h2>" & vbCRLF
  Response.Write "<p>Scans all source files for xMsg() calls and makes an updated template file (" & FS.AppendName( XLANG_FOLDER, XLANG_TEMPLATE ) & ") containing all actual messages. After that, the messgage files for each language are updated with the new messages found in the source files. You have to translate the new messages and then compile the message files.</p>" & vbCRLF
  Response.Write "<p><input type=""submit"" name=""btnUpdate"" value=""Update Message Files""></p>" & vbCRLF

  Response.Write "<h2>Compile Message Files</h2>" & vbCRLF
  Response.Write "<p>Compiles all Message Files into binary Form. The Binaries are loaded into the application and accessed via xMsg() functions.</p>" & vbCRLF
  Response.Write "<p><input type=""submit"" name=""btnCompile"" value=""Compile Message Files""></p>" & vbCRLF

  Response.Write "<h2>Make New Language</h2>" & vbCRLF
  Response.Write "<p>Setup a new language translation. Copies the Template to the corresponding directory. The contents of this file must then be translated.</p>" & vbCRLF
  Response.Write "<p><input type=""text"" name=""lang"" value=""""> <input type=""submit"" name=""btnNewLang"" value=""New Language""></p>" & vbCRLF

  Response.Write "<h2>Make Template</h2>" & vbCRLF
  Response.Write "<p>Scans all source files for xMsg() calls and makes a template file (" & FS.AppendName( XLANG_FOLDER, XLANG_TEMPLATE ) & ") containing all messages. This template is used to create and update individual translation files for each language.</p>" & vbCRLF
  Response.Write "<p><input type=""submit"" name=""btnMake"" value=""Make Template""></p>" & vbCRLF

  Response.Write "</form>" & vbCRLF
end sub

sub UpdateFiles()
  dim xlang
  Response.Write "<h1>Updating Message Files</h1>" & vbCRLF
  Response.Flush
  set xlang = new CxLangApplication
  xlang.UpdateAll
  Response.Write "done" & vbCRLF
  Response.Write "<p><a href=""xlang.asp"">Back</a></p>" & vbCRLF
  Response.Flush
end sub

sub CompileFiles()
  dim xlang
  Response.Write "<h1>Compiling Message Files</h1>" & vbCRLF
  Response.Flush
  set xlang = new CxLangApplication
  xlang.CompileAll
  Response.Write "done" & vbCRLF
  Response.Write "<p><a href=""xlang.asp"">Back</a></p>" & vbCRLF
  Response.Flush
end sub

sub NewLanguage()
  dim xlang, lang
  lang = LCase(Trim(Request.QueryString("lang")))
  if Len(lang) = 0 then lang = LCase(Trim(Request.Form("lang")))
  if Len(lang) = 0 then
    ShowMenu
    exit sub
  end if
  Response.Write "<h1>Making New Language</h1>" & vbCRLF
  Response.Flush
  set xlang = new CxLangApplication
  xlang.NewLanguage lang
  Response.Write "<p><a href=""xlang.asp"">Back</a></p>" & vbCRLF
  Response.Flush
end sub

sub MakeTemplate()
  dim xlang
  Response.Write "<h1>Making Template</h1>" & vbCRLF
  Response.Flush
  set xlang = new CxLangApplication
  xlang.MakeTemplate
  Response.Write "done" & vbCRLF
  Response.Write "<p><a href=""xlang.asp"">Back</a></p>" & vbCRLF
  Response.Flush
end sub

sub LayoutHead( aThisFile, aPageName )
  Response.Write "<html><head>" & vbCRLF
  Response.Write "<title>" & aPageName & "</title>" & vbCRLF
  Response.Write "</head><body>" & vbCRLF
end sub

sub LayoutFoot()
  Response.Write "</body></html>" & vbCRLF
end sub

sub ProcessPage()
  dim id, op
  on error resume next

  op = Request.QueryString("op")
  if Len(Request.Form("btnUpdate"))  > 0 then op = "update"
  if Len(Request.Form("btnCompile")) > 0 then op = "compile"
  if Len(Request.Form("btnNewLang")) > 0 then op = "new"
  if Len(Request.Form("btnMake"))    > 0 then op = "make"

  LayoutHead "xlang.asp", "xlang: Program Message Translation Module"

  if op = "new" then
    NewLanguage
  elseif op = "update" then
    UpdateFiles
  elseif op = "compile" then
    CompileFiles
  elseif op = "make" then
    MakeTemplate
  else
    ShowMenu
  end if

  if Err <> 0 then
    Response.Write "<h4>Error:</h4><p>" & Err.Description & "</p>" & vbCRLF
    Err.Clear
  end if

  LayoutFoot
end sub

'stop
ProcessPage
%>