Total Commander

Форум поддержки пользователей Total Commander
https://forum.wincmd.ru/

Создание BAR-файла на основе заданного набора ярлыков

https://forum.wincmd.ru/viewtopic.php?t=5773

Страница 2 из 7

Добавлено: Чт июл 06, 2006 10:10
A.N.T.
Batya как успехи??? Реально ли вообще сделать, то что я хочу?

Добавлено: Чт июл 06, 2006 10:21
Batya
A.N.T. писал(а):Batya как успехи??? Реально ли вообще сделать, то что я хочу?
Не так быстро. Ведь помимо хобби есть еще и работа :)
Твое желание вполне реально.

Добавлено: Чт июл 06, 2006 13:37
Batya
Получилось примерно так - *.vbs:

Код: Выделить всё

'=======================================================================================
' Создание в каталоге TC панели, содержащей Главное меню (Start Menu)
' Для вызова из TC необходимо в качестве параметра передать число:
'   0   - скрипт отработает один раз
'   > 0 - скрипт будет висеть в памяти и обновлять панель через данное число миллисекунд
' При вызове скрипта без параметра будет изменено значение ключа в реестре,
'   что остановит работу скрипта, висящего в памяти
'=======================================================================================
Option Explicit
Dim MyKey, WSH, StartMenuFile, FolderIconFile
Set WSH = WScript.CreateObject("WScript.Shell")
'========== Изменяемые параметры =======================================================
MyKey   = "HKCU\Software\BatyaSoft\RunningMyScript" 'Ключ в реестре
StartMenuFile  = "startmenu.bar"                    'Имя файла панели
FolderIconFile = "%COMMANDER_PATH%\TOTALCMD.EXE,1"  'Иконка для папок на панели
'=======================================================================================
If WScript.Arguments.Count = 0 Then
  WSH.RegWrite MyKey, "False"
  Set WSH = Nothing
  WScript.Quit
End If
If IsNumeric(WScript.Arguments(0)) = True Then
  If WScript.Arguments(0) = 0 Then
    ScanningStartMenu
  End If
  If WScript.Arguments(0) > 0 Then
    Dim MykeyValue
    MykeyValue = True
    WSH.RegWrite MyKey, MykeyValue
    Do While MykeyValue
      ScanningStartMenu
      WScript.Sleep WScript.Arguments(0)
      MykeyValue = WSH.RegRead(MyKey)
    Loop
  End If
End If

Set WSH = Nothing
WScript.Quit

Function ScanningStartMenu
Dim FSO, F, AUSM, CUSM, i, Menu, Buffer, Lnk
Const ForWriting = 2
Set FSO = CreateObject("Scripting.FileSystemObject")
Set AUSM = FSO.GetFolder(WSH.ExpandEnvironmentStrings("%ALLUSERSPROFILE%") & "\Start Menu\Programs")
Set CUSM = FSO.GetFolder(WSH.ExpandEnvironmentStrings("%USERPROFILE%")     & "\Start Menu\Programs")
i = 0
Buffer = ""
For Each Menu in AUSM.SubFolders
  i = i + 1
  Buffer = Buffer & vbCrLf & "button" & i & "="    & FolderIconFile 
  Buffer = Buffer & vbCrLf & "cmd"    & i & "=cd " & Menu.Path
  Buffer = Buffer & vbCrLf & "menu"   & i & "="    & Menu.Name
Next
For Each Menu in CUSM.SubFolders
  i = i + 1
  Buffer = Buffer & vbCrLf & "button" & i & "="    & FolderIconFile 
  Buffer = Buffer & vbCrLf & "cmd"    & i & "=cd " & Menu.Path
  Buffer = Buffer & vbCrLf & "menu"   & i & "="    & Menu.Name
