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