WSH + TCScript = мощное средство автоматизации TC!

[Spine]

а файлы с расширением в верхнем регистре всё-таки не сортируются
видно винде не всёравно... или скрипту...

[Volniy]

<!--QuoteBegin-Ti-Mac+Jul 24 2004, 08:38--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата (Ti-Mac @ Jul 24 2004, 08:38)</td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->2Volniy
Так Виндосу же всё равно.
<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->
Windows все равно, он даже готов работать вааще с ДОС-именами. А вот скрипту не все равно. Он ведь у тебя производит прямое сравнение (=) реального расширения файла с расширением из заданного списка. Классическое решение такой проблемки - приведение обоих величин перед сравнением к одному регистру, например:

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

If Ucase(Fso.GetExtensionName(F.Name)) = Ucase(ext) or Ext = "" then

Или чуть более утонченно Тут 1-ца в функции сравнения строк StrComp указывает на то, что при сравнении регистр не учитывается)

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

If StrComp(Fso.GetExtensionName(F.Name) , Ext, 1) = 0 Or Ext = "" then

Рекомендую также всем интересующимся скриптами <a href='http://rusproject.narod.ru/guide.htm' target='_blank'>скачать здесь</a> справочники на русском языке по основным функциям VB и FileSystemObject.

[Ti-Mac]

<!--QuoteBegin--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата </td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->[History]
1.2 beta

-  Cортирует с рисширениями в любом регистре
+ Измененён вид создаваемой папки ("24_Июль_2004 - cуббота")<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->

<!--QuoteBegin--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата </td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->
-----------------------------------8<---------------------------------------------------------
<span style='font-size:8pt;line-height:100%'>
YourDir ="D:\Downloads\"
Ext = "zip,rar,exe,msi,chm,rtf,doc,txt"

Dim Flag
Set fso = CreateObject("Scripting.FileSystemObject")

    Set Dir=FSO.GetFolder(YourDir)
    Flag = False
   
   If ext <> "" Then
     Allext = Split(ext, ",")
     For Each e In Allext
        Call Sort(Trim(e))
     Next
   Else
     Call Sort(ext)
   End If

    If flag Then
           MsgBox "Файлы в папке "&YourDir&" отсортированы по датам!",  vbInformation
    Else
           MsgBox "В папке "&YourDir&" нет новых файлов для сортировки!",       vbInformation
    End If
 
Set fso = Nothing
WScript.Quit


Sub Sort (ext)
     For Each F In Dir.Files
        If StrComp(Fso.GetExtensionName(F.Name) , Ext, 1)=0 or Ext = "" then
        DC = F.DateCreated
        DC =Day(DC) & "_" & MonthName(Month(DC)) & "_" & Year(DC) & " - " & WeekDayName(WeekDay(DC),False)
        NewDir = Dir.path & "\" & DC & "\"
             If Not FSO.FolderExists(NewDir) Then FSO.CreateFolder(NewDir)
        If fso.fileexists(NewDir+f.name) then fso.DeleteFile(NewDir+f.name)
        f.move (NewDir)
        Flag = True
        end if
    Next
End Sub</span><!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->

[Ti-Mac]

У меня TCscript не хочет работать. Ну вроде его запустил, но Demo_sample.vbs выдаёт ошибку, то же самое со всеми другими скриптами...
WIN98 SE RUS

[Spine]

2Ti-Mac
ИМХО предыдущий вид создаваемой папки был логичнее для понимания и проще для сортировки... но в принципе поправить под себя может даже тот кто WSH вообще впервые видит, типа меня

[Volniy]

<!--QuoteBegin-Ti-Mac+Jul 24 2004, 19:42--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата (Ti-Mac @ Jul 24 2004, 19:42)</td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->У меня TCscript не хочет работать. Ну вроде его запустил, но Demo_sample.vbs выдаёт ошибку, то же самое со всеми другими скриптами...<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->
Что за ошибка? Конкретней. И что значит "со всеми другими скриптами". В смысле со скриптами, использующими TCS Helper? Или вааще со всеми? На всякий случай проверь наличие библиотеки msvbvm50.dll в системной папке. И второе: после каждого перемещения exe-файла хелпера в другую папку нужно хотя бы раз запустить его как обычную прогу.
Или может быть на этой строке спотыкается:

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

If TCS.LoadIncFile("C:\Program Files\wincmd\TOTALCMD.INC") = False

тогда надо уточнить твой путь к этому файлу или положить его копию в папку с хелпером

A если честно, то я Helper не для публикации делал вообще. А если говорить о нем, как о чем-то востребованном (?), то я хотел бы тогда увидеть хоть какой-то виш-лист. Если таковой будет, я мог бы и чуть серьезней отнестись к этому "незаконнорожденному"

