Script Request

[ADv]

день добрый. стоит такая задача (тип файлов = mp3):
есть папка Artist - Album, в ней нн-ое количество треков (обычно 10-15 - стандартный мп3-альбом)
нужно:
заархивировать все мп3 и cover.jpg в каталоге в архив с названием папки, чтобы вышло

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

Artist - Album.zip\01. ***. mp3 

а еще лучше если бы с помощью какой-нить консольной утилиты скрипт сам получал из первой попавшейся мп3-шки в каталоге теги Исполнительи Альбом и архивировал все содержимое каталога в только что полученные Исполнитель - Альбом.zip

[Tol!k]

заархивировать все мп3 и cover.jpg в каталоге в архив с названием папки

http://forum.wincmd.ru/viewtopic.php?p=54819#54819

[laburj]

Batya, спасибо большое за скрипт "Создание текстового файла с содержимым буфера обмена", очень полезен

а можно ли изменить скрипт так, чтобы название создаваемого файла состояло не из указанного количества слов, а из целой первой строчки содержимого буфера до перехода на следующую строку?

и как отключить сообщение о предложении создать файл, чтобы файл создавался без подтверждения?

[Batya]

а можно ли изменить скрипт так, чтобы название создаваемого файла состояло не из указанного количества слов, а из целой первой строчки содержимого буфера до перехода на следующую строку?

В функции GetFileName вместо строки

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

  GetFileName = GetSomeWords(lText, NumWords) 

напиши

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

  GetFileName = Left(lText, InStr(lText, vbNewLine) - 1) 

и как отключить сообщение о предложении создать файл, чтобы файл создавался без подтверждения?

Нужно удалить или закомментировать (поставить знак апострофа в начале) строки:

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

Btn = MsgBox(Text, vbYesNo + vbQuestion, Title) 
If Btn = 7 Then Quit 0 

[laburj]

напиши

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

  GetFileName = Left(lText, InStr(lText, vbNewLine) - 1) 

в этом случае возникает сообщение с ошибкой:

Строка: 64
Символ: 3
Ошибка: Недопустимый вызов или аргумент процедуры: 'Left'
Код: 800A0005
Источник: Ошибка выполнения Microsoft VBScript

Скрипт для модификации я брал из этого поста:
http://forum.wincmd.ru/viewpost.php?p=52478

[Batya]

в этом случае возникает сообщение с ошибкой

Прошу прщения, написал не проверяя.

Функция GetFileName должна описываться так:

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

Function GetFileName(pText)
  Dim lText, lPos, Char
  lPos = InStr(pText, vbNewLine)
  If lPos > 0 Then
    lText = Left(pText, lPos - 1)
  Else
    lText = pText
  End If
  For Each Char In CharArr
    lText = Replace(lText, Char, ReplaceChar)
  Next
  GetFileName = Trim(lText)
End Function

[laburj]

Batya
всё отлично, только в конце названия файла остаётся пробел, можно его убрать?

и можно ли изменить скрипт так, чтобы созданный файл в конце открывался?

[Batya]

всё отлично, только в конце названия файла остаётся пробел, можно его убрать?

Добавил "Trim" - см. выше.

и можно ли изменить скрипт так, чтобы созданный файл в конце открывался?

В конце основного тела скрипта после строки "FSO.OpenTextFile(FileName, 2, True).Write Clip" добавь:

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

CreateObject("WScript.Shell").Run FileName, 7, False

[laburj]

В конце основного тела скрипта после строки "FSO.OpenTextFile(FileName, 2, True).Write Clip" добавь:

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

CreateObject("WScript.Shell").Run FileName, 7, False

возникает сообщение с ошибкой:

Строка: 40
Символ: 1
Ошибка: Не удаётся найти указанный файл.
Код: 80070002
Источник: (null)

[Batya]

laburj
Упс... Забыл про кавычки. Надо так:

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

CreateObject("WScript.Shell").Run """" & FileName & """", 7, False

[laburj]

Batya
а создаваемый файл может открываться не в фоне? в данном случае приходиться окно активировать

[Batya]

laburj

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

CreateObject("WScript.Shell").Run """" & FileName & """", 1, False

