| View previous topic :: View next topic |
| Author |
Message |
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
 (Separately) Posted: Fri Jul 22, 2011 17:11 Post subject: |
 |
|
shveicar
Смена фокуса или переход вообще нигде не нужны? Тогда три строки нижние следует отправить в небытие. |
|
| Back to top |
|
 |
shveicar
Joined: 18 Apr 2011
Posts: 277
Location: Россия Москва
|
| (Separately) Posted: Fri Jul 22, 2011 17:35 Post subject: |
|
|
Спасибо за подсказку, теперь все "ок"
Добавлено спустя 1 час 43 минуты:
Вот только сейчас обнаружил, что скрипт работает исправно, только в пределах одного диска, а если в панелях открыты разные диски то вылетает ошибка | Code: |
Windows Script Host
Строка: 13
Символ: 7
Ошибка: Разрешение отклонено
Код: 800A0046
|
что можно с этим сделать? |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Fri Jul 22, 2011 19:29 Post subject: |
|
|
Не знаю насчёт разных дисков, но одну вещь я упустил.
Нужно в скрипте массово удалить то, что в скобках: ( & "\"). |
|
| Back to top |
|
|
shveicar
Joined: 18 Apr 2011
Posts: 277
Location: Россия Москва
|
| (Separately) Posted: Fri Jul 22, 2011 19:45 Post subject: |
|
|
Сделал, но опять - работает только в пределах одного диска.  и выскакивает та-же ошибка. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Fri Jul 22, 2011 20:02 Post subject: |
|
|
Да, что-то на папки ругается. Файлы перемещает. Замени | Code: | .MoveFolder F, TargetPath |
на | Code: | F.Copy TargetPath & .GetFolder(N).Name
F.Delete |
|
|
| Back to top |
|
|
shveicar
Joined: 18 Apr 2011
Posts: 277
Location: Россия Москва
|
| (Separately) Posted: Fri Jul 22, 2011 20:55 Post subject: |
|
|
Ура! Заработало.  |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Aug 17, 2011 01:11 Post subject: |
|
|
| Code: | ' Выделение в панелях одноимённых, но разноразмерных файлов и папок
' Необходима регистрация Script Helper ActiveX for TC
' Параметр: "%P" "%T"
'==================================================
With CreateObject("Scripting.FileSystemObject")
Set P = .GetFolder(WScript.Arguments(0))
Set T = .GetFolder(WScript.Arguments(1))
End With
Set D = CreateObject("Scripting.Dictionary")
Set G = CreateObject("Scripting.Dictionary")
For Each F in P.SubFolders
D.Add F.Name, F.Size
Next
For Each F in T.SubFolders
G.Add F.Name, F.Size
Next
For Each F in D.Keys
If G.Exists(F) And D(F) <> G(F) Then S = S & vbnewline & F & "\"
Next
D.RemoveAll
G.RemoveAll
For Each F in P.Files
D.Add F.Name, F.Size
Next
For Each F in T.Files
G.Add F.Name, F.Size
Next
For Each F in D.Keys
If G.Exists(F) And D(F) <> G(F) Then S = S & vbnewline & F
Next
With CreateObject("TCScript.Helper")
T = .GetTextFromClip
.SetTextToClip(S)
.LockTC True
.SendCommand 4001
.SendCommand 2033
.SendCommand 4002
.SendCommand 2033
.LockTC False
.SetTextToClip(T)
End With
Wscript.Quit |
|
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Wed Aug 17, 2011 19:10 Post subject: |
|
|
| Code: | ' Отправить в буфер RGB-число
Do Until Main
Loop
Function Main
Main = False
L = vbNewLine
A = InputBox(L&" Введите через пробел три числа (0-255),"&_
" соответствующие своему цвету "& L & " ""красный зелёный синий""",_
" Конвертация в RGB-число","0 0 0")
If A = vbNullString Then WScript.Quit
For i = 1 to Len(A)
N = Mid(A,i,1)
If N = " " Then Sp = Sp & N
Next
If Len(Sp) <> 2 Then
MsgBox "Необходимо указать 3 числа с 2-мя пробелами !", vbExclamation,_
" Конвертация в RGB-число"
Exit Function
End If
R = Left(A, Instr(A," ")-1)
C = Mid(A,Len(R)+2)
G = Left(C, Instr(C," ")-1)
B = Mid(A, InstrRev(A," ")+1)
For Each E in Array(R,G,B)
If IsNumeric(E)=False Then
MsgBox "Все значения должны быть числовыми !", vbExclamation,_
" Конвертация в RGB-число"
Exit Function
End if
If E<0 Or E>255 Then
MsgBox "Все числа должны лежать в диапазоне [0-255] !", vbExclamation,_
" Конвертация в RGB-число"
Exit Function
End If
Next
Main = True
Dim WSH
Set WSH = CreateObject("WScript.Shell")
P = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
A = WSH.RegRead(P)
If A > 0 Then WSH.RegWrite P, 0, "REG_DWORD"
With CreateObject("InternetExplorer.Application")
.Navigate("about:blank")
.document.parentWindow.clipboardData.setData "text", Trim(RGB(R, G, B))
.Quit
End With
If A > 0 Then WSH.RegWrite P, A, "REG_DWORD"
Set WSH = Nothing
WScript.Quit
End Function |
Last edited by Flasher on Fri Aug 19, 2011 22:38; edited 1 time in total |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2224
Location: Москва, Россия
|
| (Separately) Posted: Fri Aug 19, 2011 10:26 Post subject: |
|
|
| Flasher wrote: | | ' Отправить в буфер RGB-число |
У меня IE при каждом запуске требует разрешения на на доступ к буферу обмена. Менять настройки не хочу. Переделал скрипт от Flasher с выводом результата в окне. Кому надо (например, мне ), самостоятельно нажмёт Ctrl+C.
| Code: | '=====================================================================
' Вычисление RGB-числа
'=====================================================================
Option Explicit
Dim R, G, B, A, Flag, MM
Const Title = "Вычисление RGB-числа"
On Error Resume Next
Do
A = InputBox("Введите через пробел три числа [0-255]," & vbnewLine & _
"соответствующие своему цвету " & vbNewLine & _
"""красный зелёный синий""", Title, "0 0 0")
If A = "" Then WScript.Quit
With New RegExp
.Pattern = "^ *(\d+) +(\d+) +(\d+) *$"
.IgnoreCase = True
.Global = True
Set MM = .Execute(A)(0).SubMatches
End With
Flag = (Err.Number = 0)
If Flag Then
R = MM(0) : G = MM(1) : B = MM(2)
Flag = (R <= 255 And G <= 255 And B <= 255)
If Not Flag Then Mess 2
Else
Mess 1
Err.Clear
End If
Loop Until Flag
On Error GoTo 0
InputBox "Результат:", Title, RGB(R, G, B)
WScript.Quit
Sub Mess(Mode)
Dim lStr
Select Case Mode
Case 1 lStr = "Необходимо указать 3 числа, разделённых пробелами!"
Case 2 lStr = "Все числа должны лежать в диапазоне [0-255]!"
End Select
MsgBox lStr, vbExclamation, Title
End Sub |
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Fri Aug 19, 2011 15:16 Post subject: |
|
|
| Batya wrote: | | требует разрешения на на доступ к буферу обмена. Менять настройки не хочу. |
А у других требует объект Helper (где он задействован), причём гораздо чаще. А причина нехотения в чём?
Собственно, исправил скрипт персонально под твоё "не хочу". 
| Batya wrote: | | Переделал скрипт от Flasher с выводом результата в окне. |
У меня сперва тоже было окно, но оно только мешало. Короче не резон этим пользоваться, см. сюда. Нижние три программы имеют кнопку копирования значения в буфер. |
|
| Back to top |
|
|
dude
Joined: 21 Jan 2011
Posts: 11
|
| (Separately) Posted: Thu Aug 25, 2011 20:15 Post subject: |
|
|
Достаточно специфический реквест скрипта. Думаю, лучше и проще прямо описать в действиях желаемое от него:
Имеется несколько ZIP-архивов с упакованными PNG-файлами, размещенными в различных каталогах в каждом из архивов.
Что хотелось бы?:
1. Скрипт распаковывает (желательно с помощью 7-ZIP) каждый из выделенных архивов во временную директорию ( в свою для каждого — это очевидно).
2. Рекурсивно для всех каталогов данного архива переименовывает, точнее — заменяет в именах файлов предопределенный набор символов другими (например, символы скобок, дефисов, копирайтов, процентов и пр. на пробел или нижнее подчеркивание).
3. Затем создает тут же в корневой директории каталог с именем 128х128.
4. Все найденные переименованные PNG копируются из соседних директорий в этот каталог, соответственно скрипт меняет (ясно, с помощью внешнего приложения, идеально бы — XNView) размер копируемых PNG на 128х128 пикс. Все совпадения в именах (а они будут) решаются выбором файла с наибольшим весом, остальные пропускаются.
5. Далее все подкаталоги с новым 128х128 и переименованными файлами перемещаются с заменой в исходный ZIP-архив, и сохранение архива.
* выбор архиватора и конвертера не критичен и может быть любым иным
** сразу скажу, что данный реквест не сиюминутная блажь. Все вышеописанные манипуляции — единственная безыдейная и механическая часть моей ежедневной деятельности и отнимающая чудовищное количество времени у куда более важных рабочих задач. И было бы очень мягким выражением сказать, что данный скрипт невероятно облегчил бы жизнь. Даже так, да)
*** понимаю, что конструкция выглядит сложно, но, надеюсь, будут варианты если не полного выполнения скриптом описанных задач, то хоть частично.
upd. ок, решилось почти все nncron'ом с привязкой пары утилит
но реализация скриптом через тотал было бы идеальным вариантом |
|
| Back to top |
|
|
panalex
Joined: 31 Oct 2011
Posts: 3
Location: Гомель, Беларусь
|
| (Separately) Posted: Mon Oct 31, 2011 16:15 Post subject: Как рассортировать по авторам (в папки) много файлов |
|
|
Добрый, наверное, день, господа.
Возникла у меня такая ситуация - есть много файлов с самиздата вида *.shtml в одной папке. Хочу раскидать их по папкам с именами авторов, которые есть в 10-й строке кода до двоеточия
| Code: | <html>
<head>
<!-- text/html; charset=windows-1251 from header (HC) -->
<title>Хван Дмитрий Иванович. Обновление. Глава 7</title>
</head>
<body bgcolor="#E9E9E9">
<div align=right><h3>
Хван Дмитрий Иванович: <small><a href=/h/hwan_d_i/>другие произведения.</a></small>
</h3></div> |
Возможно ли это сделать с помощью скрипта и как. Я не программист совершенно, поэтому и обращаюсь за помощью. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Mon Oct 31, 2011 17:00 Post subject: |
|
|
panalex
На какой глубине располагаются эти файлы, и где должны быть папки-получатели?
Названия можно было и не выносить в отдельную строку, это не принципиально при написании скрипта. |
|
| Back to top |
|
|
panalex
Joined: 31 Oct 2011
Posts: 3
Location: Гомель, Беларусь
|
| (Separately) Posted: Mon Oct 31, 2011 17:57 Post subject: |
|
|
Flasher
Все файлы лежат в одной папке. Создавать папки с именем автора здесь же и перемещать туда файл. Файлов одного автора может быть несколько. Они должны попасть в одну папку.
В имени автора может быть от 1 до 4 слов, но заканчивается оно двоеточием, начинается с начала строки. |
|
| Back to top |
|
|
Flasher
Joined: 06 Nov 2009
Posts: 14229
Location: Москва
|
| (Separately) Posted: Mon Oct 31, 2011 19:00 Post subject: |
|
|
По-простому, без изысков:
| Code: | ' Перемещение выделенных файлов в создаваемые рядом папки
' с именами начал 10-х строк этих файлов до двоеточия
' Параметр: %L
'========================================================
With CreateObject("Scripting.FileSystemObject")
Set TF = .OpenTextFile(WScript.Arguments(0), 1)
Do While Not TF.AtEndOfStream
F = TF.ReadLine
If F > vbNullString And .FileExists(F) Then
FF = LTrim(Split(.OpenTextFile(F,,,-2).ReadAll, vbNewLine)(9))
Trg = .GetParentFolderName(F) & "\" & Left(FF, InStr(FF, ":") - 1)
If Not .FolderExists(Trg) Then .CreateFolder Trg
.MoveFile F, Trg & "\"
End If
Loop
TF.Close
End With |
Файлы должны быть сохранены в ANSI или UTF-16. |
|
| 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
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
