'#Reference {3F4DACA7-160D-11D2-A8E9-00104B365C9F}#1.0#0#C:\WINNT\System32\vbscript.dll\2#Microsoft VBScript Regular Expressions 1.0
'#Reference {420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINNT\System32\scrrun.dll#Microsoft Scripting Runtime
'#Reference {F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0#C:\WINNT\System32\COMDLG32.OCX#Microsoft Common Dialog Control 6.0 (SP3)
''Read Microsoft Glossary files and
''convert them to a PASSOLO Glossary file

'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND
'EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
'OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE

Option Explicit
Private Function SelectLanguage As Integer

	Dim lngs(139) As String
	Dim lngi(139) As Integer, i As Integer

 	lngi(00) = pslLangAfrikaans
	lngi(01) = pslLangAlbanian
	lngi(02) = pslLangArabicSaudiArabia
	lngi(03) = pslLangArabicIraq
	lngi(04) = pslLangArabicEgypt
	lngi(05) = pslLangArabicLibya
	lngi(06) = pslLangArabicAlgeria
	lngi(07) = pslLangArabicMorocco
	lngi(08) = pslLangArabicTunisia
	lngi(09) = pslLangArabicOman
	lngi(10) = pslLangArabicYemen
	lngi(11) = pslLangArabicSyria
	lngi(12) = pslLangArabicJordan
	lngi(13) = pslLangArabicLebanon
	lngi(14) = pslLangArabicKuwait
	lngi(15) = pslLangArabicUAE
	lngi(16) = pslLangArabicBahrain
	lngi(17) = pslLangArabicQatar
	lngi(18) = pslLangArmenian
	lngi(19) = pslLangAssamese
	lngi(20) = pslLangAzeriLatin
	lngi(21) = pslLangAzeriCyrillic
	lngi(22) = pslLangBasque
	lngi(23) = pslLangBelarusian
	lngi(24) = pslLangBengali
	lngi(25) = pslLangBulgarian
	lngi(26) = pslLangCatalan
	lngi(27) = pslLangChineseTraditional
	lngi(28) = pslLangChineseSimplified
	lngi(29) = pslLangChineseHongkong
	lngi(30) = pslLangChineseSingapore
	lngi(31) = pslLangChineseMacau
	lngi(32) = pslLangCzech
	lngi(33) = pslLangDanish
	lngi(34) = pslLangDutchHolland
	lngi(35) = pslLangDutchBelgian
	lngi(36) = pslLangEnglishUSA
	lngi(37) = pslLangEnglishUK
	lngi(38) = pslLangEnglishAustralia
	lngi(39) = pslLangEnglishCanada
	lngi(40) = pslLangEnglishNewZealand
	lngi(41) = pslLangEnglishEire
	lngi(42) = pslLangEnglishSouthAfrica
	lngi(43) = pslLangEnglishJamaica
	lngi(44) = pslLangEnglishCaribbean
	lngi(45) = pslLangEnglishBelize
	lngi(46) = pslLangEnglishTrinidad
	lngi(47) = pslLangEnglishZimbabwe
	lngi(48) = pslLangEnglishPhilippines
	lngi(49) = pslLangEstonian
	lngi(50) = pslLangFaeroese
	lngi(51) = pslLangFarsi
	lngi(52) = pslLangFinnish
	lngi(53) = pslLangFrench
	lngi(54) = pslLangFrenchBelgian
	lngi(55) = pslLangFrenchCanadian
	lngi(56) = pslLangFrenchSwiss
	lngi(57) = pslLangFrenchLuxembourg
	lngi(58) = pslLangFrenchMonaco
	lngi(59) = pslLangGeorgian
	lngi(60) = pslLangGerman
	lngi(61) = pslLangGermanSwiss
	lngi(62) = pslLangGermanAustrian
	lngi(63) = pslLangGermanLuxembourg
	lngi(64) = pslLangGermanLiechtenstein
	lngi(65) = pslLangGreek
	lngi(66) = pslLangGujarati
	lngi(67) = pslLangHebrew
	lngi(68) = pslLangHindi
	lngi(69) = pslLangHungarian
	lngi(70) = pslLangIcelandic
	lngi(71) = pslLangIndonesian
	lngi(72) = pslLangItalian
	lngi(73) = pslLangItalianSwiss
	lngi(74) = pslLangJapanese
	lngi(75) = pslLangKannada
	lngi(76) = pslLangKashmiriIndia
	lngi(77) = pslLangKazak
	lngi(78) = pslLangKonkani
	lngi(79) = pslLangKorean
	lngi(80) = pslLangLatvian
	lngi(81) = pslLangLithuanian
	lngi(82) = pslLangLithuanianClassic
	lngi(83) = pslLangMacedonian
	lngi(84) = pslLangMalayMalaysia
	lngi(85) = pslLangMalayBruneiDarussalam
	lngi(86) = pslLangMalayalam
	lngi(87) = pslLangManipuri
	lngi(88) = pslLangMarathi
	lngi(89) = pslLangNepaliIndia
	lngi(90) = pslLangNorwegianBokmal
	lngi(91) = pslLangNorwegianNynorsk
	lngi(92) = pslLangOriya
	lngi(93) = pslLangPolish
	lngi(94) = pslLangPortuguese
	lngi(95) = pslLangPortugueseBrazilian
	lngi(96) = pslLangPunjabi
	lngi(97) = pslLangRomanian
	lngi(98) = pslLangRussian
	lngi(99) = pslLangSanskrit
 	lngi(100) = pslLangSerboCroatianLatin
	lngi(101) = pslLangSerboCroatianCyrillic
	lngi(102) = pslLangSindhi
	lngi(103) = pslLangSlovak
	lngi(104) = pslLangSlovenian
	lngi(105) = pslLangSpanishCastilian
	lngi(106) = pslLangSpanishMexico
	lngi(107) = pslLangSpanishModern
	lngi(108) = pslLangSpanishGuatemala
	lngi(109) = pslLangSpanishCostaRica
	lngi(110) = pslLangSpanishPanama
	lngi(111) = pslLangSpanishDomRepublic
	lngi(112) = pslLangSpanishVenezuela
	lngi(113) = pslLangSpanishColombia
	lngi(114) = pslLangSpanishPeru
	lngi(115) = pslLangSpanishArgentina
	lngi(116) = pslLangSpanishEcuador
	lngi(117) = pslLangSpanishChile
	lngi(118) = pslLangSpanishUruguay
	lngi(119) = pslLangSpanishParaguay
	lngi(120) = pslLangSpanishBolivia
	lngi(121) = pslLangSpanishElSalvador
	lngi(122) = pslLangSpanishHonduras
	lngi(123) = pslLangSpanishNicaragua
	lngi(124) = pslLangSpanishPuertoRico
	lngi(125) = pslLangSwahili
	lngi(126) = pslLangSwedish
	lngi(127) = pslLangSwedishFinland
	lngi(128) = pslLangTamil
	lngi(129) = pslLangTatar
	lngi(130) = pslLangTelugu
	lngi(131) = pslLangThai
	lngi(132) = pslLangTurkish
	lngi(133) = pslLangUkrainian
	lngi(134) = pslLangUrduPakistan
	lngi(135) = pslLangUrduIndia
	lngi(136) = pslLangUzbekLatin
	lngi(137) = pslLangUzbekCyrillic
	lngi(138) = pslLangVietnamese

	For i = 0 To 138
		lngs(i) = PSL.GetLangCode( lngi(i), pslCodeText)
	Next i

	Begin Dialog UserDialog 470,119,"PASSOLO" ' %GRID:10,7,1,1
		DropListBox 20,35,310,70,lngs(),.lng
		Text 20,14,320,14,"Select target language of the Microsoft glossary",.Text1
		OKButton 370,14,90,21
		CancelButton 370,42,90,21
	End Dialog

	Dim dlg As UserDialog
	Dim rts As Integer

	rts = Dialog( dlg)

	If rts = -1 Then
		SelectLanguage = lngi(dlg.lng)
	Else
		SelectLanguage = 0
	End If
