Script Request

ADv · Сообщение **ADv** » Вт июл 05, 2005 21:21

помогите.. нужны скрипты для:
1) запуск поиска в текущей папке файла, имя которого находится в буфере
2) Создание папки с частью имени mp3-файла (например Rammsten - Reise, Reise.mp3 перемещается в созданную папку Rammstein).
Mr.Volniy?

_________________________________________________________
http://my.opera.com/advokat_b/affiliate/

Batya · Сообщение **Batya** » Вт июл 12, 2005 11:11

ADv
1.

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

'=====================================================================
' Запуск поиска в текущей папке файла, имя которого находится в буфере
'=====================================================================

Dim TCS
Set TCS = CreateObject("TCScript.Helper")
TCS.Pause=100
TCS.LockTC True
TCS.SendCommand(501)
TCS.SendKeystroke (TCS.GetTextFromClip)
TCS.SendKeystroke ("{Enter}")
TCS.LockTC False
Set TCS=Nothing
Wscript.Quit

2. По какому критерию резать?

ADv · Сообщение **ADv** » Вт июл 12, 2005 14:11

по исполнителю, т.е. по тому, что находится до "-". в моем примере - rammstein (должна создаться папка Rammstein). спасибо

Batya · Сообщение **Batya** » Вт июл 12, 2005 15:55

2.

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

'=====================================================================
' Создание папки с частью имени файла, перемещение в нее файла
' Может быть выделено несколько файлов

' В параметрах вызова из TC должно быть прописано:
' %L
'=====================================================================

Dim TempFile, FSO, SelFile
Set TempFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(WScript.Arguments(0), 1)
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim MoveFiles, FileName, FilePath, DashInName, NewFilePath, M1, M2, M3, M4
MoveFiles = ""
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
  FileName = SelFile.Name
  FilePath = SelFile.ParentFolder
  DashInName = InstrRev(FileName, "-")
  If DashInName <> 0 Then
      NewFilePath = FilePath & "\" & Trim(Left(FileName, DashInName - 1))
      If Not FSO.FolderExists(NewFilePath) Then
        FSO.CreateFolder(NewFilePath)
      End If
      If Not FSO.FileExists(NewFilePath & "\" & FileName) Then
        FSO.MoveFile SelFile, NewFilePath & "\"
        MoveFiles = MoveFiles + FileName & chr(13)
      Else
        M1 = MsgBox("Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!")
      End If
  Else
    M2 = MsgBox("Имя исполнителя не выявлено", vbOKOnly + vbExclamation, "Внимание!")
  End If
Loop
If MoveFiles <> "" Then
  MoveFiles = Left(MoveFiles, Len(MoveFiles) - 1)
  M3 = MsgBox("Перемещены файлы:" & chr(13) & MoveFiles, vbOKOnly + vbInformation, "Результат")
Else
  M4 = MsgBox("Ни одного файла не перемещено" & chr(13) & MoveFiles, vbOKOnly + vbExclamation, "Внимание!")
End If
Set TempFile = Nothing
Set FSO = Nothing
Set SelFile = Nothing
Wscript.Quit

LocKtaR-o-DarK

Ну групповое переименование тоже не отменяли

Batya · Сообщение **Batya** » Пн авг 15, 2005 10:25

LocKtaR-o-DarK
Хочеться пофлеймить?
1. Можно ли создавать папки при групповом переименовании и перемещать туда файлы?
2. Если тебе удасться п. 1, то как составить регулярное выражение для выделения части имени до "-" в качестве имени папки с отбрасыванием концевых пробелов. Я понимаю, что п. 2 выполним, но сам не силен в регулярных выражениях. Однако, если уж ты что-то пишешь, пиши конкретно.

dxangelo

ADv писал(а):помогите.. нужны скрипты для:
1) запуск поиска в текущей папке файла, имя которого находится в буфере

А как сделать, что бы поиск слова из буфера происходил внутри файлов (галочка "с текстом"), а поле "искать файлы" оставалось пустым...?!
Очень часто этим пользуюсь...

Batya · Сообщение **Batya** » Пт апр 28, 2006 11:25

