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 

Создание BAR-файла на основе заданного набора ярлыков
Goto page Previous  1, 2, 3, 4, 5, 6, 7  Next
 
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander printer-friendly view
View previous topic :: View next topic  
Author Message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 10:10    Post subject: Reply with quote

Batya как успехи??? Реально ли вообще сделать, то что я хочу?
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 10:21    Post subject: Reply with quote

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

Не так быстро. Ведь помимо хобби есть еще и работа Smile
Твое желание вполне реально.
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 13:37    Post subject: Reply with quote

Получилось примерно так - *.vbs:
Code:
'=======================================================================================
' Создание в каталоге 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
Back to top
View user's profile Send private message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 13:58    Post subject: Reply with quote

ИИИИХХХХХАААААААА!!!!!! Супер, ТО что нужно .. Спасибо тебе боооооооооооольшое Батя!!!! Вапще крсота...!!!Cool

Скажи, а можно ли тоже самое провернуть только для определённой папки...
Скажем у меня есть папка E:\games\ - в этой папке ярлыки к играм.., ВОТ чтобы тоже генерился бар и всё содержимое этой папки, добавлял также в bar, но только чтобы значки были разные( свои для каждого ярлыка)?
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 14:25    Post subject: Reply with quote

Легко.
Code:
'=======================================================================================
' Создание в каталоге 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

Только я, изменив для красоты исходный код, этот кусок не отлаживал. Пиши, если будет ругаться.


Last edited by Batya on Thu Jul 06, 2006 14:55; edited 1 time in total
Back to top
View user's profile Send private message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 14:47    Post subject: Reply with quote

Строка: 59
Символ: 7
Ошибка: Объект не поддерживает это свойство или метод: 'LnkFile.WorkingDirectory'
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 14:55    Post subject: Reply with quote

Сорри, должно быть Lnk.WorkingDirectory.
Предыдущий пост поправил.
Back to top
View user's profile Send private message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 16:01    Post subject: Reply with quote

Даааа! Batya ты крут..Cool спасибоооо больШое. Не сочти за наглость Smile Но если не затруднит, может подредактиш первый скрипт "главное меню", что бы он помимо папок показывал ещё ярлыки которые в корне папки"ГЛАВНОЕ МЕНЮ" с соответствующими им значками...
ЗАРАНЕЕ СПАСИБО!!!!
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 16:16    Post subject: Reply with quote

Code:
'=======================================================================================
' Создание в каталоге 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

Решил, что логичнее, если иконки из корня главного меню будут лежать в начале.
Back to top
View user's profile Send private message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 16:54    Post subject: Reply with quote

Странно, у меня они всё равно в самом низу, но это не совсем не портит основной картины Very Happy Кстаи не знаеш как можно на одну кнопку повесить сразу три команды cm_RereadSource Shortcut.vbs 0
Startmenu.vbs 0 без использования батника
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 17:04    Post subject: Reply with quote

Лучше скажи, зачем тебе это надо.
Back to top
View user's profile Send private message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 17:13    Post subject: Reply with quote

Что бы запускались два твоих СУПЕР!! скрипта + обновлялась панель тотала..
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 17:30    Post subject: Reply with quote

А зачем обновлять-то? Ты что, меняешь DEFAULT.BAR?
Но командой cm_RereadSource ты обновления панелей инструментов не добьешься.
Back to top
View user's profile Send private message
A.N.T.



Joined: 01 Jul 2006
Posts: 190

Post (Separately) Posted: Thu Jul 06, 2006 17:34    Post subject: Reply with quote

Arrow

Last edited by A.N.T. on Thu Jul 13, 2006 17:54; edited 3 times in total
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Jul 06, 2006 18:27    Post subject: Reply with quote

Ты хочешь оба скрипта сразу запускать?
Это можно сделать третьим скриптом. А для обновления есть хитрый способ. Ты ведь кнопкой хочешь запускать скрипты?
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander All times are GMT + 4 Hours
Goto page Previous  1, 2, 3, 4, 5, 6, 7  Next
Page 2 of 7

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group