MakeDicGroups.vbs

' Group single direction dictionary remover for Lingvo X5
' by Pasha ZZZ v1.0 2011-06-24

Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const IniGroup = "Group:", IniDict = "Dictionary:"
Const CSIDL_LOCAL_APPDATA = &h1C, CSIDL_COMMON_APPDATA = &h23

Dim WSH, WSEnv, FSO, IniFN, IniF, IniS, S, S1, S2, S3, IsGroupMulti, Arr1, Arr2, A, D
Dim DicCnt, DDicCnt, SGrpCnt, MGrpCnt, CUAD, eCUN, AUAD, IniFound, ShApp

Set ShApp = CreateObject("Shell.Application")
Set WSH = WScript.CreateObject("WScript.Shell")
Set WSEnv = WSH.Environment("PROCESS")

eCUN = WSEnv("USERNAME")

AUAD = ShApp.Namespace(CSIDL_COMMON_APPDATA).Self.Path & "\ABBYY\Lingvo\15.0\Dic\dictconf.ini"
CUAD = ShApp.Namespace(CSIDL_LOCAL_APPDATA).Self.Path & "\ABBYY\Lingvo\15.0\Dic\dictconf.ini"

IniS = ""

Set FSO = CreateObject("Scripting.FileSystemObject")

IniFound = 0
If FSO.FileExists(AUAD) Then IniFound = 1
If FSO.FileExists(CUAD) Then IniFound = IniFound + 2

IniFN = ""

Select Case IniFound
Case 1
  A = MsgBox("Найден файл конфигурации для всех пользователей:" & Chr(13) & AUAD & Chr(13) & Chr(13) & "Удалить в нем одноязычные словари с мультиязычных полок?", vbOKCancel + vbQuestion, "Обнаружен файл конфигурации")
  If A = 1 Then IniFN = AUAD
Case 2
  A = MsgBox("Найден файл конфигурации для текущего пользователя (" & eCUN & "):" & Chr(13) & CUAD & Chr(13) & Chr(13) & "Удалить в нем одноязычные словари с мультиязычных полок?", vbOKCancel + vbQuestion, "Обнаружен файл конфигурации")
  If A = 1 Then IniFN = CUAD
Case 3
  A = MsgBox("Найден файл конфигурации для всех пользователей:" & Chr(13) & AUAD & Chr(13) & Chr(13) & "Найден файл конфигурации для текущего пользователя (" & eCUN & "):" & Chr(13) & CUAD & Chr(13) & Chr(13) & "Да - удалить одноязычные словари с многоязычных полок в файле для всех пользователей" & Chr(13) & "Нет - удалить одноязычные словари с многоязычных полок в файле для текущего пользователя", vbYesNoCancel + vbQuestion, "Обнаружены 2 файла конфигурации")
  If A = 6 Then IniFN = AUAD Else If A = 7 Then IniFN = CUAD
End Select

If Len(IniFN) = 0 Then
  If IniFound = 0 Then
    MsgBox "Выполнение программы прервано:" & Chr(13) & "не найдены файлы конфигурации полок/словарей." & Chr(13) & Chr(13) & "Установите Lingvo X5 и запустите хотя бы 1 раз!", vbCritical, "Файлы конфигурации не найдены"
  Else
    MsgBox "Выполнение программы прервано." & Chr(13) & "Изменения не произведены.", vbCritical, "Остановлено пользователем"
  End If
  WScript.Quit
End If

Set IniF = FSO.OpenTextFile(IniFN, ForReading, False, TristateTrue)

IsGroupMulti = False
DicCnt = 0
DDicCnt = 0
SGrpCnt = 0
MGrpCnt = 0
Do Until IniF.AtEndOfStream
  S = Trim(IniF.ReadLine)
  If Len(S)>0 And Left(S, 1)<>";" Then
    If Left(S, 1)="[" Then
      IsGroupMulti = False
      S1 = Mid (S, 2, InStr(S, "]") - 2)
      If Left(S1, Len(IniDict))=IniDict Then DicCnt = DicCnt + 1
      If Left(S1, Len(IniGroup))=IniGroup Then
        Arr1 = Split(Right(S1, Len(S1) - Len(IniGroup)), "-")
        If Arr1(0)<>Arr1(1) Then
          IsGroupMulti = True
          MGrpCnt = MGrpCnt + 1
        Else
          SGrpCnt = SGrpCnt + 1
        End If
      End If
    Else
      If IsGroupMulti Then
        S1 = Left(S, InStr(S, "="))
        S2 = ""
        Arr1 = Split(Trim(Right(S, Len(S) - Len(S1))), ";")
        For A = 0 To UBound(Arr1)
          D = InStrRev(Arr1(A), "(")
          Arr2 = Split(Mid(Arr1(A), D + 1, InStrRev(Arr1(A), ")") - D - 1), "-")
          If Arr2(0)<>Arr2(1) Then S2 = S2 + Arr1(A) + ";" Else DDicCnt = DDicCnt + 1
        Next
        If Len(S2)>0 Then S = S1 + Left(S2, Len(S2) - 1) Else S = "; " + S1 + "<no dictionaries for this group>"
      End If
    End If
  End If
  IniS = IniS + S + ChrW(13) + ChrW(10)
Loop
IniF.Close

If DDicCnt>0 Then
  If FSO.FileExists(IniFN & ".org") Then FSO.DeleteFile IniFN & ".org", True
  FSO.MoveFile IniFN, IniFN & ".org"
  Set IniF = FSO.CreateTextFile(IniFN, True, True)
  IniF.Write(IniS)
  IniF.Close
  MsgBox "Найдено всего полок словарей: " & CStr(MGrpCnt + SGrpCnt) & Chr(13) & " - из них одноязычных - " & CStr(SGrpCnt) & Chr(13) & " - мультиязычных - " & CStr(MGrpCnt) & Chr(13) & Chr(13) & "Найдено словарей всего: " & CStr(DicCnt) & Chr(13) & "Удалено словарей с полок: " & CStr(DDicCnt), vbOKOnly + vbInformation, "Изменение конфигурации завершено"
Else
  MsgBox "Найдено всего полок словарей: " & CStr(MGrpCnt + SGrpCnt) & Chr(13) & " - из них одноязычных - " & CStr(SGrpCnt) & Chr(13) & " - мультиязычных - " & CStr(MGrpCnt) & Chr(13) & Chr(13) & "Найдено словарей всего: " & CStr(DicCnt) & Chr(13) & "Лишних словарей на полках не найдено!", vbOKOnly + vbExclamation, "Конфигурация не изменена"
End If