dxangelo

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

'=====================================================================
' Запуск поиска в текущей папке по содержимому тексту из буфера
'=====================================================================

Dim TCS, Str
Set TCS = CreateObject("TCScript.Helper")
Str = TCS.GetTextFromClip         ' Текст из буфера
TCS.Pause=100
TCS.LockTC True
TCS.SendCommand(501)
TCS.SendKeystroke ("{DEL}")       ' Очистить файловую маску
TCS.SendKeystroke ("{TAB 5} ")    ' Перейти к чекбоксу и нажать пробел
If Len(Str) > 0 Then
  TCS.SendKeystroke (Str)         ' Вставить текст
  'TCS.SendKeystroke ("+{TAB 6}")  ' Вернуться в поле ввода файловой маски
  TCS.SendKeystroke ("{Enter}")   ' Запустить поиск
End If
TCS.LockTC False
Set TCS = Nothing
Wscript.Quit

При желании, для ввода файловой маски в скрипте можно закомментировать 16 строку и раскомментировать 15 строку. Тогда поиск не запустится - нужно ввести маску и нажать Enter.

ADv · Сообщение **ADv** » Сб май 06, 2006 20:23

помогите, plz. нужен скрипт, который бы создавал в текущей папке текстовый файл с именем mp3-шки. т.е. например, для Lacuna Coil - 02 - Heaven's A Lie.mp3 и Lacuna Coil - 03 - Daylight Dancer.mp3 создается файл Lacuna Coil - 02 - Heaven's A Lie.txt и Lacuna Coil - 03 - Daylight Dancer.txt соответственно. необходимо, чтобы тхт создавался для всех mp3 в текущем каталоге. по возможности киньте скрипт на мыло mikusb[собака]bk.ru

Вахмурка

запуск поиска в текущей папке файла, имя которого находится в буфере

http://powerpro.wincmd.ru/Scripts/Find.htm#cliptext

Batya · Сообщение **Batya** » Ср май 10, 2006 13:15

ADv писал(а):помогите, plz. нужен скрипт, который бы создавал в текущей папке текстовый файл с именем mp3-шки.

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

'==========================================================================
' Создание в текущей папке для всех файлов с указанным расширением
'   аналогичного файла с другим указанным расширением

' В параметрах вызова из TC должно быть прописано:
' "%P" {расширение исходных файлов} {расширение создаваемых файлов}
' Пример:
' "%P" mp3 txt
'==========================================================================
Dim MB
If WScript.Arguments.Count < 3 Then
  MB = MsgBox("Заданы не все параметры!", vbOKOnly + vbExclamation, "Создание новых файлов")
  WScript.Quit
End If

Dim FSO, CurrentFolder, Ext1, Ext2, oFolder, oFile, NewFilePath, oNewFile
Set FSO = CreateObject("Scripting.FileSystemObject")

CurrentFolder = WScript.Arguments(0)
Ext1          = WScript.Arguments(1)
Ext2          = WScript.Arguments(2)

If not FSO.FolderExists(CurrentFolder) Then
  MB = MsgBox("Папка " & CurrentFolder & " не существует!", vbOKOnly + vbExclamation, "Создание новых файлов")
  WScript.Quit
End If

Set oFolder = FSO.GetFolder(CurrentFolder)

For Each oFile in oFolder.Files
  If FSO.GetExtensionName(oFile.Path) = Ext1 Then
    NewFilePath = CurrentFolder & FSO.GetBaseName(oFile.Path) & "." & Ext2
    If not FSO.FileExists(NewFilePath) Then
      Set oNewFile = FSO.CreateTextFile(NewFilePath)
      oNewFile.Close
    End If
  End If
Next

Set oFolder  = Nothing
Set oFile    = Nothing
Set oNewFile = Nothing
Set FSO      = Nothing
Wscript.Quit

Отослал также на мыло.
В параметрах кнопки (команды) надо указать 3 параметра, например:
"%P" mp3 txt

Edit:
Выяснилось, что %P в параметрах кнопки надо поставить в кавычки. Иначе криво работает, если в пути папок есть пробелы. Спасибо ADv.
До сих пор не уяснил для себя, как при разборе строки параметров Гислер с кавычками работает.

