[REQ] Меню пуск на button bar!!!

Обсуждение вопросов автоматизации Total Commander с помощью сторонних программ и скриптовых технологий.

Модераторы: d-view, Моторокер, Avada, CaptainFlint, Nik

Аватара пользователя
Batya
Сообщения: 2236
Зарегистрирован: Ср дек 15, 2004 09:51
Откуда: Москва, Россия

Сообщение Batya »

flm писал(а):Вот я не вижу там параметров, которые позволяли бы убрать пустую кнопку и выход на DEFAULT.BAR, хоть убей. Может я ослеп?

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

'Признак формирования кнопки выхода на предыдущую панель - 0 или 1
ExitButton     = 1
flm писал(а):я не обязан знать про параметры, читать шапки скриптов и тд.
Любая программа для работы требует определённых условий.
Условия работы своих скриптов я всегда помещаю в шапке скрипта. Обычно ни у кого вопросов не возникает.

flm
Специально для тебя - выкинул лишнее:

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

'=======================================================================================
' Создание в каталоге 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
!!! Внимание для тех, кто не читает шапки скриптов !!!
Изменились условия работы скрипта - приведённый выше скрипт не сканирует папку с ярлыками, а отрабатывает один раз. В качестве параметра для скрипта можно указать папку с ярлыками. Иначе будет читаться папка "Программы", общая для всех пользователей. Если путь к папке содержит пробелы, его нужно заключить в кавычки!
Последний раз редактировалось Batya Ср окт 21, 2009 09:25, всего редактировалось 1 раз.
Нет, я не сплю. Я просто медленно моргаю.
Аватара пользователя
flm
Сообщения: 467
Зарегистрирован: Вс дек 09, 2007 05:54

Сообщение flm »

Batya писал(а):
flm писал(а):Вот я не вижу там параметров, которые позволяли бы убрать пустую кнопку и выход на DEFAULT.BAR, хоть убей. Может я ослеп?

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

'Признак формирования кнопки выхода на предыдущую панель - 0 или 1
ExitButton     = 1
Это не то. При этом отсутствуют во всех саббарах ссылки на родительские бары. А нужно просто убрать одну - ссылку на DEFAULT.BAR в корневом. И пустую кнопку везде ;).
Batya писал(а):
flm писал(а):я не обязан знать про параметры, читать шапки скриптов и тд.
Любая программа для работы требует определённых условий.
Условия работы своих скриптов я всегда помещаю в шапке скрипта. Обычно ни у кого вопросов не возникает.
У меня возникли не вопросы, а замечания по юзабилити :).
Batya писал(а): flm
Специально для тебя - выкинул лишнее:
Спасибо. У меня ещё много хотелок осталось, наверное сам попробую доработать скрипт, может посоветуешь какую-нибудь книгу по vbscript для начинающих? Если вдруг есть что под рукой - мой e-mail - flm{собака}bk{точка}ru.

[mod="Avada"]Явный показ адреса убрал.[/mod]
cogito ergo sum
http://www.yakimchuk.ru/questions.htm - Как правильно задавать вопросы
Аватара пользователя
Batya
Сообщения: 2236
Зарегистрирован: Ср дек 15, 2004 09:51
Откуда: Москва, Россия

Сообщение Batya »

flm писал(а):А нужно просто убрать одну - ссылку на DEFAULT.BAR в корневом.
Понял - убрал ещё немного лишнего :)
flm писал(а):И пустую кнопку везде
Так, вроде, уже нигде нет. И я что-то не понял?
flm писал(а):У меня возникли не вопросы, а замечания по юзабилити
ОК. Замечания принимаются. Как сделать юзабилитнее?
flm писал(а):У меня ещё много хотелок осталось
Ладно уж, я уже успокоился 8) Что хотелось?
flm писал(а):может посоветуешь какую-нибудь книгу по vbscript для начинающих?
Ничего не могу посоветовать. Сам изучал vbscript по хэлпам.

