1) Исправления в связи со сменой API MySQL
[openlib.git] / www / tools / export_file.txt
1 '   Output a file\r
2 '   If there is no translation then we output the line as a comment\r
3 '   that starts with #EN# indicating that translation is required\r
4 \r
5 \r
6 Sub Export_File(sType, iCol As Integer)\r
7 \r
8     Dim oFile As Integer\r
9     Dim iRow As Integer\r
10     Dim iBlankLines As Integer\r
11     Dim sLangCode As String\r
12     Dim sOut As String\r
13     Dim sTemp As String\r
14     Dim bOut() As Byte\r
15     Dim shSheet As Worksheet: Set shSheet = Worksheets(sType)\r
16     \r
17     sFilename = sType & "_" & LCase$(shSheet.Cells(cLanguageCodeRow, iCol).Value) & ".json"\r
18     oFile = FreeFile()\r
19     sFullPath = Application.ActiveWorkbook.Path & "\" & sFilename\r
20     On Error Resume Next\r
21     Kill sFullPath\r
22     Open sFullPath For Output As #oFile\r
23     Close #oFile\r
24     On Error GoTo 0\r
25     Open sFullPath For Binary Access Write As #oFile\r
26     ' Output comment on version as first line\r
27     sOut = "{" & vbCrLf\r
28     bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)\r
29     Put #oFile, , bOut\r
30     \r
31     iRow = cFirstDataRow\r
32     Do\r
33         sTemp = shSheet.Cells(iRow, cKeywordCol).Value\r
34         sOut = "// " & sTemp\r
35 '        Print #oFile, sTemp;\r
36         If Len(sTemp) = 0 Then\r
37             iBlankLines = iBlankLines + 1\r
38         Else\r
39             iBlankLines = 0\r
40             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
41                 sOut = """" & sTemp & """" & ":"\r
42 '                Print #oFile, "=";\r
43                 sTemp = shSheet.Cells(iRow, iCol).Value\r
44                 If Len(sTemp) > 0 Then\r
45                     sOut = sOut & """" & sTemp & ""","\r
46                     sOut = sOut & vbCrLf\r
47                     bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)\r
48                     Put #oFile, , bOut\r
49 '                    Print #oFile, sTemp;\r
50                 Else\r
51                     ' If no language specific one supplied then\r
52                     ' output English one as a comment starting with '#EN#'\r
53                     ' (as long this is not the english column with empty value)\r
54                     If iCol <> cEnglishLangCol Then\r
55                         sOut = "// EN" & sOut\r
56                     End If\r
57                     sOut = sOut & shSheet.Cells(iRow, 3).Value\r
58 '                    Print #oFile, shSheet.Cells(iRow, 3).Value;\r
59                 End If\r
60             End If\r
61         End If\r
62 '        Print #oFile, ""        ' Force new line\r
63         iRow = iRow + 1\r
64     Loop Until (iBlankLines > 5)\r
65     \r
66     sOut = """fin"":""fin""" & vbCrLf & "}" & vbCrLf\r
67     bOut = UnicodeToBytes(Worksheets(cConfiguration).Cells(cOutputFormatRow, cOutputFormatCol), sOut)\r
68     Put #oFile, , bOut\r
69     \r
70     Close #oFile\r
71 End Sub\r