from vb2py.vbfunctions import *
from vb2py.vbdebug import *
import ExcelAPI.XLA_Application as X02
import pattgen.M09_Language
import pattgen.M01_Public_Constants_a_Var as M01
import pattgen.M30_Tools as M30
import mlpyproggen.Pattern_Generator as PG

""" Add missing language specific strings in the VBA code to the "Languages" sheet
 The program parses all VBA Modules for the command "Get_Language_Str("

 The following files are processed:
  - *.bas: normal VBA files
  - *.cls: Classes (all sheets and "DieseArbeitsmappe")
  - *.frm: VBA code of the dialoges
 The *.frx files are not processed because they contaim

 The source code files are generated by "Export_Code.xlsm"

 The function "Add_All_VBA_Strings_to_the_Languages_Sheet()" must be called
 manually to update the list of language strings.

 *.Cls and *.frm files contain some internal ines which are not shown in the VB Editor
-------------------------------------------------------------------------------
-------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------
-------------------------------------------------------------------------------
 Das zerlegen ist gar nicht so einfach ;-(
 - Das erste Argument der "Get_Language_Str()" Funktion ist ein String.
 - Ein String kann aus mehreren über "&" zusammengesetzten Strings besten
 - Ein String kann direkt angegeben werden: "Hallo"
   oder eine String Konstante sein. Hier wird aber nur "vbcr" unterstützt.
 - Die Liste kann sich auch über mehrere Code Zeilen erstrecken wenn ein
   "_" ganz am Ende der Zeile steht.
 - In einer Zeile können mehrere "Get_Language_Str()" Aufrufe stehen
 Ablauf:
 1. String verarbeiten (Der String kann auch erst in der nächsten Zeile kommen '_')
 2. Prüfen ob ein weiterer String kommt '&' Ja => 1
 3. Das Ende muss erreicht sein: ',' oder ')'
----------------------------------------------------------------------------------------
---------------------------------------------------------------------------------
-------------------------------------------------------------------------
-------------------------------------------------------------------------------
----------------------------------------------------------
-------------------------------------------------------
"""

VBA_Modul_Name = String()
AddedCnt = Long()
Internal_Lines = Long()

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: ResStr - ByRef 
def Load_File_in_String(FileName, ResStr):
    _fn_return_value = None
    fp = Integer()
    #-------------------------------------------------------------------------------
    fp = FreeFile()
    # VB2PY (UntranslatedCode) On Error GoTo ErrProc
    VBFiles.openFile(fp, FileName, 'r') 
    ResStr = Input(LOF(fp), fp)
    VBFiles.closeFile(fp)
    # VB2PY (UntranslatedCode) On Error GoTo 0
    _fn_return_value = True
    return _fn_return_value
    X02.MsgBox('Error reading \'' + FileName + '\'', vbCritical, 'Error reading file in \'Load_File_in_String\'')
    return _fn_return_value

def Get_LineStr(p_str, Pos):
    _fn_return_value = None
    Start = Long()

    EndLine = Long()
    #-------------------------------------------------------
    Start = InStrRev(p_str, vbCr, Pos) + 1
    EndLine = InStr(Pos, p_str, vbCr)
    if EndLine == 0:
        EndLine = Len(p_str)
    _fn_return_value = Mid(p_str, Start, EndLine - Start)
    return _fn_return_value

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: Pos - ByVal 
def Get_LineNumber(p_str, Pos):
    _fn_return_value = None
    LineCnt = Long()

    Cnt2 = Long()
    #------------------------------------------------------------------------
    LineCnt = 0
    while 1:
        Start = InStrRev(p_str, vbCr, Pos)
        if Start > 0:
            LineCnt = LineCnt + 1
            Pos = Start - 1
            if Pos == 0:
                break
        else:
            break
        if not (True):
            break
    _fn_return_value = LineCnt
    return _fn_return_value

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: Name - ByVal 
def Set_Internal_Lines(p_str, Name):
    global Internal_Lines
    Pos = Long()
    #------------------------------------------------------------------
    if LCase(Right(Name, 4)) == '.cls' or LCase(Right(Name, 4)) == '.frm':
        Pos = InStrRev(p_str, 'Attribute VB_Exposed')
        Internal_Lines = Get_LineNumber(p_str, Pos)
        # Stimmt nicht immer ganz genau => Egal
    else:
        Internal_Lines = 0