End Function


Private Function ExtractString( src As String, Key As String) As String
	Dim s As String, k As String
	Dim p As Integer

	' Delete last comma
	s = Left( src, Len(src) - 1)

	' Delete Quotes
	If Left(s, 1) = Chr(34) Then
		s = Left( s, Len(s) - 1)
		s = Right( s, Len(s) - 1)
	End If

	' Replace Tabs
	s = Replace( s, vbTab, "\t")

	' Delete last comma
	If Len(Key) > 1 Then
		k = Left( Key, Len(Key) - 1)
	End If

	' Insert Ampersand at hotkey position
	If Len(k) = 1 Then
    	p = InStr(1, s, k)
       	If p = 1 Then
			s = "&" & s
        ElseIf p > 0 Then
            s = Left(s, p - 1) & "&" & Right(s, Len(s) - p + 1)
        End If
    End If
	ExtractString = s
End Function

Sub Main
	' Read MS Glossary file name
	Dim dlg As MSComDlg.CommonDialog
	Set dlg = New MSComDlg.CommonDialog

	dlg.DialogTitle = "Select Microsoft Glossary file"
	dlg.Filter = "Microsoft Glossary File (*.csv)|*.csv"
	dlg.Flags = cdlOFNExplorer
    dlg.ShowOpen

	Dim fname As String, path As String
	fname = dlg.FileName

	' Select target language
	Dim trglng As Integer
	trglng = SelectLanguage

	' Create file system objects
    Dim fso As FileSystemObject
    Dim fil As File
    Dim fin As TextStream, fout As TextStream
	Set fso = CreateObject("Scripting.FileSystemObject")

	' Open csv file as ASCII (MBCS) for reading
	Set fil = fso.GetFile(fname)
	Set fin = fil.OpenAsTextStream(ForReading, TristateFalse)
	' Read two lines (no content)
    fin.ReadLine
    fin.ReadLine

	' Open glo file for writing
	fname = Replace( fname, ".csv", ".glo")
	Set fout = fso.CreateTextFile( fname)
	fout.WriteLine( "9 1" & vbTab & trglng Mod &H400 & " " & trglng \ &H400)

	' Process all strings in MS glossary file
	Dim lns As Long
	lns = 0
	While Not fin.AtEndOfStream
		Dim s As String, src As String, trg As String, Key As String
		Dim pos As Integer, quote As Integer
		s = fin.ReadLine

		' Extract strings with regular expression
		Dim re As RegExp
		Dim coll As MatchCollection
		Set re = New RegExp
		' re.Pattern = """([^""\\]*(\\.[^""\\]*)*)"",?|([^,]+),?|,"
		re.Pattern = "([^"",]*|""([^""]|"""")+"")(,|$)"
		re.IgnoreCase = True
		re.Global = True
		Set coll = re.Execute(s)

		' Test if we have 4 items
		If coll.Count >= 4 Then
			' Add short cuts to strings
			src = ExtractString( coll.Item(0), coll.Item(1))
			trg = ExtractString( coll.Item(2), coll.Item(3))

			' Write Strings to glossary
	        fout.WriteLine src & vbTab & trg
	    End If

		lns = lns + 1
	Wend

	' Close files
	fin.Close
 	fout.Close

 	' End message
 	MsgBox "New " & PSL.GetLangCode( trglng, pslCodeText) & " glossary generated." & vbCrLf & lns & " lines written to PASSOLO glossary file" & vbCrLf & fname, vbOkOnly, "PASSOLO"
End Sub