P.S. Убери явный показ мыла, а то спам-роботы не дремлют :!:
Типа adress{собака}domen{точка}ru. Человек поймёт.
Нет, я не сплю. Я просто медленно моргаю.
Аватара пользователя
flm
Сообщения: 467
Зарегистрирован: Вс дек 09, 2007 05:54

Сообщение flm »

Avada Batya
Спасибо за заботу о моём почтовом ящике. Но ему 100 лет в обед - спам как ходил, так ходит и будет ходить, свети его или не свети :). Это ж мэил ру.

Batya
Сам напросился :).
В данный момент скрипт выполняет слудующую задачу - из подготовленого каталога (системы каталогов) делается bar (система bar'ов). Применять такой скрипт можно только для узкого круга задач:
1). Перевод меню пуск (только одного пользователя) в систему bar-ов.
2). Перевод заранее подготовленного каталога с ссылками в bar(систему bar-ов).
И та и та задачи не являются, на мой взгляд, популярными. В том смысле, что 1). - не является полноценным переводом Пуска в систему bar-ов. 2). требует ручной подготовки ярлыков (в ещё более редких случаях - файлов).
Попробуем расширить задачи и привести их в более популярные. Итак:
1). Полноценный перевод меню пуск в систему bar-файлов.
Скрипт в более ранней вариации справлялся с этой задачей, но довольно криво. Во-первых, необходима сортировка. Т.е. если в общем для всех пользователей меню есть каталог "a2" и в обычном есть "а1", то в результирующем bar-файле они должны идти поочереди. Кроме того, если и там и там есть каталог "Автозагрузка", то должен получиться 1 bar с ссылками на содержимое обоих каталогов. Тут есть ещё кое-какие подводные камни, но пока мы их игнорируем.
2). Автоматизация создания bar-файлов из группы программ. Допустим, у нас есть в системе папка programs, в которой у нас установлены 20 любимых программ, чтобы перенести их на бар, нужно вручную перетягивать все exe-шники и тд. на toolbar, что ни есть удобно. Тут бы нам помог скрипт, если б он либо a). поддерживал путь к файлу(-ам) в качестве параметра(-ов) (в таком случае нам нужно было бы всего то: нажать ctrl+f11, ctrl+b, выделить нужное, запустить скрипт и через параметры передать ему полные пути к файлам) либо б). скрипт поддерживал бы маски. Т.е. можно было бы задать, чтоб кнопки создавались только из lnk, exe, bat, cmd или около того....
Таким образом выделим хотелки:
1. Сортировка
2. Маски
3. Путь к файлам в качестве параметра
Ещё можно добавить какую-то индикацию работы. А то при больших объёмах скрипт работает долго и прилично загружает систему, но не выдаёт никаких сообщений о своём состоянии (а вдруг зависло?).

p.s.: если дать разгуляться моей фантазии, то в конце концов получится полноценный многофункциональный bar-creator. :)
cogito ergo sum
http://www.yakimchuk.ru/questions.htm - Как правильно задавать вопросы
Аватара пользователя
Batya
Сообщения: 2236
Зарегистрирован: Ср дек 15, 2004 09:51
Откуда: Москва, Россия

Сообщение Batya »

flm писал(а):Таким образом выделим хотелки:
1. Сортировка
Это реально.
flm писал(а):2. Маски
В виде масок не получится. Могу сделать только для списка расширений.
flm писал(а):3. Путь к файлам в качестве параметра
Помоему для exe-файлов я что-то подобное уже делал.
flm писал(а):Ещё можно добавить какую-то индикацию работы.
А вот это точно не смогу сделать :(

А теперь о грустном. Несколько дней назад поменял работу. Сейчас пока сижу без интернета и даже не знаю, возможно ли вообще заходить с работы на форум. Так что, совершенно не представляю, когда смогу что-либо покодить на vbs :(
Нет, я не сплю. Я просто медленно моргаю.
Аватара пользователя
flm
Сообщения: 467
Зарегистрирован: Вс дек 09, 2007 05:54

Сообщение flm »

up :)
cogito ergo sum
http://www.yakimchuk.ru/questions.htm - Как правильно задавать вопросы
Ответить