View previous topic :: View next topic |
Author |
Message |
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 10:10 Post subject: |
|
|
Batya как успехи??? Реально ли вообще сделать, то что я хочу? |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 10:21 Post subject: |
|
|
A.N.T. wrote: | Batya как успехи??? Реально ли вообще сделать, то что я хочу? |
Не так быстро. Ведь помимо хобби есть еще и работа
Твое желание вполне реально. |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 13:37 Post subject: |
|
|
Получилось примерно так - *.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 |
|
|
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 13:58 Post subject: |
|
|
ИИИИХХХХХАААААААА!!!!!! Супер, ТО что нужно .. Спасибо тебе боооооооооооольшое Батя!!!! Вапще крсота...!!!
Скажи, а можно ли тоже самое провернуть только для определённой папки...
Скажем у меня есть папка E:\games\ - в этой папке ярлыки к играм.., ВОТ чтобы тоже генерился бар и всё содержимое этой папки, добавлял также в bar, но только чтобы значки были разные( свои для каждого ярлыка)? |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 14:25 Post subject: |
|
|
Легко.
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 |
|
|
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 14:47 Post subject: |
|
|
Строка: 59
Символ: 7
Ошибка: Объект не поддерживает это свойство или метод: 'LnkFile.WorkingDirectory' |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 14:55 Post subject: |
|
|
Сорри, должно быть Lnk.WorkingDirectory.
Предыдущий пост поправил. |
|
Back to top |
|
|
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 16:01 Post subject: |
|
|
Даааа! Batya ты крут.. спасибоооо больШое. Не сочти за наглость Но если не затруднит, может подредактиш первый скрипт "главное меню", что бы он помимо папок показывал ещё ярлыки которые в корне папки"ГЛАВНОЕ МЕНЮ" с соответствующими им значками...
ЗАРАНЕЕ СПАСИБО!!!! |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 16:16 Post subject: |
|
|
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 |
|
|
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 16:54 Post subject: |
|
|
Странно, у меня они всё равно в самом низу, но это не совсем не портит основной картины Кстаи не знаеш как можно на одну кнопку повесить сразу три команды cm_RereadSource Shortcut.vbs 0
Startmenu.vbs 0 без использования батника |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 17:04 Post subject: |
|
|
Лучше скажи, зачем тебе это надо. |
|
Back to top |
|
|
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 17:13 Post subject: |
|
|
Что бы запускались два твоих СУПЕР!! скрипта + обновлялась панель тотала.. |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 17:30 Post subject: |
|
|
А зачем обновлять-то? Ты что, меняешь DEFAULT.BAR?
Но командой cm_RereadSource ты обновления панелей инструментов не добьешься. |
|
Back to top |
|
|
A.N.T.
Joined: 01 Jul 2006 Posts: 190
|
(Separately) Posted: Thu Jul 06, 2006 17:34 Post subject: |
|
|
Last edited by A.N.T. on Thu Jul 13, 2006 17:54; edited 3 times in total |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2218 Location: Москва, Россия
|
(Separately) Posted: Thu Jul 06, 2006 18:27 Post subject: |
|
|
Ты хочешь оба скрипта сразу запускать?
Это можно сделать третьим скриптом. А для обновления есть хитрый способ. Ты ведь кнопкой хочешь запускать скрипты? |
|
Back to top |
|
|
|
|
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
|