View previous topic :: View next topic |
Author |
Message |
ADv
Joined: 03 Mar 2005 Posts: 47 Location: Украина
|
(Separately) Posted: Tue Jul 05, 2005 21:21 Post subject: Script Request |
|
|
помогите.. нужны скрипты для:
1) запуск поиска в текущей папке файла, имя которого находится в буфере
2) Создание папки с частью имени mp3-файла (например Rammsten - Reise, Reise.mp3 перемещается в созданную папку Rammstein).
Mr.Volniy?
_________________________________________________________
http://my.opera.com/advokat_b/affiliate/ |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Tue Jul 12, 2005 11:11 Post subject: |
|
|
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 |
|
|
ADv
Joined: 03 Mar 2005 Posts: 47 Location: Украина
|
(Separately) Posted: Tue Jul 12, 2005 14:11 Post subject: |
|
|
по исполнителю, т.е. по тому, что находится до "-". в моем примере - rammstein (должна создаться папка Rammstein). спасибо |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Tue Jul 12, 2005 15:55 Post subject: |
|
|
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 |
|
|
LocKtaR-o-DarK
Joined: 12 Aug 2005 Posts: 349 Location: Москва
|
(Separately) Posted: Mon Aug 15, 2005 05:27 Post subject: |
|
|
Ну групповое переименование тоже не отменяли |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Mon Aug 15, 2005 10:25 Post subject: |
|
|
LocKtaR-o-DarK
Хочеться пофлеймить?
1. Можно ли создавать папки при групповом переименовании и перемещать туда файлы?
2. Если тебе удасться п. 1, то как составить регулярное выражение для выделения части имени до "-" в качестве имени папки с отбрасыванием концевых пробелов. Я понимаю, что п. 2 выполним, но сам не силен в регулярных выражениях. Однако, если уж ты что-то пишешь, пиши конкретно. |
|
Back to top |
|
|
dxangelo
Joined: 28 Apr 2006 Posts: 8 Location: Волгоград
|
(Separately) Posted: Fri Apr 28, 2006 05:42 Post subject: Re: Script Request |
|
|
ADv wrote: | помогите.. нужны скрипты для:
1) запуск поиска в текущей папке файла, имя которого находится в буфере
|
А как сделать, что бы поиск слова из буфера происходил внутри файлов (галочка "с текстом"), а поле "искать файлы" оставалось пустым...?!
Очень часто этим пользуюсь... |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Fri Apr 28, 2006 11:25 Post subject: |
|
|
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 |
|
|
ADv
Joined: 03 Mar 2005 Posts: 47 Location: Украина
|
(Separately) Posted: Sat May 06, 2006 20:23 Post subject: |
|
|
помогите, 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 |
|
Back to top |
|
|
Вахмурка
Joined: 27 Dec 2004 Posts: 2584 Location: Большая деревня Москва
|
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Wed May 10, 2006 13:15 Post subject: |
|
|
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 |
|
|
fa1con
Joined: 19 Aug 2006 Posts: 162
|
(Separately) Posted: Wed Aug 23, 2006 16:13 Post subject: |
|
|
Нужен скрипт для установки случайных обоев из текущей директории TC (без поддиректорий). Если в текущей директории нет подходящих файлов, устанавливать обои из первого параметра запуска, если он не задан, устанавливать из директории по умолчанию.
Напишите плз, кто хорошо умеет. |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Wed Aug 23, 2006 18:27 Post subject: |
|
|
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 |
|
|
fa1con
Joined: 19 Aug 2006 Posts: 162
|
(Separately) Posted: Wed Aug 23, 2006 22:58 Post subject: |
|
|
Хммм… Можно как то приводить кодировку строки имени файла? А то вместо
Code: | \\10.0.255.26\рисунки\Рисунки\WAR\01.jpg |
IrfanView передается
Code: | \\10.0.255.26\@8AC=:8\Рисунки\WAR\01.jpg |
Именно так: имя ресурса «рисунки» как «@8AC=:8», а каталог кириллицей нормально. |
|
Back to top |
|
|
Batya
Joined: 15 Dec 2004 Posts: 2220 Location: Москва, Россия
|
(Separately) Posted: Thu Aug 24, 2006 09:52 Post subject: |
|
|
fa1con
Странно. У меня даже в сети все нормально передается.
Может кто-нибудь из специалистов по сетям скажет, почему такое может быть? _________________ Нет, я не сплю. Я просто медленно моргаю. |
|
Back to top |
|
|
|
|
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
|