Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Удаление одинаковых кнопок со всех панелей инструментов ТС 
Author Message
Flasher



PostPosted: Tue Nov 10, 2015 09:09    Post subject: Reply with quote

ice_daemon, пару точек таки пропустил. Smile

Помозговал я тут, вот что получилось (тестировать сперва на копиях):
Code:
'============================= VBS ==============================
' Удалить с панелей инструментов кнопку по коду из буфера обмена

' Параметры: "<путь к каталогу c BAR-файлами>" <имена BAR-файлов>
' Пример:    "%%COMMANDER_PATH%%\ButtonBars" Default.bar User.bar

' Автор - Flasher ©
'================================================================

Option Explicit
Dim Arg, Cnt, WSH, C, K, Clip, Keys, FSO, Path, Src, FPath, Chek

Set Arg = WScript.Arguments : Cnt = Arg.Count
If Cnt < 2 Then Msg "Укажите не менее 2-х параметров!", 4144
C = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
Set WSH = CreateObject("WScript.Shell")
With WSH
  On Error Resume Next
  K = .RegRead(C) : If K > 0 Or Err.Number <> 0 Then .RegWrite C, 0, "REG_DWORD"
  Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
  If K > 0 Then .RegWrite C, K, "REG_DWORD"
  On Error Goto 0
End With
If Trim(Clip) = "" Then _
Msg "Буфер обмена не содержит текстовых данных!", 4144
C = Split(Clip, vbNewLine) : If C(0) <> "TOTALCMD#BAR#DATA" Then _
Msg    "В буфере обмена отсутствует код кнопки!", 4144

With New RegExp
  .Global = True : .Pattern = "([\$\(\)\*\+\.\[\?\^\{\|\\])"
  For K = 1 to 6
    C(K) = .Replace(C(K), "\$1")
    If Left(C(K), 1) = """" Then C(K) = """" & C(K) & """"
  Next : .Global = False
End With : Keys = "(cmd|param|button|menu|path|iconic)"
Set FSO = CreateObject("Scripting.FileSystemObject")
Path = WSH.ExpandEnvironmentStrings(Arg(0))
Src  = "^(Buttoncount=)[1-9][0-9]*$"
For K = 1 To Cnt - 1
  FPath = FSO.BuildPath(Path, Arg(K))
  If FSO.FileExists(FPath) Then Repl FPath, Chek
Next : If Chek Then _
Msg "Кнопка удалена со всех заданных панелей инструментов!", 4160
Msg  "Кнопка отсутствует на заданных панелях инстурментов!", 4144

Sub Msg(Text, Num)
  MsgBox Text, Num, " Удаление кнопки c панелей инструментов ТС      "
  WScript.Quit
End Sub

Sub Repl(BarFile, Test)
  Dim All, Count, n, i
  All = FSO.OpenTextFile(BarFile).ReadAll
  With New RegExp
    .Multiline = True : .Pattern = Src
    Count = Split(.Execute(All)(0),"=")(1)
    For n = 1 To Count
      .Pattern = "^cmd" & n & "=" & C(1) & "$"
      If .Test(All) Or C(1) = "" Then
        .Pattern = "^param" & n & "=" & C(2) & "$"
        If .Test(All) Or C(2) = "" Then
          .Pattern = "^button" & n & "=" & C(3) & "$"
          If .Test(All) Or C(3) = "" Then
            .Pattern = "^menu" & n & "=" & C(4) & "$"
            If .Test(All) Or C(4) = "" Then
              .Pattern = "^path" & n & "=" & C(5) & "$"
              If .Test(All) Or C(5) = "" Then
                .Pattern = "^iconic" & n & "=" & C(6) & "$"
                If .Test(All) Or C(6) = "" Then
                  .Pattern = Src : All = .Replace(All, "$1" & Count - 1)
                  .Global = True : .Pattern = "(\r?\n|^)" & Keys & n & "=.*$"
                  All = .Replace(All, "") : Test = 1
                  For i = n + 1 To Count
                    .Pattern = "^" & Keys & i & "(=.*)$"
                    All = .Replace(All, "$1" & i - 1 & "$2")
                  Next : Count = Count - 1 : .Global = False
                End If
              End If
            End If
          End If
        End If
      End If
    Next
    If Test Then
      With FSO.OpenTextFile(BarFile, 2) : .Write All : .Close : End With
    End If
  End With
End Sub

_________________
Автору сборки TC Image (Andrey_A) настоятельно рекомендуется не распространять на иных ресурсах любую предоставленную мной где-либо техническую информацию по автоматизации и оптимизации в работе с ТС и системой.
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group