def Add_String_if_Missing(LangStr, p_str, Pos):
    global AddedCnt
    #-------------------------------------------------------------------------------
    if LangStr != '':
        Row = pattgen.M09_Language.Find_Language_Str_Row(LangStr)
        if Row == 0:
            Sh = PG.ThisWorkbook.Sheets(M01.LANGUAGES_SH)
            # 29.04.20: Added: ThisWorkbook to hopefully prevent problems at startup
            DstRow = M30.LastUsedRowIn(M01.LANGUAGES_SH) + 1
            _with79 = Sh
            _with79.CellDict[DstRow, pattgen.M09_Language.LangType_Col] = 'VBA'
            _with79.CellDict[DstRow, pattgen.M09_Language.LangParamCol] = VBA_Modul_Name + ' ' + Get_LineNumber(p_str, Pos) - Internal_Lines
            _with79.CellDict[DstRow, pattgen.M09_Language.FirstLangCol] = '\'' + LangStr
            AddedCnt = AddedCnt + 1
            Debug.Print('Adding string: \'' + LangStr + '\'')
            # Debug

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: Start - ByRef 
def Proc_Quotation_Mark_String(Start, p_str):
    _fn_return_value = None
    #----------------------------------------------------------------------------------------
    while 1:
        QPos = InStr(Start, p_str, '"')
        if QPos == 0:
            X02.MsgBox('Error: Expected ending quotation mark in line:' + vbCr + Get_LineStr(p_str, QPos), vbCritical)
            return _fn_return_value
        if Mid(p_str, QPos + 1, 1) == '"':
            # Second quotation mark ? => Quotation mark within a string ?
            _fn_return_value = Proc_Quotation_Mark_String() + Mid(p_str, Start, QPos - Start + 1)
            Start = QPos + 2
        else:
            # End of the string
            _fn_return_value = Proc_Quotation_Mark_String() + Mid(p_str, Start, QPos - Start)
            Start = QPos + 1
            return _fn_return_value
        if not (True):
            break
    return _fn_return_value

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: Start - ByRef 
def Get_Constant_String(Start, p_str):
    _fn_return_value = None
    Known_Constant_Strings = vbCr + 'vbCr' + vbTab + '|' + vbLf + vbCr + 'vbLf' + vbTab + vbLf + vbCr + 'StdDescStart' + vbTab + 'Mit diesem Blatt kann die Konfiguration' + vbCr + 'o.ControlTipText' + vbTab + '' + vbCr

    EndStr1 = Long()

    EndStr2 = Long()
    #---------------------------------------------------------------------------------
    # List of known constants which is replaced. Each entry has two elements.
    # 1. The search string
    # 2. The replace text
    # They are separaed by vbTab.
    # vbCr is used to depatate the lines.
    EndStr1 = InStr(Start, p_str, ' ')
    EndStr2 = InStr(Start, p_str, ')')
    if EndStr1 == 0 and EndStr2 == 0:
        Debug.Print('Wrong line:' + vbCr + Get_LineStr(p_str, Start), 'Press Ctrl+Break to debug')
        X02.MsgBox('Error: End not found in \'Get_Constant_String()', vbCritical)
        # Should never happen
        Start = Start + 1
    else:
        # Set EndStr1 to the first occourence of
        # ' or ')'
        if EndStr1 == 0:
            EndStr1 = EndStr2
        if EndStr2 != 0 and EndStr2 < EndStr1:
            EndStr1 = EndStr2
        Name = Mid(p_str, Start, EndStr1 - Start)
        Start = Start + Len(Name)
        Pos = InStr(Known_Constant_Strings, vbCr + Name + vbTab)
        if Pos > 0:
            StartTxt = Pos + 1 + Len(Name) + 1
            EndStr1 = InStr(StartTxt, Known_Constant_Strings, vbCr)
            if EndStr1 == 0:
                X02.MsgBox('Error: \'vbCr\' missing at the end of \'Known_Constant_Strings\'', vbCritical, 'Internal Error')
            else:
                _fn_return_value = Mid(Known_Constant_Strings, StartTxt, EndStr1 - StartTxt)
        else:
            Debug.Print('Wrong line:' + vbCr + Get_LineStr(p_str, Start))
            X02.MsgBox('Unknown constant string: \'' + Name + '\'', vbCritical, 'Press Ctrl+Break to debug')
    return _fn_return_value

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: Start - ByRef 
def Proc_String(Start, p_str):
    _fn_return_value = None
    #-------------------------------------------------------------------------
    if Mid(p_str, Start, 1) == '_':
        while 1:
            Start = Start + 1
            c = Mid(p_str, Start, 1)
            if not (InStr('_ ' + vbCr + vbLf + vbTab, c) > 0):
                break
    if Mid(p_str, Start, 1) == '"':
        Start = Start + 1
        _fn_return_value = Proc_Quotation_Mark_String(Start, p_str)
    else:
        _fn_return_value = Get_Constant_String(Start, p_str)
    return _fn_return_value

