Translations/ShellExtension/CreateTranslatedRcFiles.vbs

   1 Option Explicit
   2 ''
   3 ' This script creates the translated RC files for the shell extension.
   4 '
   5 ' Copyright (C) 2007-2009 by Tim Gerundt
   6 ' Released under the "GNU General Public License"
   7 '
   8 ' ID line follows -- this is updated by SVN
   9 ' $Id: CreateTranslatedRcFiles.vbs 6780 2009-05-23 11:58:54Z gerundt $
  10
  11 Const ForReading = 1
  12
  13 Const NO_BLOCK = 0
  14 Const STRINGTABLE_BLOCK = 1
  15
  16 Const PATH_SHELLEXTTEMPLATE_RC = "../../ShellExtension/Languages/ShellExtensionTemplate.rc"
  17
  18 Dim oFSO, oCharsets, bRunFromCmd
  19
  20 Set oFSO = CreateObject("Scripting.FileSystemObject")
  21
  22 bRunFromCmd = False
  23 If LCase(oFSO.GetFileName(Wscript.FullName)) = "cscript.exe" Then
  24   bRunFromCmd = True
  25 End If
  26
  27 Set oCharsets = CreateObject("Scripting.Dictionary")
  28 oCharsets.Add "932", "Shift_JIS"
  29 oCharsets.Add "936", "GB2312"
  30 oCharsets.Add "949", "EUC-KR"
  31 oCharsets.Add "950", "BIG5"
  32 oCharsets.Add "1250", "Windows-1250"
  33 oCharsets.Add "1251", "Windows-1251"
  34 oCharsets.Add "1252", "Windows-1252"
  35 oCharsets.Add "1253", "Windows-1253"
  36 oCharsets.Add "1254", "Windows-1254"
  37 oCharsets.Add "1256", "Windows-1256"
  38 oCharsets.Add "1257", "Windows-1257"
  39
  40 Call Main
  41
  42 ''
  43 ' ...
  44 Sub Main
  45   Dim oLanguages, sLanguage
  46   Dim oLanguageTranslations, sLanguagePoFilePath
  47   Dim StartTime, EndTime, Seconds
  48   Dim sCharset
  49
  50   StartTime = Time
  51
  52   InfoBox "Warning: " & Wscript.ScriptName & " can take several seconds to finish!", 3
  53
  54   Set oLanguages = GetLanguages
  55   For Each sLanguage In oLanguages.Keys 'For all languages...
  56     If (bRunFromCmd = True) Then 'If run from command line...
  57       Wscript.Echo sLanguage
  58     End If
  59     Set oLanguageTranslations = GetTranslationsFromPoFile(oLanguages(sLanguage), sCharset)
  60     If (oLanguageTranslations.Count > 0) Then 'If translations exists...
  61       CreateRcFileWithTranslations PATH_SHELLEXTTEMPLATE_RC, "../../ShellExtension/Languages/ShellExtension" & sLanguage & ".rc", oLanguageTranslations, sCharset
  62     End If
  63   Next
  64
  65   EndTime = Time
  66   Seconds = DateDiff("s", StartTime, EndTime)
  67
  68   InfoBox Wscript.ScriptName & " finished after " & Seconds & " seconds!", 3
  69 End Sub
  70
  71 ''
  72 ' ...
  73 Function GetLanguages()
  74   Dim oLanguages, oFile
  75
  76   Set oLanguages = CreateObject("Scripting.Dictionary")
  77
  78   For Each oFile In oFSO.GetFolder(".").Files 'For all files in the current folder...
  79     If (LCase(oFSO.GetExtensionName(oFile.Name)) = "po") Then 'If a PO file...
  80       oLanguages.Add oFSO.GetBaseName(oFile.Name), oFile.Path
  81     End If
  82   Next
  83   Set GetLanguages = oLanguages
  84 End Function
  85
  86 ''
  87 ' ...
  88 Function GetTranslationsFromPoFile(ByVal sPoPath, sCharset)
  89   Dim oTranslations, oTextFile, sLine
  90   Dim oMatch, iMsgStarted, sMsgId, sMsgStr
  91   Dim reMsgId, reMsgStr, reMsgContinued, reCharset
  92
  93   Set reMsgId = New RegExp
  94   reMsgId.Pattern = "^msgid ""(.*)""$"
  95   reMsgId.IgnoreCase = True
  96
  97   Set reMsgStr = New RegExp
  98   reMsgStr.Pattern = "^msgstr ""(.*)""$"
  99   reMsgStr.IgnoreCase = True
 100
 101   Set reMsgContinued = New RegExp
 102   reMsgContinued.Pattern = "^""(.*)""$"
 103   reMsgContinued.IgnoreCase = True
 104
 105   '
 106   sCharset = "_autodetect"
 107   Set reCharset = New RegExp
 108   reCharset.Pattern = "harset.*CP(.*)\\n""$"
 109   reCharset.IgnoreCase = True
 110   Set oTextFile = oFSO.OpenTextFile(sPoPath, ForReading)
 111   Do Until oTextFile.AtEndOfStream 'For all lines...
 112     sLine = Trim(oTextFile.ReadLine)
 113     If reCharset.Test(sLine) Then
 114       Set oMatch = reCharset.Execute(sLine)(0)
 115       sCharset = oCharsets(oMatch.SubMatches(0))
 116       Exit Do
 117     End If
 118   Loop
 119   oTextFile.Close
 120
 121   Set oTranslations = CreateObject("Scripting.Dictionary")
 122
 123   If (oFSO.FileExists(sPoPath) = True) Then 'If the PO file exists...
 124     iMsgStarted = 0
 125     sMsgId = ""
 126     sMsgStr = ""
 127     Set oTextFile = CreateObject("ADODB.Stream")
 128     oTextFile.Type = 2 ' adTypeText
 129     oTextFile.LineSeparator = 10 ' adLF
 130     oTextFile.Charset = sCharset
 131     oTextFile.Open
 132     oTextFile.LoadFromFile(sPoPath)
 133     Do Until oTextFile.EOS 'For all lines...
 134       sLine = oTextFile.ReadText(-2) ' -2 = adReadLine
 135       If Len(sLine) > 0 Then
 136         If Right(sLine, 1) = vbCR Then
 137           sLine = Left(sLine, Len(sLine) - 1)
 138         End If
 139       End If
 140       sLine = Trim(sLine)
 141
 142       If (sLine <> "") Then 'If NOT empty line...
 143         If (Left(sLine, 1) <> "#") Then 'If NOT comment line...
 144           '--------------------------------------------------------------------------------
 145           ' Note: We must replace \" temporary with FormFeed and convert them later to ""
 146           '--------------------------------------------------------------------------------
 147           sLine = Replace(sLine, "\""", vbFormFeed)
 148           If reMsgId.Test(sLine) Then 'If "msgid"...
 149             iMsgStarted = 1
 150             Set oMatch = reMsgId.Execute(sLine)(0)
 151             sMsgId = oMatch.SubMatches(0)
 152           ElseIf reMsgStr.Test(sLine) Then 'If "msgstr"...
 153             iMsgStarted = 2
 154             Set oMatch = reMsgStr.Execute(sLine)(0)
 155             sMsgStr = oMatch.SubMatches(0)
 156           ElseIf reMsgContinued.Test(sLine) Then 'If "msgid" or "msgstr" continued...
 157             Set oMatch = reMsgContinued.Execute(sLine)(0)
 158             If (iMsgStarted = 1) Then
 159               sMsgId = sMsgId & oMatch.SubMatches(0)
 160             ElseIf (iMsgStarted = 2) Then
 161               sMsgStr = sMsgStr & oMatch.SubMatches(0)
 162             End If
 163           End If
 164           sMsgId = Replace(sMsgId, vbFormFeed, """""")
 165           sMsgStr = Replace(sMsgStr, vbFormFeed, """""")
 166         End If
 167       Else 'If empty line
 168         iMsgStarted = 0
 169       End If
 170
 171       If (iMsgStarted = 0) Then 'If NOT inside a translation...
 172         If (sMsgId <> "") And (sMsgStr <> "") And (sMsgId <> sMsgStr) Then 'If translated...
 173           oTranslations.Add sMsgId, sMsgStr
 174         End If
 175         sMsgId = ""
 176         sMsgStr = ""
 177       End If
 178     Loop
 179     If (sMsgId <> "") And (sMsgStr <> "") And (sMsgId <> sMsgStr) Then 'If translated...
 180       oTranslations.Add sMsgId, sMsgStr
 181     End If
 182     oTextFile.Close
 183   End If
 184   Set GetTranslationsFromPoFile = oTranslations
 185 End Function
 186
 187 ''
 188 ' ...
 189 Sub CreateRcFileWithTranslations(ByVal sMasterRcPath, ByVal sLanguageRcPath, ByVal oTranslations, sCharset)
 190   Dim oMasterRcFile, sMasterLine
 191   Dim oLanguageRcFile, sLanguageLine
 192   Dim iBlockType, oMatches, oMatch, sMsgId, sMsgStr
 193   Dim reAfxTarg, reLanguage, reCodePage, reString, sTemp
 194
 195   Set reAfxTarg = New RegExp
 196   reAfxTarg.Pattern = "defined\((AFX_TARG_\w*)\)"
 197   reAfxTarg.IgnoreCase = True
 198
 199   Set reLanguage = New RegExp
 200   reLanguage.Pattern = "LANGUAGE (LANG_\w*, SUBLANG_\w*)"
 201   reLanguage.IgnoreCase = True
 202
 203   Set reCodePage = New RegExp
 204   reCodePage.Pattern = "code_page\(([\d]+)\)"
 205   reCodePage.IgnoreCase = True
 206
 207   Set reString = New RegExp
 208   reString.Pattern = """(.*?)"""
 209   reString.IgnoreCase = True
 210
 211   If (oFSO.FileExists(sMasterRcPath) = True) Then 'If the master RC file exists...
 212     iBlockType = NO_BLOCK
 213     Set oMasterRcFile = oFSO.OpenTextFile(sMasterRcPath, ForReading)
 214     Set oLanguageRcFile = CreateObject("ADODB.Stream")
 215     oLanguageRcFile.Type = 2 ' adTypeText
 216     oLanguageRcFile.LineSeparator = -1 ' adCRLF
 217     oLanguageRcFile.Charset = sCharset
 218     oLanguageRcFile.Open
 219     Do Until oMasterRcFile.AtEndOfStream = True 'For all lines...
 220       sMasterLine = oMasterRcFile.ReadLine
 221       sLanguageLine = sMasterLine
 222       sMasterLine = Trim(sMasterLine) 'Save Masterline trimmed!
 223
 224       If (sMasterLine = "STRINGTABLE") Then 'STRINGTABLE...
 225         iBlockType = STRINGTABLE_BLOCK
 226       ElseIf (sMasterLine = "BEGIN") Then 'BEGIN...
 227         'IGNORE FOR SPEEDUP!
 228       ElseIf (sMasterLine = "END") Then 'END...
 229         If (iBlockType = STRINGTABLE_BLOCK) Then 'If inside stringtable...
 230           iBlockType = NO_BLOCK
 231         End If
 232       ElseIf (Left(sMasterLine, 2) = "//") Then 'If comment line...
 233         'IGNORE FOR SPEEDUP!
 234       ElseIf (sMasterLine <> "") Then 'If NOT empty line...
 235         Select Case iBlockType
 236           Case NO_BLOCK:
 237             If reAfxTarg.Test(sMasterLine) Then 'AFX_TARG_*...
 238               Set oMatch = reAfxTarg.Execute(sMasterLine)(0)
 239               sMsgId = oMatch.SubMatches(0)
 240               If (sMsgId <> "") And (oTranslations.Exists(sMsgId) = True) Then 'If translation located...
 241                 sMsgStr = oTranslations(sMsgId)
 242                 sLanguageLine = Replace(sLanguageLine, "defined(" & sMsgId, "defined(" & sMsgStr)
 243               End If
 244             ElseIf reLanguage.Test(sMasterLine) Then 'LANGUAGE...
 245               Set oMatch = reLanguage.Execute(sMasterLine)(0)
 246               sMsgId = oMatch.SubMatches(0)
 247               If (sMsgId <> "") And (oTranslations.Exists(sMsgId) = True) Then 'If translation located...
 248                 sMsgStr = oTranslations(sMsgId)
 249                 sLanguageLine = Replace(sLanguageLine, "LANGUAGE " & sMsgId, "LANGUAGE " & sMsgStr)
 250               End If
 251             ElseIf reCodePage.Test(sMasterLine) Then 'code_page...
 252               Set oMatch = reCodePage.Execute(sMasterLine)(0)
 253               sMsgId = oMatch.SubMatches(0)
 254               If (sMsgId <> "") And (oTranslations.Exists(sMsgId) = True) Then 'If translation located...
 255                 sMsgStr = oTranslations(sMsgId)
 256                 sLanguageLine = Replace(sLanguageLine, "code_page(" & sMsgId & ")", "code_page(" & sMsgStr & ")")
 257               End If
 258             End If
 259
 260           Case STRINGTABLE_BLOCK:
 261             If (InStr(sMasterLine, """") > 0) Then 'If quote found (for speedup)...
 262               '--------------------------------------------------------------------------------
 263               ' Note: We must replace "" temporary with FormFeed...
 264               '--------------------------------------------------------------------------------
 265               sTemp = Replace(sMasterLine, """""", vbFormFeed)
 266               If reString.Test(sTemp) Then 'String...
 267                 Set oMatches = reString.Execute(sTemp)
 268                 For Each oMatch In oMatches 'For all strings...
 269                   sMsgId = Replace(oMatch.SubMatches(0), vbFormFeed, """""")
 270                   If (sMsgId <> "") And (oTranslations.Exists(sMsgId) = True) Then 'If translation located...
 271                     sMsgStr = oTranslations(sMsgId)
 272                     sLanguageLine = Replace(sLanguageLine, """" & sMsgId & """", """" & sMsgStr & """")
 273                   End If
 274                 Next
 275               End If
 276             End If
 277
 278         End Select
 279       End If
 280       oLanguageRcFile.WriteText sLanguageLine, 1
 281     Loop
 282     oMasterRcFile.Close
 283     WScript.Echo sLanguageRcPath
 284     oLanguageRcFile.SaveToFile sLanguageRcPath, 2
 285     oLanguageRcFile.Close
 286   End If
 287 End Sub
 288
 289 ''
 290 ' ...
 291 Function InfoBox(ByVal sText, ByVal iSecondsToWait)
 292   Dim oShell
 293
 294   If (bRunFromCmd = False) Then 'If run from command line...
 295     Set oShell = Wscript.CreateObject("WScript.Shell")
 296     InfoBox = oShell.Popup(sText, iSecondsToWait, Wscript.ScriptName, 64)
 297   Else 'If NOT run from command line...
 298     Wscript.Echo sText
 299   End If
 300 End Function