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