[Spine]

и ещё насчёт "DirMakeDate.vbs" он ведь описания к файлам из "descript.ion"не переносит , а я както повадился всю необходимую инфу туда загонять...
можно ли дополнить скрипт такой функцией? (ответ "можно, дополняй" не подходит, я не умею...)

[Ti-Mac]

2Volniy
Нету msvbvm50.dll. Где взять для моей Винды?
2Spine
Ответ: "Можно, но это сильно муторно, я ведь тоже новичок" Проси Вольного. Он спец по VB-функциям вот и сделает быстро.

[Spine]

2Volniy
сделай доброе дело, добавь такую фичу в скрипт, уж очень полезная примочка получится...

[Volniy]

<!--QuoteBegin-Ti-Mac+Jul 25 2004, 10:54--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата (Ti-Mac @ Jul 25 2004, 10:54)</td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->2Volniy
Нету msvbvm50.dll. Где взять для моей Винды?
<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->
Да в ней-же, в самой Винде, в ее дистрибутиве тоесть (как вообще он мог у тебя удалиться?). В моем win98se он лежит в WIN98_36.CAB. А вообще есть такая полезная штука в винде - SFC (System File Checker). Запускаешь его, отмечаешь "Извлечь..." и потом только указываешь, где дистрибутив и куда положить файл. На всякий случай после извлечения файла выполни в командной строке:

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

regsvr32 msvbvm50.dll

2Spine Вспомни, сколько времени прошло, пока Гислера уломали включить поддержку описаний
Я могу посмотреть, но только ты сперва уточни, что именно надо. Не повторять же мне всю функциональность описаний внутри одного скрипта

[Ti-Mac]

2Volniy
Установил файл, запустил regsvr32 msvbvm50.dll. И всё равно не работает
Выдаёт ошибку на строке Set TCS = CreateObject("TCSCRIPT.Helper")

[Volniy]

Вас дождешься, как же, небось на пляжу ужо загораем Ну да ладно, ловите

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

Sub MoveDescription(forFile, SourceION, TargetION)
  Dim AllNew, AllOld
  Const ForReading = 1, ForWriting = 2
  Dim i, tmp, TS1, TS2, NoAdd
 
  If fso.FileExists(SourceION) Then ' Ищем описание для файла в исходном файле
     Set TS1 = fso.OpenTextFile(SourceION, ForReading)
     AllOld = Split(TS1.ReadAll, vbCrLf)
     TS1.Close
     For i = 0 To UBound(AllOld) - 1
        If InStr(1, AllOld(i), forFile, 1) Then
           tmp = AllOld(i) ' нашли описание и сохранили в tmp
           AllOld(i) = AllOld(UBound(AllOld) - 1) ' переносим с конца
           AllOld(UBound(AllOld) - 1) = ""
           ReDim Preserve AllOld(UBound(AllOld) - 1) ' укорачиваем
           Exit For
        End If
     Next
  End If

  If Len(tmp) Then ' Если описание для файла найдено
     If fso.FileExists(TargetION) Then
        Set TS2 = fso.OpenTextFile(TargetION, ForReading)
        AllNew = Split(TS2.ReadAll, vbCrLf)
        TS2.Close
       
        For i = 0 To UBound(AllNew) - 1
           If InStr(1, AllNew(i), forFile, 1) Then
              AllNew(i) = tmp
              NoAdd = True  ' существующее описание заменили и добавлять строки не нужно
              Exit For
           End If
        Next
       
        If NoAdd = False Then          ' Придется добавить
           i = UBound(AllNew)
           AllNew(i) = tmp              ' занесем новое описание в последнюю строку
           ReDim Preserve AllNew(i + 1)
        End If
     Else
  '       Если файла нет, то будем заполнять его с нуля
          AllNew = Split(tmp & vbNewLine, vbNewLine) ' занесли описание в массив
 
     End If
     
        ' Записываем оба файла descript.ion
        Set TS2 = fso.OpenTextFile(TargetION, ForWriting, True)
        TS2.Write Join(AllNew, vbNewLine)
        TS2.Close
        fso.GetFile(TargetION).Attributes = 34 ' Атрибут Скрытый
       
        Set TS2 = fso.OpenTextFile(SourceION, ForWriting, True)
        TS2.Write Join(AllOld, vbNewLine)
        TS2.Close
        fso.GetFile(SourceION).Attributes = 34 ' Атрибут Скрытый
  End If
 
  Set TS1 = Nothing
  Set TS2 = Nothing
End Sub


Эту подпрограмму нужно вставить в скрипт. Что бы ее вызвать в скрипте имени Ti-mac-а добавьте после строки

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

       f.move (NewDir)