# VB2PY (UntranslatedCode) Argument Passing Semantics / Decorators not supported: Pos - ByVal 
def Proc_Get_Language_Str(Pos, p_str):
    _fn_return_value = None
    LangStr = String()
    #-------------------------------------------------------------------------------
    while 1:
        if Mid(p_str, Pos, 1) == ' ':
            Pos = Pos + 1
        # If the first character is a "_" (See: M65_Special_Modules)
        LangStr = LangStr + Proc_String(Pos, p_str)
        if Mid(p_str, Pos, 1) == ' ':
            Pos = Pos + 1
        _select66 = Mid(p_str, Pos, 1)
        if (_select66 == '&'):
            Pos = Pos + 2
        elif (_select66 == ',') or (_select66 == ')'):
            # The "Get_Language_Str()" could have additional optional parameters => End of the string
            # ")" = End of the function detected
            Add_String_if_Missing(LangStr, p_str, Pos)
            _fn_return_value = Pos + 1
            return _fn_return_value
        else:
            Debug.Print('Wrong line:' + vbCr + Get_LineStr(p_str, Pos))
            X02.MsgBox('Error: Unexpected character \'' + Mid(p_str, Pos, 1) + '\' detected after ending quotation mark (Press break and check Debug output)', vbCritical)
            Pos = Pos + 1
            # In case the program is not stopped
        if not (Pos < Len(p_str)):
            break
    return _fn_return_value

def Process_File(VBAName):
    global VBA_Modul_Name
    _fn_return_value = None
    p_str = String()

    Start = Long()

    FPos = Long()
    #UT--------------------------------------------------------
    raise() #*HL byRef issue
    if not Load_File_in_String(VBAName, p_str):
        return _fn_return_value
    VBA_Modul_Name = M30.FileName(VBAName)
    Set_Internal_Lines(p_str, VBAName)
    Start = 1
    while 1:
        FPos = InStr(Start, p_str, 'Get_Language_Str(', vbBinaryCompare)
        if FPos <= 0:
            break
        if Mid(p_str, FPos - Len('Function '), Len('Function ')) == 'Function ':
            # Skip the function definition
            Start = Start + Len('Function Get_Language_Str(')
        else:
            Start = Proc_Get_Language_Str(FPos + Len('Get_Language_Str('), p_str)
        if not (True):
            break
    return _fn_return_value

def Add_All_VBA_Strings_to_the_Languages_Sheet():
    global AddedCnt
    SrcDir = String()

    DateStr = String()

    Res = String()

    Skipped = String()

    Cnt = Long()

    Ext = Variant()

    Extentions = '*.bas *.cls *.frm'
    #UT-----------------------------------------------------
    DateStr = X02.Format(X02.Now, 'DD_MM_YYYY')
    SrcDir = PG.ThisWorkbook.Path + '\\Code_' + M30.FileName(PG.ThisWorkbook.Name) + '_' + DateStr + '\\'
    # Debug with a single file
    #Process_File ThisWorkbook.Path & SrcDir & "M65_Special_Modules.bas":      Exit Sub
    #Process_File ThisWorkbook.Path & SrcDir & "M15_Par_Description.bas":      Exit Sub
    #Process_File ThisWorkbook.Path & SrcDir & "M65_Special_Modules.bas":      Exit Sub
    #Process_File ThisWorkbook.Path & SrcDir & "M07_COM_Port.bas":             Exit Sub
    #Process_File ThisWorkbook.Path & SrcDir & "Test_Main.bas":                Exit Sub
    #Process_File ThisWorkbook.Path & SrcDir & "M08_Load_Sheet_Data.bas":      Exit Sub
    X02.MsgBox('Add all missing text constants in the VBA program to the languages sheet.' + vbCr + vbCr + 'Attention: The program \'Export_Code.xlsm\' must be called to export the source code modules ' + 'to the directory:' + vbCr + '  \'' + SrcDir + '\'', vbInformation)
    AddedCnt = 0
    for Ext in Split(Extentions, ' '):
        Res = Dir(PG.ThisWorkbook.Path + SrcDir + Ext)
        while 1:
            if Res != '':
                if Res == 'M09_Language.bas' or Res == 'M09_Languages_Add.bas':
                    Skipped = Skipped + Res + vbCr
                else:
                    Debug.Print('File: ' + Res)
                    Process_File(PG.ThisWorkbook.Path + SrcDir + Res)
                    Cnt = Cnt + 1
                Res = Dir()
                # Mit Excel für Mac 2016 wird der ursprüngliche Dir-Funktionsaufruf erfolgreich ausgeführt. Nachfolgende Aufrufe zum Durchlaufen des angegebenen Verzeichnisses führen jedoch zu einem Fehler. Dies ist leider ein bekanntes Problem.
            else:
                break
            if not (True):
                break
    if Cnt == 0:
        X02.MsgBox('Error: Directory doesn\'t exist or it dosn\'t contain files:' + vbCr + '  \'' + SrcDir + '\'' + vbCr + vbCr + 'The program \'Export_Code.xlsm\' must be called to export the source code modules ' + 'to the directory.', vbCritical, 'No source files found')
    else:
        X02.MsgBox(AddedCnt + ' strings added to the \'languages\' sheet' + vbCr + Cnt + ' modules processed' + vbCr + vbCr + 'Following modules have been skipped:' + vbCr + Skipped + 'because they contain special \'Get_Language_Str\' calls', vbInformation)

# VB2PY (UntranslatedCode) Option Explicit
