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 Previous  1, 2, 3 ... 20, 21, 22 ... 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
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Fri Jul 22, 2011 17:11    Post subject: Reply with quote

shveicar
Смена фокуса или переход вообще нигде не нужны? Тогда три строки нижние следует отправить в небытие.
Back to top
View user's profile Send private message
shveicar



Joined: 18 Apr 2011
Posts: 277
Location: Россия Москва

Post (Separately) Posted: Fri Jul 22, 2011 17:35    Post subject: Reply with quote

Спасибо за подсказку, теперь все "ок"

Добавлено спустя 1 час 43 минуты:

Вот только сейчас обнаружил, что скрипт работает исправно, только в пределах одного диска, а если в панелях открыты разные диски то вылетает ошибка
Code:

Windows Script Host
Строка:   13
Символ:   7
Ошибка:   Разрешение отклонено
Код:   800A0046
что можно с этим сделать?
Back to top
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Fri Jul 22, 2011 19:29    Post subject: Reply with quote

Не знаю насчёт разных дисков, но одну вещь я упустил.
Нужно в скрипте массово удалить то, что в скобках: ( & "\").
Back to top
View user's profile Send private message
shveicar



Joined: 18 Apr 2011
Posts: 277
Location: Россия Москва

Post (Separately) Posted: Fri Jul 22, 2011 19:45    Post subject: Reply with quote

Сделал, но опять - работает только в пределах одного диска. Rolling Eyes и выскакивает та-же ошибка.
Back to top
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Fri Jul 22, 2011 20:02    Post subject: Reply with quote

Да, что-то на папки ругается. Файлы перемещает. Замени
Code:
      .MoveFolder F, TargetPath

на
Code:
      F.Copy TargetPath & .GetFolder(N).Name
      F.Delete
Back to top
View user's profile Send private message
shveicar



Joined: 18 Apr 2011
Posts: 277
Location: Россия Москва

Post (Separately) Posted: Fri Jul 22, 2011 20:55    Post subject: Reply with quote

Ура! Заработало. Smile
Back to top
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Wed Aug 17, 2011 01:11    Post subject: Reply with quote

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
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Wed Aug 17, 2011 19:10    Post subject: Reply with quote

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
View user's profile Send private message
Batya



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

Post (Separately) Posted: Fri Aug 19, 2011 10:26    Post subject: Reply with quote

Flasher wrote:
' Отправить в буфер RGB-число

У меня IE при каждом запуске требует разрешения на на доступ к буферу обмена. Менять настройки не хочу. Переделал скрипт от Flasher с выводом результата в окне. Кому надо (например, мне Smile ), самостоятельно нажмёт 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
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Fri Aug 19, 2011 15:16    Post subject: Reply with quote

Batya wrote:
требует разрешения на на доступ к буферу обмена. Менять настройки не хочу.
А у других требует объект Helper (где он задействован), причём гораздо чаще. А причина нехотения в чём?
Собственно, исправил скрипт персонально под твоё "не хочу". Wink

Batya wrote:
Переделал скрипт от Flasher с выводом результата в окне.
У меня сперва тоже было окно, но оно только мешало. Короче не резон этим пользоваться, см. сюда. Нижние три программы имеют кнопку копирования значения в буфер.
Back to top
View user's profile Send private message
dude



Joined: 21 Jan 2011
Posts: 11

Post (Separately) Posted: Thu Aug 25, 2011 20:15    Post subject: Reply with quote

Достаточно специфический реквест скрипта. Думаю, лучше и проще прямо описать в действиях желаемое от него:
Имеется несколько ZIP-архивов с упакованными PNG-файлами, размещенными в различных каталогах в каждом из архивов.
Что хотелось бы?:
1. Скрипт распаковывает (желательно с помощью 7-ZIP) каждый из выделенных архивов во временную директорию ( в свою для каждого — это очевидно).
2. Рекурсивно для всех каталогов данного архива переименовывает, точнее — заменяет в именах файлов предопределенный набор символов другими (например, символы скобок, дефисов, копирайтов, процентов и пр. на пробел или нижнее подчеркивание).
3. Затем создает тут же в корневой директории каталог с именем 128х128.
4. Все найденные переименованные PNG копируются из соседних директорий в этот каталог, соответственно скрипт меняет (ясно, с помощью внешнего приложения, идеально бы — XNView) размер копируемых PNG на 128х128 пикс. Все совпадения в именах (а они будут) решаются выбором файла с наибольшим весом, остальные пропускаются.
5. Далее все подкаталоги с новым 128х128 и переименованными файлами перемещаются с заменой в исходный ZIP-архив, и сохранение архива.

* выбор архиватора и конвертера не критичен и может быть любым иным
** сразу скажу, что данный реквест не сиюминутная блажь. Все вышеописанные манипуляции — единственная безыдейная и механическая часть моей ежедневной деятельности и отнимающая чудовищное количество времени у куда более важных рабочих задач. И было бы очень мягким выражением сказать, что данный скрипт невероятно облегчил бы жизнь. Даже так, да)
*** понимаю, что конструкция выглядит сложно, но, надеюсь, будут варианты если не полного выполнения скриптом описанных задач, то хоть частично.

upd. ок, решилось почти все nncron'ом с привязкой пары утилит
но реализация скриптом через тотал было бы идеальным вариантом
Back to top
View user's profile Send private message
panalex



Joined: 31 Oct 2011
Posts: 3
Location: Гомель, Беларусь

Post (Separately) Posted: Mon Oct 31, 2011 16:15    Post subject: Как рассортировать по авторам (в папки) много файлов Reply with quote

Добрый, наверное, день, господа.
Возникла у меня такая ситуация - есть много файлов с самиздата вида *.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
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Mon Oct 31, 2011 17:00    Post subject: Reply with quote

panalex
На какой глубине располагаются эти файлы, и где должны быть папки-получатели?

Названия можно было и не выносить в отдельную строку, это не принципиально при написании скрипта.
Back to top
View user's profile Send private message
panalex



Joined: 31 Oct 2011
Posts: 3
Location: Гомель, Беларусь

Post (Separately) Posted: Mon Oct 31, 2011 17:57    Post subject: Reply with quote

Flasher
Все файлы лежат в одной папке. Создавать папки с именем автора здесь же и перемещать туда файл. Файлов одного автора может быть несколько. Они должны попасть в одну папку.
В имени автора может быть от 1 до 4 слов, но заканчивается оно двоеточием, начинается с начала строки.
Back to top
View user's profile Send private message
Flasher



Joined: 06 Nov 2009
Posts: 14229
Location: Москва

Post (Separately) Posted: Mon Oct 31, 2011 19:00    Post subject: Reply with quote

По-простому, без изысков:
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
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 Previous  1, 2, 3 ... 20, 21, 22 ... 40, 41, 42  Next
Page 21 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