1) Исправления в связи со сменой API MySQL
[openlib.git] / www / tools / export_file.txt
diff --git a/www/tools/export_file.txt b/www/tools/export_file.txt
new file mode 100644 (file)
index 0000000..f706a7f
--- /dev/null
@@ -0,0 +1,71 @@
+'   Output a file\r
+'   If there is no translation then we output the line as a comment\r
+'   that starts with #EN# indicating that translation is required\r
+\r
+\r
+Sub Export_File(sType, iCol As Integer)\r
+\r
+    Dim oFile As Integer\r
+    Dim iRow As Integer\r
+    Dim iBlankLines As Integer\r
+    Dim sLangCode As String\r
+    Dim sOut As String\r
+    Dim sTemp As String\r
+    Dim bOut() As Byte\r
+    Dim shSheet As Worksheet: Set shSheet = Worksheets(sType)\r
+    \r
+    sFilename = sType & "_" & LCase$(shSheet.Cells(cLanguageCodeRow, iCol).Value) & ".json"\r
+    oFile = FreeFile()\r
+    sFullPath = Application.ActiveWorkbook.Path & "\" & sFilename\r
+    On Error Resume Next\r
+    Kill sFullPath\r
+    Open sFullPath For Output As #oFile\r
+    Close #oFile\r
+    On Error GoTo 0\r
+    Open sFullPath For Binary Access Write As #oFile\r
+    ' Output comment on version as first line\r
+    sOut = "{" & vbCrLf\r
+    bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)\r
+    Put #oFile, , bOut\r
+    \r
+    iRow = cFirstDataRow\r
+    Do\r
+        sTemp = shSheet.Cells(iRow, cKeywordCol).Value\r
+        sOut = "// " & sTemp\r
+'        Print #oFile, sTemp;\r
+        If Len(sTemp) = 0 Then\r
+            iBlankLines = iBlankLines + 1\r
+        Else\r
+            iBlankLines = 0\r
+            If Not isComment(sTemp) And (Not (sTemp Like "config*") Or sTemp Like "config.Language*") And Not sTemp Like "gui*" And Not sTemp Like "error*" And Not sTemp Like "info*" And Not sTemp Like "stats*" Then\r
+                sOut = """" & sTemp & """" & ":"\r
+'                Print #oFile, "=";\r
+                sTemp = shSheet.Cells(iRow, iCol).Value\r
+                If Len(sTemp) > 0 Then\r
+                    sOut = sOut & """" & sTemp & ""","\r
+                    sOut = sOut & vbCrLf\r
+                    bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)\r
+                    Put #oFile, , bOut\r
+'                    Print #oFile, sTemp;\r
+                Else\r
+                    ' If no language specific one supplied then\r
+                    ' output English one as a comment starting with '#EN#'\r
+                    ' (as long this is not the english column with empty value)\r
+                    If iCol <> cEnglishLangCol Then\r
+                        sOut = "// EN" & sOut\r
+                    End If\r
+                    sOut = sOut & shSheet.Cells(iRow, 3).Value\r
+'                    Print #oFile, shSheet.Cells(iRow, 3).Value;\r
+                End If\r
+            End If\r
+        End If\r
+'        Print #oFile, ""        ' Force new line\r
+        iRow = iRow + 1\r
+    Loop Until (iBlankLines > 5)\r
+    \r
+    sOut = """fin"":""fin""" & vbCrLf & "}" & vbCrLf\r
+    bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)\r
+    Put #oFile, , bOut\r
+    \r
+    Close #oFile\r
+End Sub\r