Next
For Each Menu in AUSM.Files
  If LCase(FSO.GetExtensionName(Menu.Path)) = "lnk" Then
    Set Lnk = WSH.CreateShortcut(Menu.Path)
    i = i + 1
    If Lnk.IconLocation <> ",0" Then
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.IconLocation
    Else
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.TargetPath
    End If    
    Buffer = Buffer & vbCrLf   & "cmd"    & i & "=" & Menu.Path
    Buffer = Buffer & vbCrLf   & "menu"   & i & "=" & FSO.GetBaseName(Menu.Path)
    If Lnk.WorkingDirectory <> "" Then
      Buffer = Buffer & vbCrLf & "path"   & i & "=" & Lnk.WorkingDirectory
    End If
  End If
Next
For Each Menu in CUSM.Files
  If LCase(FSO.GetExtensionName(Menu.Path)) = "lnk" Then
    Set Lnk = WSH.CreateShortcut(Menu.Path)
    i = i + 1
    If Lnk.IconLocation <> ",0" Then
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.IconLocation
    Else
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.TargetPath
    End If    
    Buffer = Buffer & vbCrLf   & "cmd"    & i & "=" & Menu.Path
    Buffer = Buffer & vbCrLf   & "menu"   & i & "=" & FSO.GetBaseName(Menu.Path)
    If Lnk.WorkingDirectory <> "" Then
      Buffer = Buffer & vbCrLf & "path"   & i & "=" & Lnk.WorkingDirectory
    End If
  End If
Next

Buffer = "[Buttonbar]" & vbCrLf & "Buttoncount=" & i & Buffer 
Set F  = FSO.OpenTextFile(WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\" & StartMenuFile, ForWriting, True)
F.Write Buffer  
F.Close 
Set Menu = Nothing
Set F    = Nothing
Set AUSM = Nothing
Set CUSM = Nothing
Set FSO  = Nothing
End Function

Добавлено: Чт июл 06, 2006 13:58
A.N.T.
ИИИИХХХХХАААААААА!!!!!! Супер, ТО что нужно .. Спасибо тебе боооооооооооольшое Батя!!!! Вапще крсота...!!!8)

Скажи, а можно ли тоже самое провернуть только для определённой папки...
Скажем у меня есть папка E:\games\ - в этой папке ярлыки к играм.., ВОТ чтобы тоже генерился бар и всё содержимое этой папки, добавлял также в bar, но только чтобы значки были разные( свои для каждого ярлыка)?

Добавлено: Чт июл 06, 2006 14:25
Batya
Легко.

Код: Выделить всё

'======================================================================================= 
' Создание в каталоге TC панели, содержащей ярлыки из указанной папки 
' Для вызова из TC необходимо в качестве параметра передать число: 
'   0   - скрипт отработает один раз 
'   > 0 - скрипт будет висеть в памяти и обновлять панель через данное число миллисекунд 
' При вызове скрипта без параметра будет изменено значение ключа в реестре, 
'   что остановит работу скрипта, висящего в памяти 
'======================================================================================= 
Option Explicit 
Dim MyKey, WSH, MyBarFile, MyLnkFolder 
Set WSH = WScript.CreateObject("WScript.Shell") 
'========== Изменяемые параметры ======================================================= 
MyKey       = "HKCU\Software\BatyaSoft\RunningMyScript" 'Ключ в реестре 
MyBarFile   = "games.bar"                               'Имя файла панели
MyLnkFolder = "E:\games"                                'Папка с ярлыками
'======================================================================================= 
If WScript.Arguments.Count = 0 Then 
  WSH.RegWrite MyKey, "False" 
  Set WSH = Nothing 
  WScript.Quit 
End If 
If IsNumeric(WScript.Arguments(0)) = True Then 
  If WScript.Arguments(0) = 0 Then 
    ScanningMyLnkFolder 
  End If 
  If WScript.Arguments(0) > 0 Then 
    Dim MykeyValue 
    MykeyValue = True 
    WSH.RegWrite MyKey, MykeyValue 
    Do While MykeyValue 
      ScanningMyLnkFolder 
      WScript.Sleep WScript.Arguments(0) 
      MykeyValue = WSH.RegRead(MyKey) 
    Loop 
  End If 
End If 

