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: [REQ] Меню пуск на button bar!!! 
Author Message
Batya



PostPosted: Mon Oct 19, 2009 23:04    Post subject: Reply with quote

flm wrote:
Это просто описание процедуры, которая должна выполняться, чтоб получался необходимый результат.

Я, всё таки, думаю, что такую процедуру должен для себя определять программист, а не пользователь.

flm wrote:
какие службы должны быть запущены в системе, чтоб отрабатывали скрипты?

Ничего специально делать не надо. В винде всё работатет по умолчанию. Работоспособность может отъехать только, если с виндой проводить нестандартные действия.

flm wrote:
мне не удалось запустить скрипт

В папке TC необходимо создать папку "Bars".
Также представленный по ссылке скрипт выполнен под английскую винду.
Переделал под русскую винду:
Code:
'=======================================================================================
' Создание в каталоге TC панели, содержащей Главное меню (Start Menu)
' Для вызова из TC необходимо в качестве параметра передать число:
'   0   - скрипт отработает один раз
'   > 0 - скрипт будет висеть в памяти и обновлять панель через данное число миллисекунд
' При вызове скрипта без параметра будет изменено значение ключа в реестре,
'   что остановит работу скрипта, висящего в памяти
'=======================================================================================
Option Explicit
Dim MyKey, WSH, StartMenuFile, FolderIconFile, BarsFolder, ExitButton, ExitIconFile
Dim StartMenuPath, UnknowTypeIcon
Set WSH = WScript.CreateObject("WScript.Shell")
'========== Изменяемые параметры =======================================================
MyKey   = "HKCU\Software\BatyaSoft\RunningMyScript" 'Ключ в реестре
StartMenuFile  = "startmenu.bar"                    'Имя основного файла панели
'Иконка для папок на панели:
FolderIconFile = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\TOTALCMD.EXE,1"
'Папка в каталоге TC для формирования вложенных bar:
BarsFolder     = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\Bars"
'Признак формирования кнопки выхода на предыдущую панель - 0 или 1
ExitButton     = 1
'Иконка для кнопки выхода на предыдущую панель:
ExitIconFile   = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\TOTALCMD.EXE,10"
'Иконка для файлов неизвестных типов:
UnknowTypeIcon = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\TOTALCMD.EXE,9"
'=======================================================================================
If WScript.Arguments.Count = 0 Then
  WSH.RegWrite MyKey, "False"
  Set WSH = Nothing
  WScript.Quit
End If
If IsNumeric(WScript.Arguments(0)) = True Then
  Dim FSO, DelFiles
  Const ForWriting = 2, Hidden = 2
  If WScript.Arguments(0) = 0 Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(BarsFolder) Then FSO.CreateFolder BarsFolder
    If FSO.GetFolder(BarsFolder).Files.Count > 0 Then
      FSO.DeleteFile(BarsFolder & "\*.*")
    End If
    ScanningStartMenu
  End If
  If WScript.Arguments(0) > 0 Then
    Dim MykeyValue
    MykeyValue = True
    WSH.RegWrite MyKey, MykeyValue
    Do While MykeyValue
      FSO.DeleteFile(BarsFolder & "\*.*")
      ScanningStartMenu
      WScript.Sleep WScript.Arguments(0)
      MykeyValue = WSH.RegRead(MyKey)
    Loop
  End If
End If

Set WSH = Nothing
WScript.Quit

Function ScanningStartMenu
  Dim F, AUSM, CUSM, AUSP, CUSP, Menu, n, i, RegTree
  RegTree  = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\"
  Set CUSM = FSO.GetFolder(WSH.RegRead(RegTree & "Programs"))
  Set CUSP = FSO.GetFolder(WSH.RegRead(RegTree & "Start Menu"))
  RegTree  = "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\"
  Set AUSM = FSO.GetFolder(WSH.RegRead(RegTree & "Common Programs"))
  Set AUSP = FSO.GetFolder(WSH.RegRead(RegTree & "Common Start Menu"))
  StartMenuPath = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\" & StartMenuFile
  n = 0
  For Each Menu in AUSM.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      n = n + 1
    End If
  Next
  For Each Menu in CUSM.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      n = n + 1
    End If
  Next
  For Each Menu in AUSP.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      n = n + 1
    End If
  Next
  For Each Menu in CUSP.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      n = n + 1
    End If
  Next
  Set F = FSO.OpenTextFile(StartMenuPath, ForWriting, True)
  n = n + AUSM.SubFolders.Count + CUSM.SubFolders.Count + AUSP.SubFolders.Count + CUSP.SubFolders.Count - 1
  If ExitButton = 1 Then
    n = n + 2
  End If
  F.WriteLine "[Buttonbar]"
  F.WriteLine "Buttoncount=" & n
  i = 0
  If ExitButton = 1 Then
    F.WriteLine "button1=" & ExitIconFile
    F.WriteLine "cmd1="    & WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\DEFAULT.BAR"
    F.WriteLine "menu1="   & "Назад"
    F.WriteLine "button2="
    i = 2
  End If
  For Each Menu in AUSM.SubFolders
'    If Menu.Name <> "Programs" Then
    If Menu.Name <> "Программы" Then
      i = i + 1
      ProcessFolder F, Menu, i, StartMenuPath
    End If
  Next
  For Each Menu in CUSM.SubFolders
