Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Script Request
Goto page 1, 2, 3 ... 40, 41, 42  Next
 
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander printer-friendly view
View previous topic :: View next topic  
Author Message
ADv



Joined: 03 Mar 2005
Posts: 47
Location: Украина

Post (Separately) Posted: Tue Jul 05, 2005 21:21    Post subject: Script Request Reply with quote

помогите.. нужны скрипты для:
1) запуск поиска в текущей папке файла, имя которого находится в буфере
2) Создание папки с частью имени mp3-файла (например Rammsten - Reise, Reise.mp3 перемещается в созданную папку Rammstein).
Mr.Volniy? Smile
_________________________________________________________
http://my.opera.com/advokat_b/affiliate/
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Tue Jul 12, 2005 11:11    Post subject: Reply with quote

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

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. По какому критерию резать?
Back to top
View user's profile Send private message
ADv



Joined: 03 Mar 2005
Posts: 47
Location: Украина

Post (Separately) Posted: Tue Jul 12, 2005 14:11    Post subject: Reply with quote

по исполнителю, т.е. по тому, что находится до "-". в моем примере - rammstein (должна создаться папка Rammstein). спасибо
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Tue Jul 12, 2005 15:55    Post subject: Reply with quote

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

' В параметрах вызова из 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
Back to top
View user's profile Send private message
LocKtaR-o-DarK



Joined: 12 Aug 2005
Posts: 349
Location: Москва

Post (Separately) Posted: Mon Aug 15, 2005 05:27    Post subject: Reply with quote

Ну групповое переименование тоже не отменяли
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Mon Aug 15, 2005 10:25    Post subject: Reply with quote

LocKtaR-o-DarK
Хочеться пофлеймить?
1. Можно ли создавать папки при групповом переименовании и перемещать туда файлы?
2. Если тебе удасться п. 1, то как составить регулярное выражение для выделения части имени до "-" в качестве имени папки с отбрасыванием концевых пробелов. Я понимаю, что п. 2 выполним, но сам не силен в регулярных выражениях. Однако, если уж ты что-то пишешь, пиши конкретно.
Back to top
View user's profile Send private message
dxangelo



Joined: 28 Apr 2006
Posts: 8
Location: Волгоград

Post (Separately) Posted: Fri Apr 28, 2006 05:42    Post subject: Re: Script Request Reply with quote

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


А как сделать, что бы поиск слова из буфера происходил внутри файлов (галочка "с текстом"), а поле "искать файлы" оставалось пустым...?!
Очень часто этим пользуюсь...
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Fri Apr 28, 2006 11:25    Post subject: Reply with quote

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

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.
Back to top
View user's profile Send private message
ADv



Joined: 03 Mar 2005
Posts: 47
Location: Украина

Post (Separately) Posted: Sat May 06, 2006 20:23    Post subject: Reply with quote

помогите, 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 Smile
Back to top
View user's profile Send private message
Вахмурка



Joined: 27 Dec 2004
Posts: 2584
Location: Большая деревня Москва

Post (Separately) Posted: Tue May 09, 2006 22:59    Post subject: Reply with quote

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

http://powerpro.wincmd.ru/Scripts/Find.htm#cliptext
_________________
Сайт PowerPro+Total Commander
Скрипты PowerPro для Total Commander
* * *
«Не усматривайте злого умысла в том, что вполне объяснимо глупостью» (Р. Хэнлон)
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Wed May 10, 2006 13:15    Post subject: Reply with quote

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

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

' В параметрах вызова из 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.
До сих пор не уяснил для себя, как при разборе строки параметров Гислер с кавычками работает.
Back to top
View user's profile Send private message
fa1con



Joined: 19 Aug 2006
Posts: 162

Post (Separately) Posted: Wed Aug 23, 2006 16:13    Post subject: Reply with quote

Нужен скрипт для установки случайных обоев из текущей директории TC (без поддиректорий). Если в текущей директории нет подходящих файлов, устанавливать обои из первого параметра запуска, если он не задан, устанавливать из директории по умолчанию.
Напишите плз, кто хорошо умеет.
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Wed Aug 23, 2006 18:27    Post subject: Reply with quote

Code:
'==============================================================================
' Установка в качестве обоев случайного файла из текущего каталога
' Для установки обоев используется программа 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. Задайте пусть к нему в скрипте.
Back to top
View user's profile Send private message
fa1con



Joined: 19 Aug 2006
Posts: 162

Post (Separately) Posted: Wed Aug 23, 2006 22:58    Post subject: Reply with quote

Хммм… Можно как то приводить кодировку строки имени файла? А то вместо
Code:
\\10.0.255.26\рисунки\Рисунки\WAR\01.jpg

IrfanView передается
Code:
\\10.0.255.26\@8AC=:8\Рисунки\WAR\01.jpg


Именно так: имя ресурса «рисунки» как «@8AC=:8», а каталог кириллицей нормально.
Back to top
View user's profile Send private message
Batya



Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия

Post (Separately) Posted: Thu Aug 24, 2006 09:52    Post subject: Reply with quote

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

Может кто-нибудь из специалистов по сетям скажет, почему такое может быть?
_________________
Нет, я не сплю. Я просто медленно моргаю.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    Total Commander Forum Index -> Автоматизация Total Commander All times are GMT + 4 Hours
Goto page 1, 2, 3 ... 40, 41, 42  Next
Page 1 of 42

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group