[laburj]

Batya, спасибо огромное! всё вроде как работает! будем тестить) поставил скрипт на хоткей ctrl+alt+t

[laburj]

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

поясню на примере:
если активная вкладка d:\soft_not_tested\security\Dr.Web\LiveCD
то я хочу, чтобы открылась вкладка
d:\soft_on_dvd\security\Dr.Web\ LiveCD

условия замены д.б. прописаны заранее
в данном случае:
soft_not_tested=soft_on_dvd

если же такой папки не существует (d:\soft_on_dvd\security\Dr.Web\ LiveCD), то открывается возможный нижний уровень, к примеру: d:\soft_on_dvd\security

[Batya]

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

Примерно такой vbs:

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

'=============================================================================
' Открытие в противоположной панели на новой вкладке TC
'   слегка изменённого пути активной вкладки.
'
' Параметры:
' {текущая папка}
'
' Пример параметров при вызове из TC:
' "%P"
'
' Автор - Batya
'=============================================================================
Option Explicit
Dim Repl, IsCreate
Set Repl = CreateObject("Scripting.Dictionary")
'======== Изменяемые параметры ===============================================
' Массив заменяемых значений
Repl.Add "soft_not_tested", "soft_on_dvd"
Repl.Add "Пример 1", "Пример 2"
IsCreate = False 'Признак создания папки, если полученный путь не существует
'=============================================================================
Dim Mess, FSO, WSH, FF, IsFound
SetMess
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")

On Error Resume Next
CheckParam:CheckErr
On Error GoTo 0
Main
Quit 0

Sub Main
  Dim K, TC
  IsFound = False
  For Each K In Repl.Keys
    If InStr(1, FF, K, vbTextCompare) > 0 Then
      FF = Replace(FF, K, Repl(K), 1, -1, vbTextCompare)
      IsFound = True
      Exit For
    End If
  Next
  If IsFound Then
    If IsCreate Then
      BuildTree FF
    Else
      FF = ExistsLevel(FF)
    End If
    TC = """" & GetPath("%Commander_Path%\totalcmd.exe") & """"
    WSH.Run TC & " /O /S /T /R=""" & FF & """", 1, False
  End If
End Sub

Sub SetMess
  Set Mess = CreateObject("Scripting.Dictionary")
  With Mess
    .Add 0,  "Открытие в TC вкладки с изменённым путём"
    .Add 1,  "Не указаны параметры!"
  End With
End Sub

Sub CheckParam
  If WScript.Arguments.Count = 0 Then Err.Raise vbObjectError + 1, "", Mess(1)
  FF = GetPath(WScript.Arguments(0))
End Sub

Function GetPath(pPath)
  GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function

Function ExistsLevel(pPath)
  If FSO.FileExists(pPath) Or FSO.FolderExists(pPath) Then
    ExistsLevel = pPath
  Else
    ExistsLevel = ExistsLevel(FSO.GetParentFolderName(pPath))
  End If
End Function

'Создание дерева папок
Sub BuildTree(pFolder)
  Dim lPF
  lPF = FSO.GetParentFolderName(pFolder)
  If Not FSO.FolderExists(lPF    ) Then BuildTree lPF
  If Not FSO.FolderExists(pFolder) Then FSO.CreateFolder pFolder
End Sub

Function MessBox(pMess, pMode)
  Dim lIcon
  Select Case pMode
    Case 1 lIcon = vbCritical    + vbOKOnly
    Case 2 lIcon = vbExclamation + vbOKOnly
    Case 3 lIcon = vbInformation + vbOKOnly
  End Select
  MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

'Проверка, нет ли ошибок
Sub CheckErr
  If Err.Number <> 0 Then
    MessBox Mess(0) & vbNewLine & vbNewLine & "Возникла ошибка № " &_
      Err.Number & ":" & vbNewLine & Err.Description, 1
    Quit Err.Number
  End If
End Sub

Sub Quit(pQuitCode)
  Set Repl = Nothing
  Set Mess = Nothing
  Set WSH  = Nothing
  Set FSO  = Nothing
  WScript.Quit pQuitCode
End Sub