Attribute VB_Name = "MDescriptions"
Option Explicit

Const sSrcPath = "f:\temp\VBCCR_RUS\VBCCR_STDEXE\Builds\"
'Const sSrcPath = "f:\temp\VBCCR_RUS\VBFLEX_STDEXE\Builds\"

Type type_Descr
   File        As String
   Path        As String
   Sub         As String
   TypeOfSub   As String
   Description As String
   FileId      As Long
   TypeId      As Long
End Type

Type type_File
   File        As String
   Path        As String
End Type

Sub Main()
'   On Error Resume Next
     
   Dim aDirs()    As String         'Directories of controls
   Dim D          As Integer        'Directories counter
   Dim sCurDir    As String         'Current directory
   
   Dim aFiles()   As type_File      'cls, ctl and pag files
   Dim F          As Integer        'Files counter
   Dim sCurFile   As String         'Current file
   Dim nSrcFile   As Integer        'Source file (number)
   Dim nTmpFile   As Integer        'Temporary file (number)
   Dim bFilChang  As Boolean        'File was changed
   
   Dim aStrings() As type_Descr     'Strings with descriptions
   Dim S          As Integer        'Strings counter
   Dim sCurString As String         'Current string of file
   
   Dim sMainDB    As String         'Database path
   Dim oDBEngine  As Object         'DAO.DBEngine
   Dim oWorkspase As Object         'DAO.Workspace
   Dim oBase      As Object         'DAO.Database
   Dim t_DESCR    As Object         'DAO.Recordset
   
   ReDim aDirs(1 To 100)
   sCurDir = Dir$(sSrcPath, vbDirectory)
   D = 1
   Do While LenB(sCurDir)                         'Filling aDirs array
      If sCurDir <> "." And sCurDir <> ".." Then
         If (GetAttr(sSrcPath & sCurDir) And vbDirectory) = vbDirectory Then
            aDirs(D) = sSrcPath & sCurDir
            D = D + 1
         End If
      End If
      sCurDir = Dir$
   Loop
   If D > 1 Then ReDim Preserve aDirs(1 To D - 1)
   
   ReDim aFiles(1 To 300)
   F = 1
   For D = LBound(aDirs) To UBound(aDirs)         'Filling aFiles array
      sCurFile = Dir$(aDirs(D) & "\*")
      Do While LenB(sCurFile)
         If sCurFile Like "*.[c][lt][sl]" Then
            aFiles(F).File = sCurFile
            aFiles(F).Path = aDirs(D) & "\"
            F = F + 1
         End If
         sCurFile = Dir$
      Loop
   Next
   If LenB(Dir$(sSrcPath & "CommonDialog.cls")) Then
      aFiles(F).Path = sSrcPath
      aFiles(F).File = "CommonDialog.cls"
      If F > 1 Then ReDim Preserve aFiles(1 To F)
   Else
      If F > 1 Then ReDim Preserve aFiles(1 To F - 1)
   End If
   ReDim aDirs(0)
   
   sMainDB = App.Path & "\vbccr.mdb"              'Opening database
   If LenB(Dir$(sMainDB)) = 0 Then
      Exit Sub
   Else
      'Set oDBEngine = New DAO.DBEngine
      Set oDBEngine = CreateObject("DAO.DBEngine.36")
      Set oWorkspase = oDBEngine.Workspaces(0)
      Set oBase = oWorkspase.OpenDatabase(sMainDB, True)
      Set t_DESCR = oBase.OpenRecordset("t_DESCR")
   End If
   
   ReDim aStrings(1 To 6000)
   S = 1
   For F = LBound(aFiles) To UBound(aFiles)       'Replasing strings
      nSrcFile = FreeFile
      Open aFiles(F).Path & aFiles(F).File For Input As #nSrcFile
      nTmpFile = FreeFile
      Open aFiles(F).Path & aFiles(F).File & ".tmp" For Output As #nTmpFile
      bFilChang = False
         Do While Not EOF(nSrcFile)
            Line Input #nSrcFile, sCurString
            If sCurString Like "*Public *(*)*" Then
               Print #nTmpFile, sCurString
               sCurString = Right$(sCurString, Len(sCurString) - 7)
               sCurString = Left$(sCurString, InStr(1, sCurString, "(") - 1)
               aStrings(S).TypeOfSub = Left$(sCurString, InStrRev(sCurString, " ") - 1)
               aStrings(S).Sub = Right$(sCurString, Len(sCurString) - InStrRev(sCurString, " "))
               aStrings(S).File = aFiles(F).File
               aStrings(S).Path = aFiles(F).Path
            ElseIf sCurString Like "*.VB_Description*" _
            And sCurString Like "*Attribute " & aStrings(S).Sub & ".VB_Description =*" Then
               sCurString = Right$(sCurString, Len(sCurString) - InStr(1, sCurString, ".VB_Description =") - 18)
               aStrings(S).Description = Left$(sCurString, Len(sCurString) - 1)
               With t_DESCR
                  .Index = "SUB_DESCR"
                  .Seek "=", aStrings(S).Description
                  If Not .NoMatch Then
                     If !SUB_TRANSL <> aStrings(S).Description Then
                        aStrings(S).Description = !SUB_TRANSL
                        bFilChang = True
                     End If
                  End If
               End With
               Print #nTmpFile, "Attribute " & aStrings(S).Sub & ".VB_Description = """ & aStrings(S).Description & """"
               S = S + 1
            Else
               Print #nTmpFile, sCurString
            End If
         Loop
      Close #nTmpFile, #nSrcFile
      If bFilChang Then
         FileCopy aFiles(F).Path & aFiles(F).File & ".tmp", aFiles(F).Path & aFiles(F).File
      End If
      Kill aFiles(F).Path & aFiles(F).File & ".tmp"
   Next
   If S > 1 Then ReDim Preserve aStrings(1 To S - 1)
   ReDim aFiles(0)
      
   t_DESCR.Close
   Set t_DESCR = Nothing
   oBase.Close
   Set oBase = Nothing
   oWorkspase.Close
   Set oWorkspase = Nothing
   Set oDBEngine = Nothing
   
End Sub