Batya
|
 Posted: Tue Oct 20, 2009 14:30 Post subject: |
 |
|
| flm wrote: | | Вот я не вижу там параметров, которые позволяли бы убрать пустую кнопку и выход на DEFAULT.BAR, хоть убей. Может я ослеп? |
| Code: | 'Признак формирования кнопки выхода на предыдущую панель - 0 или 1
ExitButton = 1
|
| flm wrote: | | я не обязан знать про параметры, читать шапки скриптов и тд. |
Любая программа для работы требует определённых условий.
Условия работы своих скриптов я всегда помещаю в шапке скрипта. Обычно ни у кого вопросов не возникает.
flm
Специально для тебя - выкинул лишнее:
| Code: | '=======================================================================================
' Создание в каталоге TC панели, содержащей "Программы" Главного меню.
' В качестве параметра для скрипта можно указать папку с ярлыками,
' иначе будет читаться папка "Программы", общая для всех пользователей.
'=======================================================================================
Option Explicit
Dim FSO, WSH, StartMenuFile, FolderIconFile, BarsFolder, ExitButton, ExitIconFile
Dim UnknowTypeIcon, RegTree
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
'========== Изменяемые параметры =======================================================
StartMenuFile = "programs.bar" 'Имя основного файла панели
'Иконка для папок на панели:
FolderIconFile = GetPath("%COMMANDER_PATH%\TOTALCMD.EXE,1")
'Папка в каталоге TC для формирования вложенных bar:
BarsFolder = GetPath("%COMMANDER_PATH%\Bars")
'Признак формирования кнопки выхода на предыдущую панель - 0 или 1
ExitButton = 1
'Иконка для кнопки выхода на предыдущую панель:
ExitIconFile = GetPath("%COMMANDER_PATH%\TOTALCMD.EXE,10")
'Иконка для файлов неизвестных типов:
UnknowTypeIcon = GetPath("%COMMANDER_PATH%\TOTALCMD.EXE,9")
'Читаем по умолчанию папку с ярлыками из реестра
RegTree = "HKLM\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Common Programs"
'=======================================================================================
Dim StartMenuPath, AUSP, LnkFolder
If WScript.Arguments.Count > 0 Then
LnkFolder = GetPath(WScript.Arguments(0))
Else
LnkFolder = GetPath(WSH.RegRead(RegTree))
End If
Const ForWriting = 2, Hidden = 2
If Not FSO.FolderExists(BarsFolder) Then FSO.CreateFolder BarsFolder
If FSO.GetFolder(BarsFolder).Files.Count > 0 Then
FSO.DeleteFile(BarsFolder & "\*.*")
End If
ScanningStartMenu
Quit
Function ScanningStartMenu
Dim F, AUSP, Menu, n, i, RegTree
Set AUSP = FSO.GetFolder(LnkFolder)
StartMenuPath = GetPath("%COMMANDER_PATH%\" & StartMenuFile)
n = 0
For Each Menu in AUSP.Files
If (Menu.Attributes and Hidden) <> Hidden Then
n = n + 1
End If
Next
Set F = FSO.OpenTextFile(StartMenuPath, ForWriting, True)
n = n + AUSP.SubFolders.Count - 1
F.WriteLine "[Buttonbar]"
F.WriteLine "Buttoncount=" & n
i = 0
For Each Menu in AUSP.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
F.Close
Set Menu = Nothing
Set F = Nothing
Set AUSP = 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 + 1
F1.WriteLine "button1=" & ExitIconFile
F1.WriteLine "cmd1=" & SM
F1.WriteLine "menu1=" & "..."
F1.WriteLine "iconic1=" & "1"
k = 1
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 GetPath(pPath)
GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
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
'Выход
Sub Quit
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit
End Sub |
!!! Внимание для тех, кто не читает шапки скриптов !!!
Изменились условия работы скрипта - приведённый выше скрипт не сканирует папку с ярлыками, а отрабатывает один раз. В качестве параметра для скрипта можно указать папку с ярлыками. Иначе будет читаться папка "Программы", общая для всех пользователей. Если путь к папке содержит пробелы, его нужно заключить в кавычки!
_________________
Нет, я не сплю. Я просто медленно моргаю.
Last edited by Batya on Wed Oct 21, 2009 09:25; edited 1 time in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