fa1con · Сообщение **fa1con** » Ср авг 23, 2006 16:13

Нужен скрипт для установки случайных обоев из текущей директории TC (без поддиректорий). Если в текущей директории нет подходящих файлов, устанавливать обои из первого параметра запуска, если он не задан, устанавливать из директории по умолчанию.
Напишите плз, кто хорошо умеет.

Batya · Сообщение **Batya** » Ср авг 23, 2006 18:27

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

'==============================================================================
' Установка в качестве обоев случайного файла из текущего каталога
' Для установки обоев используется программа IrfanView
'
' В качестве первого параметра указать полный путь до папки или:
' "%P"
' Вторым параметром можно указать имя файла-картинки
'==============================================================================
Option Explicit 
Dim MyPictures, Irfan
'============= Задайте каталог картинок  по умолчанию =========================
MyPictures = "e:\Photo\2005_12_24\"'"D:\Pictures"
'============== Задайте путь IrfanView ========================================
Irfan = "D:\Program Files\IrfanView\i_view32.exe"
'==============================================================================

If WScript.Arguments.Count = 0  Then 
  MsgBox "Не указан параметр - папка с обоями", _
         vbOKOnly + vbExclamation, _
         "Установка обоев"
  WScript.Quit
End If
Dim FSO, WSH, oFolder, n, x, FilesSet, aFileSet, Wall
Set FSO     = CreateObject("Scripting.FileSystemObject")
Set WSH     = WScript.CreateObject("WScript.Shell")
Set oFolder = FSO.GetFolder(WScript.Arguments(0))

FilesSet = Pictures(oFolder)
aFileSet = Split(FilesSet, vbCr)
n        = UBound(aFileSet)
Wall     = ""
Randomize

If n > 0 Then
  x = Int(n * Rnd) + 1
  Wall = aFileSet(x - 1)
Else
  If WScript.Arguments.Count > 1 Then
    Wall = WScript.Arguments(1)
  Else
    If FSO.FolderExists(MyPictures) Then
      FilesSet = Pictures(FSO.GetFolder(MyPictures))
      aFileSet = Split(FilesSet, vbCr)
      n        = UBound(aFileSet)
      If n > 0 Then
        x    = Int(n * Rnd) + 1
        Wall = aFileSet(x - 1)
      End If
    End If
  End IF
End If

If Len(Wall) > 0 Then
  WSH.Run("""" & Irfan + """ " + Wall + " /wall=2 /killmesoftly")
Else
  MsgBox "Не найден файл с картинкой", _
         vbOKOnly + vbExclamation, _
         "Установка обоев"
End If

Set oFolder = Nothing
Set WSH     = Nothing
Set FSO     = Nothing
WScript.Quit

Function Pictures(oFold)
  Dim ScanFile, Ext
  Pictures = ""
  For Each ScanFile in oFold.Files
    Ext = LCase(FSO.GetExtensionName(ScanFile))
    If Ext = "jpg" or Ext = "bmp" or Ext = "gif" or Ext = "jpeg" Then
      Pictures = Pictures + ScanFile.Path + vbCr
    End If
  Next
  Set ScanFile = Nothing
  Set oFold    = Nothing
End Function

Я не знаю, как ком. строкой задать обои, кроме как используя IrfanView. Задайте пусть к нему в скрипте.

fa1con · Сообщение **fa1con** » Ср авг 23, 2006 22:58

Хммм… Можно как то приводить кодировку строки имени файла? А то вместо

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

\\10.0.255.26\рисунки\Рисунки\WAR\01.jpg

IrfanView передается

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

\\10.0.255.26\@8AC=:8\Рисунки\WAR\01.jpg

Именно так: имя ресурса «рисунки» как «@8AC=:8», а каталог кириллицей нормально.

Batya · Сообщение **Batya** » Чт авг 24, 2006 09:52

fa1con
Странно. У меня даже в сети все нормально передается.

Может кто-нибудь из специалистов по сетям скажет, почему такое может быть?

Total Commander

Script Request

Script Request

Re: Script Request