Set WSH = Nothing 
WScript.Quit 

Function ScanningMyLnkFolder 
Dim FSO, F, Games, i, LnkFile, Buffer, Lnk 
Const ForWriting = 2 
Set FSO = CreateObject("Scripting.FileSystemObject") 
i = 0 
Buffer = "" 
For Each LnkFile in FSO.GetFolder(MyLnkFolder).Files 
  If LCase(FSO.GetExtensionName(LnkFile.Path)) = "lnk" Then 
    Set Lnk = WSH.CreateShortcut(LnkFile.Path) 
    i = i + 1 
    If Lnk.IconLocation <> ",0" Then 
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.IconLocation 
    Else 
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.TargetPath 
    End If    
    Buffer = Buffer & vbCrLf   & "cmd"    & i & "=" & LnkFile.Path 
    Buffer = Buffer & vbCrLf   & "menu"   & i & "=" & FSO.GetBaseName(LnkFile.Path) 
    If Lnk.WorkingDirectory <> "" Then 
      Buffer = Buffer & vbCrLf & "path"   & i & "=" & Lnk.WorkingDirectory 
    End If 
  End If 
Next 

Buffer = "[Buttonbar]" & vbCrLf & "Buttoncount=" & i & Buffer 
Set F  = FSO.OpenTextFile(WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\" & MyBarFile, ForWriting, True) 
F.Write Buffer  
F.Close 
Set Lnk     = Nothing 
Set LnkFile = Nothing 
Set F       = Nothing 
Set FSO     = Nothing 
End Function
Только я, изменив для красоты исходный код, этот кусок не отлаживал. Пиши, если будет ругаться.

Добавлено: Чт июл 06, 2006 14:47
A.N.T.
Строка: 59
Символ: 7
Ошибка: Объект не поддерживает это свойство или метод: 'LnkFile.WorkingDirectory'

Добавлено: Чт июл 06, 2006 14:55
Batya
Сорри, должно быть Lnk.WorkingDirectory.
Предыдущий пост поправил.

Добавлено: Чт июл 06, 2006 16:01
A.N.T.
Даааа! Batya ты крут..8) спасибоооо больШое. Не сочти за наглость :) Но если не затруднит, может подредактиш первый скрипт "главное меню", что бы он помимо папок показывал ещё ярлыки которые в корне папки"ГЛАВНОЕ МЕНЮ" с соответствующими им значками...
ЗАРАНЕЕ СПАСИБО!!!!

Добавлено: Чт июл 06, 2006 16:16
Batya

Код: Выделить всё