'    If Menu.Name <> "Programs" Then
    If Menu.Name <> "Программы" Then
      i = i + 1
      ProcessFolder F, Menu, i, StartMenuPath
    End If
  Next
  For Each Menu in AUSM.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      i = i + 1
      ProcessFile F, Menu, i
    End If
  Next
  For Each Menu in CUSM.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      i = i + 1
      ProcessFile F, Menu, i
    End If
  Next
  i = i + 1
  F.WriteLine "button" & i & "="
  For Each Menu in AUSP.SubFolders
    i = i + 1
    ProcessFolder F, Menu, i, StartMenuPath
  Next
  For Each Menu in CUSP.SubFolders
    i = i + 1
    ProcessFolder F, Menu, i, StartMenuPath
  Next
  For Each Menu in AUSP.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      i = i + 1
      ProcessFile F, Menu, i
    End If
  Next
  For Each Menu in CUSP.Files
    If (Menu.Attributes and Hidden) <> Hidden Then
      i = i + 1
      ProcessFile F, Menu, i
    End If
  Next
  F.Close

  Set Menu = Nothing
  Set F    = Nothing
  Set AUSM = Nothing
  Set CUSM = Nothing
  Set AUSP = Nothing
  Set CUSP = Nothing
  Set FSO  = Nothing
End Function

Function ProcessFolder(OTF, SubFold, j, SM)
  Dim k, NewBar
  NewBar = BarsFolder & "\" & SubFold.Name & ".bar"
  If FSO.FileExists(NewBar) Then
    k = 1
    NewBar = BarsFolder & "\" & SubFold.Name & k & ".bar"
    While FSO.FileExists(NewBar)
      k = k + 1
      NewBar = BarsFolder & "\" & SubFold.Name & k & ".bar"
    Wend
  End If
  OTF.WriteLine "button" & j & "=" & FolderIconFile
  OTF.WriteLine "cmd"    & j & "=" & NewBar
  OTF.WriteLine "menu"   & j & "=" & SubFold.Name
  OTF.WriteLine "iconic" & j & "=1"

  Dim F1, Menu1, n1
  Set F1 = FSO.OpenTextFile(NewBar, ForWriting, True)
  n1 = 0
  For Each Menu1 in SubFold.Files
    If (Menu1.Attributes and Hidden) <> Hidden Then
      n1 = n1 + 1
    End If
  Next
  n1 = n1 + SubFold.SubFolders.Count
  F1.WriteLine "[Buttonbar]"
  If ExitButton = 1 Then
    F1.WriteLine "Buttoncount=" & n1 + 2
    F1.WriteLine "button1=" & ExitIconFile
    F1.WriteLine "cmd1="    & SM
    F1.WriteLine "menu1="   & "Назад"
    F1.WriteLine "iconic1=" & "1"
    F1.WriteLine "button2="
    k = 2
  Else
    F1.WriteLine "Buttoncount=" & n1
    k = 0
  End If
  For Each Menu1 in SubFold.SubFolders
    k = k + 1
    ProcessFolder F1, Menu1, k, NewBar
  Next
  For Each Menu1 in SubFold.Files
    If (Menu1.Attributes and Hidden) <> Hidden Then
      k = k + 1
      ProcessFile F1, Menu1, k
    End If
  Next
  F1.Close
  Set Menu1 = Nothing
  Set F1    = Nothing
End Function

Function ProcessFile(OTF, oFile, j)
  If LCase(FSO.GetExtensionName(oFile.Path)) = "lnk" Then
    Dim Lnk
    Set Lnk = WSH.CreateShortcut(oFile.Path)
    If Lnk.IconLocation <> ",0" Then
      Dim LnkPath
      LnkPath = Lnk.IconLocation
      LnkPath = Left(LnkPath, InStrRev(LnkPath, ",") - 1)
      If FSO.FileExists(LnkPath) Then
        Dim Ext
        Ext = LCase(FSO.GetExtensionName(LnkPath))
        If Not (Ext = "exe" or Ext = "dll" or Ext = "ico" or Ext = "icl") Then
          OTF.WriteLine "button" & j & "=" & FileIcon(LnkPath)
        Else
          OTF.WriteLine "button" & j & "=" & Lnk.IconLocation
        End IF
      Else
        OTF.WriteLine "button" & j & "=" & Lnk.IconLocation
      End IF
    Else
      OTF.WriteLine "button" & j & "=" & FileIcon(Lnk.TargetPath)
    End If
    OTF.WriteLine   "cmd"    & j & "=" & oFile.Path
    OTF.WriteLine   "menu"   & j & "=" & FSO.GetBaseName(oFile.Path)
    If Lnk.WorkingDirectory <> "" Then
      OTF.WriteLine "path"   & j & "=" & Lnk.WorkingDirectory
    End If
    Set Lnk = Nothing
  Else
    OTF.WriteLine "button" & j & "=" & FileIcon(oFile.Path)
    OTF.WriteLine "cmd"    & j & "=" & oFile.Path
    OTF.WriteLine "menu"   & j & "=" & FSO.GetBaseName(oFile.Path)
  End If
End Function

Function FileIcon(FilePath)
  Dim Ext
  Ext = LCase(FSO.GetExtensionName(FilePath))
  If Not (Ext = "exe" or Ext = "dll" or Ext = "ico" or Ext = "icl") Then
    On Error Resume Next
    FileIcon = WSH.RegRead("HKCR\" & WSH.RegRead("HKCR\." & Ext & "\") & "\DefaultIcon\")
    If Err.Number <> 0 Then
      FileIcon = UnknowTypeIcon
    End If
    On Error GoTo 0
  Else
    FileIcon = FilePath
  End If
  If FileIcon = "%1" or FileIcon = """%1""" Then
    FileIcon = "%SystemRoot%\system32\url.dll,0"
  End If
End Function

_________________
Нет, я не сплю. Я просто медленно моргаю.


Last edited by Batya on Tue Oct 20, 2009 10:58; edited 1 time in total
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group