строчку

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

       Call MoveDescription(F.Name, dir.Path & "\descript.ion", newdir & "descript.ion")

PS Код мне самому как-то не очень нравится, но он работает

2 Ti-Mac Что-то непонятое у тебя происходит . А вообще он запускается с показом окошка О программе? И еще попробуй его запустить так

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

TCScript.exe /regserver

Кроме того, что у тебя не было обязательной для твоей системы библиотеки, может оказаться, что у тебя еще чего из важного недостает (признавайся: делал чистки ). Надо бы установить рантайм бейсиковский, например <a href='http://download.microsoft.com/download/vb50pro/Utility/1/WIN98/EN-US/MSVBVM50.EXE' target='_blank'>этот</a> или может даже лучше <a href='http://download.microsoft.com/download/vba6/Utility/1/WIN98/EN-US/vbrun60sp3.EXE' target='_blank'>вот этот</a> Там уже ставится все, что нужно.

[Ti-Mac]

<!--QuoteBegin--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата </td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->TCScript.exe /regserver<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->
Так что ж ты раньше молчал? ЗАСКРИПЕЛ СКРИПТ!!!!!!!!!!!!!!!!!!!!!!

Ловите новый небольшой скриптик. Скопируйте в буфер адрес ключа реестра и запустите GotoRegKey.vbs из меню Start TC. Через пол секунды этот ключ для вас откроется в панели автоматически.
Дополнительные фишки:
- скрипт подчищает адрес от не нужных пробелов
- поддерживает адреса через двойной разделитель "\\"
- разделитель в конце адреса не обязательно вводить
- проверка реестра на наличие данного ключа
- быстрое создание нового ключа если не найден
В переменную RegPlugin укажите путь к вашему регистровому плагину TC

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

' File: GotoRegKey.vbs

Dim TCS, WSHshell, BufText, tmp
Set TCS = CreateObject("TCSCRIPT.Helper")
Set WshShell = WScript.CreateObject("WScript.Shell")

RegPlugin = "\\\Registry\"

BufText = TCS.GetTextFromClip
BufText = Replace(BufText,"\\","\")

tmp = Split(BufText, "\")
   For i=0 to UBound(tmp)
             tmp(i) = trim(tmp(i))
   Next
 
BufText = Join(tmp, "\")
    If Right(BufText,1) <> "\" Then BufText = BufText + "\"

On Error Resume Next
WShShell.RegRead BufText

If Err.Number = -2147024894 Then
  Answer = MsgBox (BufText & vbNewLine & "Такого ключа не существует" & vbNewLine &  _
  "Создать этот ключ?", vbOkCancel + vbquestion, "GotoRegKey.vbs - Создать ключ?")
                If Answer = vbOk Then
                                   WShShell.RegWrite Buftext, ""                                                                             WShShell.Sleep 1000
                                   Call GoKey
                                   WScrip.Quit
                 Else
                                   Wscript.Quit
End if

Elseif err.Number <> 0 Then
    MsgBox "Введённый адрес не является адресом реестра", vbcritical, "GotoRegKey.vbs - Ошибка"
    WScript.Quit
End If

Call GoKey
WScrip.Quit

Sub GoKey
 WshShell.Sendkeys("{LEFT}")
 WScript.Sleep 300
 WshShell.Sendkeys("cd " & RegPlugin & BufText )
 WScript.Sleep 300
 WshShell.Sendkeys("{ENTER}")
 WScript.Quit
End Sub



[lef]

<!--QuoteBegin--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата </td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->А что, это как-то мешает? Подозреваю, что в это время в буфере уже хранилось нечто иное и при этом нужное, да?<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->
Ну как-бы непорядочек, могло бы и хранится

<!--QuoteBegin--></div><table border='0' align='center' width='95%' cellpadding='3' cellspacing='1'><tr><td>Цитата </td></tr><tr><td id='QUOTE'><!--QuoteEBegin-->Как тут уже не раз упоминалось, можно пойти другим путем и передавать в скрипт через командную строку (параметры %L, %l, %F, %f, %D, %d) файл со списком выделенных файлов, а потом его читать.<!--QuoteEnd--></td></tr></table><div class='postcolor'><!--QuoteEEnd-->

Это конечно понятно, но на самом деле хотелось бы, чтобы ты реализовал подобную команду:

For each f In TCS.GetSelectedFiles

Ну и остальное не помешало бы, наподобие Активного окна, выделенных файлов в противоположном окне, в общем всего того, что можно передать через параметры Коммандера (%L, %l, %F, %f, %D ...)

[Ti-Mac]

2All
Объясните по какому принципу работает F4