'=======================================================================================
' Создание в каталоге TC панели, содержащей Главное меню (Start Menu)
' Для вызова из TC необходимо в качестве параметра передать число:
'   0   - скрипт отработает один раз
'   > 0 - скрипт будет висеть в памяти и обновлять панель через данное число миллисекунд
' При вызове скрипта без параметра будет изменено значение ключа в реестре,
'   что остановит работу скрипта, висящего в памяти
'=======================================================================================
Option Explicit
Dim MyKey, WSH, StartMenuFile, FolderIconFile
Set WSH = WScript.CreateObject("WScript.Shell")
'========== Изменяемые параметры =======================================================
MyKey   = "HKCU\Software\BatyaSoft\RunningMyScript" 'Ключ в реестре
StartMenuFile  = "startmenu.bar"                    'Имя файла панели
FolderIconFile = "%COMMANDER_PATH%\TOTALCMD.EXE,1"  'Иконка для папок на панели
'=======================================================================================
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, i, Menu, Buffer, Lnk
  If WScript.Arguments(0) = 0 Then
    ScanningStartMenu
  End If
  If WScript.Arguments(0) > 0 Then
    Dim MykeyValue
    MykeyValue = True
    WSH.RegWrite MyKey, MykeyValue
    Do While MykeyValue
      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, AUMM, CUMM
  Const ForWriting = 2
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set AUSM = FSO.GetFolder(WSH.ExpandEnvironmentStrings("%ALLUSERSPROFILE%") & "\Start Menu\Programs")
  Set CUSM = FSO.GetFolder(WSH.ExpandEnvironmentStrings("%USERPROFILE%")     & "\Start Menu\Programs")
  Set AUMM = FSO.GetFolder(WSH.ExpandEnvironmentStrings("%ALLUSERSPROFILE%") & "\Start Menu")
  Set CUMM = FSO.GetFolder(WSH.ExpandEnvironmentStrings("%USERPROFILE%")     & "\Start Menu")
  i = 0
  Buffer = ""
  For Each Menu in AUMM.Files
    ProcessFile
  Next
  For Each Menu in CUMM.Files
    ProcessFile
  Next
  For Each Menu in AUSM.SubFolders
    ProcessFolder
  Next
  For Each Menu in CUSM.SubFolders
    ProcessFolder
  Next
  For Each Menu in AUSM.Files
    ProcessFile
  Next
  For Each Menu in CUSM.Files
    ProcessFile
  Next
  
  Buffer = "[Buttonbar]" & vbCrLf & "Buttoncount=" & i & Buffer 
  Set F  = FSO.OpenTextFile(WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%") & "\" & StartMenuFile, ForWriting, True)
  F.Write Buffer  
  F.Close 
  Set Menu = Nothing
  Set F    = Nothing
  Set AUSM = Nothing
  Set CUSM = Nothing
  Set FSO  = Nothing
End Function

Function ProcessFolder
  i = i + 1
  Buffer = Buffer & vbCrLf & "button" & i & "="    & FolderIconFile 
  Buffer = Buffer & vbCrLf & "cmd"    & i & "=cd " & Menu.Path
  Buffer = Buffer & vbCrLf & "menu"   & i & "="    & Menu.Name
End Function

Function ProcessFile
  If LCase(FSO.GetExtensionName(Menu.Path)) = "lnk" Then
    Set Lnk = WSH.CreateShortcut(Menu.Path)
    i = i + 1
    If Lnk.IconLocation <> ",0" Then
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.IconLocation
    Else
      Buffer = Buffer & vbCrLf & "button" & i & "=" & Lnk.TargetPath
    End If    
    Buffer = Buffer & vbCrLf   & "cmd"    & i & "=" & Menu.Path
    Buffer = Buffer & vbCrLf   & "menu"   & i & "=" & FSO.GetBaseName(Menu.Path)
    If Lnk.WorkingDirectory <> "" Then
      Buffer = Buffer & vbCrLf & "path"   & i & "=" & Lnk.WorkingDirectory
    End If
  End If
End Function
Решил, что логичнее, если иконки из корня главного меню будут лежать в начале.

Добавлено: Чт июл 06, 2006 16:54
A.N.T.
Странно, у меня они всё равно в самом низу, но это не совсем не портит основной картины :D Кстаи не знаеш как можно на одну кнопку повесить сразу три команды cm_RereadSource Shortcut.vbs 0
Startmenu.vbs 0 без использования батника

Добавлено: Чт июл 06, 2006 17:04
Batya
Лучше скажи, зачем тебе это надо.

Добавлено: Чт июл 06, 2006 17:13
A.N.T.
Что бы запускались два твоих СУПЕР!! скрипта + обновлялась панель тотала..

Добавлено: Чт июл 06, 2006 17:30
Batya
А зачем обновлять-то? Ты что, меняешь DEFAULT.BAR?
Но командой cm_RereadSource ты обновления панелей инструментов не добьешься.

Добавлено: Чт июл 06, 2006 17:34
A.N.T.
:arrow:

Добавлено: Чт июл 06, 2006 18:27
Batya
Ты хочешь оба скрипта сразу запускать?
Это можно сделать третьим скриптом. А для обновления есть хитрый способ. Ты ведь кнопкой хочешь запускать скрипты?
Часовой пояс: UTC+03:00
Страница 2 из 7

Создано на основе phpBB® Forum Software © phpBB Limited

Русская поддержка phpBB