Скрипты для Total Commander
-
Скрипты - уникальный инструмент для достижения различных целей в работе с файлами и не только, особенно в файловом менеджере, даже если вы раньше об этом ничего не слышали и не знали, то путём простых движений вы можете оптимизировать свои действия
Тема тестирования скриптов создана для увеличения функциональности Total Commander
Всё это делается для тех, кто хочет экономить время и автоматизировать работу
Огромное спасибо участникам, авторам и всем повлиявшим на тему
#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
В этой теме Каждый может выложить свой скрипт, написанный на любом языке: vbs, js, hta, au3,ahk, bat,cmd... - главное, чтобы он относился как-то к Total Commander, можно было им воспользоваться и к нему было должное описание к применению.
#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
В теме "Тестирование и заказ скриптов" Каждый может протестировать, дать свой комментарий (все комментарии из этой темы будут удаляться)...если есть интересная идея, вы так же можете поделиться ей в соседней теме и заказать скрипт, а вдруг она покажется интересной для авторов...
#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#Сообщение отредактировал LonerD 25 апреля 2017 - 04:38Читайте: Справочные материалы по работе c TC + Онлайн справка TC
22 ноября 2011 - 13:03 / #1 -
RunSelectInABCTextConverter.vbs
Конвертирование ВЫДЕЛЕННЫХ "текстовых" файлов ПО ОЧЕРЕДИ программой ABCtext.exe
Скачать ABCTextConverter' RunSelectInABCTextConverter.vbs
'======================== Описание =====================================
' Конвертирование ВЫДЕЛЕННЫХ "текстовых" файлов ПО ОЧЕРЕДИ программой ABCtext.exe
'======================== Параметры =====================================
' 1-й параметр: Cписок файлов
' 2-й параметр: путь\куда\конвертировать
' 3-й параметр: расширение ABC
' 4-й параметр: параметр1 ABC
' 5-й параметр: параметр2 ABC
' Дополнительные 3, 4, 5 параметры необходимо смотреть в справке программы
'======================== Примеры =====================================
' %L %t "pdf" 3 0 - Конвертация .TXT под курсором в .PDF
' %L %t "txt" 0 5 - Конвертация .HTML .HTM .MHT под курсором в .TXT (ANSI)
' %L %t "html" 7 1 - Конвертация .DOC .DOCX .RTF под курсором в .HTML
'
' Автор: Аверин Андрей
' Версия: 1.2 (07.10.2010 - 08.11.2011)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru
Option Explicit
'==================== Изменяемые пути ==================================
Program = "%COMMANDER_PATH%\Utilities\Texts\AbcText\Abctext.exe"
'========================================================================
If WScript.Arguments.Count < 5 Then
MsgBox "Не хватает параметров!" & vbNewLine &_
"Должно быть минимум ПЯТЬ параметра" & vbNewLine &_
"Примкр: %L %t ''html'' 7 1", vbOKOnly & vbInformation,_
"Конвертирование выделенных ''текстовых'' файлов"
WScript.Quit
End If
Dim FSO, WSH, ListFile, Program, Param, TPath, Name, Ext, P1, P2
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Program = GetPath(Program)
If Not FSO.FileExists(Program) Then
MsgBox "Не правильно указан путь до Abctext.exe", vbOKOnly & vbInformation,_
"Конвертирование выделенных ''текстовых'' файлов"
WsEnd
End If
With WScript
TPath = .Arguments(1) : Ext = .Arguments(2) : P1 = .Arguments(3) : P2 = .Arguments(4)
Set ListFile = FSO.OpenTextFile(GetPath(.Arguments(0)), 1)
End With
Do While Not ListFile.AtEndOfStream
Param = ListFile.ReadLine : Name = FSO.GetBaseName(Param)
WSH.Run Chr(34) & Program & Chr(34) & Chr(32) & Chr(34) & Param & Chr(34) &_
Chr(32) & Chr(34) & TPath & Name & "." & Ext & Chr(34) & Chr(32) & P1 & Chr(32) & P2 ,2,True
Loop
ListFile.Close : Set ListFile = Nothing : WsEnd
Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
Sub WsEnd : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit : End SubСообщение отредактировал Andrey_A 11 марта 2012 - 20:59Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:06 / #81 -
InstalFontInWincmd.vbs
Установить Шрифт для Total Commander
Используется FunctionsINIRWS.vbs и TCMC.exe - файлы можете скачать в шапке темы' InstallFont.vbs
'======================== Описание ====================================
' Копирует и устанавливает выделенные шрифты в системную папку Font
' Установка шрифта вызовом API и регистрация шрифта в реестре
'======================== Параметры ====================================
' {файл список}
' %L
'
' Автор: Аверин Андрей
' Версия: 1.2 (09.10.2010 - 28.12.2010)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru
'=======================================================================
Option Explicit
Dim FSO, WSH, ListFile, Path, Ext, i, TName, TPath
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
i = 0
Do While Not ListFile.AtEndOfStream
Path = ListFile.ReadLine
Ext = FSO.GetExtensionName(Path)
TName = FSO.GetBaseName(Path) & "." & Ext
TPath = WSH.SpecialFolders("Fonts") & "\" & TName
If (FSO.FileExists(Path)) And (FSO.FileExists(TPath) = False) Then
if UCase(Ext) = "TTF" Or UCase(Ext) = "OTF" Or UCase(Ext) = "TTC" Or UCase(Ext) = "FON" Then
FSO.CopyFile Path, TPath
WSH.Run "RunDll32.exe gdi32.dll,AddFontResourceA " & TName
WSH.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts\" &_
FSO.GetBaseName(Path) & " (TrueType)" ,TName,"REG_SZ"
i = i +1
End if
End If
Loop
MsgBox "Скопировано и зарегистрировано в систему " &_
i & " шрифта(ов)", vbInformation ,"Установка шрифтов"
ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : Set WSH = Nothing : WScript.QuitСообщение отредактировал Andrey_A 11 марта 2012 - 21:00Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:29 / #82 -
ListFontBar.au3
Создание Font.bar файла - панели Total Commander'a для быстрой установки шрифта файловых панелей
Используется InstalFontInWincmd.vbs; ListFontBar.au3
; ======================== Описание =====================================
; Создание Font.bar файла - панели Total Commander'a для быстрой установки шрифта файловых панелей
; ==================== Как работает скрипт ================================
; 1. Чтение шрифтов из реестра, очистка от мусора, дубликатов, сортировка
; 2. Создание .bar файлов по первым буквам шрифтов (в папке $FontPath)
; 3. Создание Font.bar файла ($FontBarFile)
; ====================== Как использовать ================================
; 1. запустить скрипт
; 2. перетащить Font.bar на панель Total Commander'a
; 3. сделать кнопку в виде меню (нажать правой кнопкой -> изменить -> галочка в виде меню -> ok)
;
; Автор: Аверин Андрей
; Версия: 1.4 (20.01.2011 - 08.03.2012)
; Mail: Averin-And@yandex.ru
; Site: http://tc-image.3dn.ru
; ========================================================================
Dim $aSSS[1000] = [0]
$aSSS[0] = 1
$Text = ""
$bText = ""
$FontText = ""
$FontSym = ""
$sCount = ""
$n = 0
$FontPath = "%COMMANDER_PATH%\BAR\Font"; папка для создаваемых вспомогательных .bar файлов
$FontBarFile = "%COMMANDER_PATH%\BAR\000_Font.bar"; основной .bar файл
$AutoIt = "%COMMANDER_PATH%\Utilities\Scripting\AutoIt\AutoIt3.exe"; путь к AutoIt3.exe
$Script = "%COMMANDER_PATH%\Scripts\CreateBar\ListFontBar.au3"; путь к этому скрипту
$FontInst = "%COMMANDER_PATH%\Scripts\SysScript\InstalFontInWincmd.vbs"; путь к скрипту, который устанавливает шрифт в Total Commander
$IconIcl = "%COMMANDER_PATH%\Wcmicons.dll"; путь к библиотеке с иконками
$NIcon1 = 322; номер иконки для вспомогательных .bar файлов
$NIcon2 = 1249; номер иконки для основного .bar файла
$NIcon3 = 80 ; номер иконки обновления
$FPath = _TCHExpandEnv($FontPath)
DirCreate($FPath)
FileDelete($FPath & "\*.bar")
FileDelete($FPath & "\*.br2")
; адреса реестра из которых считываются шрифты
$aSSS =_ReadRegg("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\FontMapper",$aSSS[0] , $aSSS)
$aSSS =_ReadRegg("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts",$aSSS[0], $aSSS)
__ArrayQuickSort1D($aSSS, 1, $aSSS[0])
; создание .bar файлов шрифтов в отдельной папке
; шрифты объединяютя в один .bar файл по первой букве
$Text = "[Buttonbar]" & @CRLF & "Buttoncount=>>>>" & @CRLF
For $kk = 1 to $aSSS[0] + 1
$tFont = _FirstLetterUp($aSSS[$kk]) ; название шрифта
$Sym = StringMid($tFont, 1, 1) ; первая буква
if $Sym <> $sCount Then
if $kk <> 1 Then
$BarFile = $FontPath & "\Font_" & $sCount & ".bar"
$Text = StringReplace($Text, ">>>>", $n)
FileWrite(FileOpen(_TCHExpandEnv($BarFile), 2+8+32), $Text)
$FontText = $FontText & $BarFile & ";" ; строка путей создаваемых . bar файлов
$FontSym = $FontSym & $sCount & ";" ; строка из первых букв шрифтов
$n = 0
$Text = "[Buttonbar]" & @CRLF & "Buttoncount=>>>>"
EndIf
EndIf
$sCount = $Sym
$n = $n + 1
$Text = $Text & @CRLF & _
"cmd" & $n & "=" & $FontInst & @CRLF & _
"param"& $n & "=" & Chr(34) & Chr(34) & $tFont & Chr(34) & Chr(34) & @CRLF & _
"menu"& $n & "=Установить шрифт " & Chr(34) & $tFont & Chr(34) & @CRLF & _
"button"& $n & "=" & $IconIcl & "," & $NIcon1
Next
; запись созданных .bar файлов в основной для отображении на панели Total Commander'a
$n = 4
$Fs = StringSplit($FontSym, ";", 1); массив путей создаваемых . bar файлов
$Ft = StringSplit($FontText, ";", 1) ; массив первых букв шрифтов
$bText = "[Buttonbar]" & @CRLF & _
"Buttoncount=" & UBound($Ft) + 1 & @CRLF & _
"cmd1=" & @CRLF & _
"button1=" & @CRLF & _
"cmd2=" & $AutoIt & Chr(32) & Chr(34) & $Script & Chr(34) & @CRLF & _
"button2=" & $IconIcl & "," & $NIcon3 & @CRLF & _
"menu2=Обновить" & @CRLF & _
"cmd3=" & @CRLF & _
"button3="
For $ii = 1 To UBound($Ft) - 2
$bText = $bText & @CRLF & _
"cmd"& $n & "=" & $Ft[$ii] & @CRLF & _
"button"& $n & "=" & $IconIcl & "," & $NIcon2 & @CRLF & _
"menu"& $n & "=Шрифты " & Chr(34) & $Fs[$ii] & Chr(34) & @CRLF & _
"iconic"& $n & "=1"
$n = $n + 1
Next
FileWrite(FileOpen(_TCHExpandEnv($FontBarFile), 2+8+32), $bText)
; функция считывает раздел из реестра и заносит имена в массив с определёнными условиями
; нулевая позиция массива является длинной
Func _ReadRegg($Adres,$n,$aS)
For $i = 1 to 1000
$var = RegEnumVal($Adres, $i); Вернуть название значения(Ключ реестра, начиная с N)
if @error <> 0 Then ExitLoop
if $n = 1 Then
$aS[1] = _DelFromLne($var)
$n = $n + 1
Endif
if StringInStr($var, "&") = 0 Then
$var = _Dudlicat($var,$aS)
if StringLen($var) > 2 Then
$aS[$n] = $var
$n = $n + 1
Endif
Else
$Rez = StringSplit($var, " & ", 1)
For $s = 1 To UBound($Rez) - 1
$var = $Rez[$s]
$var = _Dudlicat($var,$aS)
if StringLen($var) > 2 Then
$aS[$n] = $var
$n = $n + 1
EndIf
Next
Endif
Next
$aS[0] = $n - 1
Return $aS
EndFunc
; функция сортирует массив по первым символам (в алфавитном порядке)
Func _SortSym(ByRef $aStrings, $ff)
For $mm = 0 to $ff - 1
if StringLeft($aStrings[$mm],1) > StringLeft($aStrings[$mm+1],1) Then
$Temp = $aStrings[$mm+1]
$aStrings[$mm+1] = $aStrings[$mm]
$aStrings[$mm] = $Temp
$mm = 0
Endif
Next
Return $aStrings
EndFunc
; функция проверяет, есть ли строка уже в масиве, если да, то делает её пустой ""
Func _Dudlicat($Line, $dubList)
$Line = _DelNum($Line) ; очистка от цифр
$Line = _DelFromLne($Line) ; очистка от мусора
For $pp = 1 To UBound($dubList) - 1
if $dubList[$pp] = $Line Then
$pp = UBound($dubList)
$Line = ""
Endif
Next
Return $Line
EndFunc
; функция удаления ненужных фраз из строки
; фразы прописываются через; в $DelText = "(TrueType);Italic;Bold;,"
Func _DelFromLne($Line)
$DelText = "(TrueType);Italic;Bold;,;(All res);(VGA res);(VGA)"
$Dell = StringSplit($DelText, ";", 1); разрезаем строку, создаём массив
For $ii = 1 To UBound($Dell) - 1
$Line = StringReplace($Line, $Dell[$ii] , "")
Next
$Line = StringStripWS($Line, 3); удалить пробелы в начале и вконце строки
Return $Line
EndFunc
; функция удаления цифр из строки
Func _DelNum($Line)
$DelText = "1;2;3;4;5;6;7;8;9;0"
$Dell = StringSplit($DelText, ";", 1)
For $ii = 1 To UBound($Dell) - 1
$Line = StringReplace($Line, $Dell[$ii] , "")
Next
$Line = StringStripWS($Line, 3)
Return $Line
EndFunc
; функция преобразования строки "Первый Символ С Большой Буквы"
Func _FirstLetterUp($Line)
$sLine = ""
For $ii = 1 To StringLen($Line)
$Sym = StringMid($Line, $ii, 1)
if $ii = 1 Then
$Sym = StringUpper($Sym)
Else
if $Sym = " " Then
$ii = $ii + 1
$Sym = " " & StringUpper(StringMid($Line, $ii, 1))
Else
$Sym = StringLower($Sym)
EndIf
EndIf
$sLine = $sLine & $Sym
Next
Return $sLine
EndFunc
; функция разворачивания переменных окружения
Func _TCHExpandEnv($sText)
$aResult = StringRegExp($sText, "%(\w+)%", 3)
If IsArray($aResult) Then
For $i = 0 To UBound($aResult)-1
$sText = StringReplace($sText, "%" & $aResult[$i] & "%", EnvGet($aResult[$i]))
Next
EndIf
Return $sText
EndFunc
; быстрая сортирока массива по в алфавитном порядке
Func __ArrayQuickSort1D(ByRef $avArray, ByRef $iStart, ByRef $iEnd)
If $iEnd <= $iStart Then Return
Local $vTmp
; InsertionSort (faster for smaller segments)
If ($iEnd - $iStart) < 15 Then
Local $vCur
For $i = $iStart + 1 To $iEnd
$vTmp = $avArray[$i]
If IsNumber($vTmp) Then
For $j = $i - 1 To $iStart Step -1
$vCur = $avArray[$j]
; If $vTmp >= $vCur Then ExitLoop
If ($vTmp >= $vCur And IsNumber($vCur)) Or (Not IsNumber($vCur) And StringCompare($vTmp, $vCur) >= 0) Then ExitLoop
$avArray[$j + 1] = $vCur
Next
Else
For $j = $i - 1 To $iStart Step -1
If (StringCompare($vTmp, $avArray[$j]) >= 0) Then ExitLoop
$avArray[$j + 1] = $avArray[$j]
Next
EndIf
$avArray[$j + 1] = $vTmp
Next
Return
EndIf
; QuickSort
Local $L = $iStart, $R = $iEnd, $vPivot = $avArray[Int(($iStart + $iEnd) / 2)], $fNum = IsNumber($vPivot)
Do
If $fNum Then
; While $avArray[$L] < $vPivot
While ($avArray[$L] < $vPivot And IsNumber($avArray[$L])) Or (Not IsNumber($avArray[$L]) And StringCompare($avArray[$L], $vPivot) < 0)
$L += 1
WEnd
; While $avArray[$R] > $vPivot
While ($avArray[$R] > $vPivot And IsNumber($avArray[$R])) Or (Not IsNumber($avArray[$R]) And StringCompare($avArray[$R], $vPivot) > 0)
$R -= 1
WEnd
Else
While (StringCompare($avArray[$L], $vPivot) < 0)
$L += 1
WEnd
While (StringCompare($avArray[$R], $vPivot) > 0)
$R -= 1
WEnd
EndIf
; Swap
If $L <= $R Then
$vTmp = $avArray[$L]
$avArray[$L] = $avArray[$R]
$avArray[$R] = $vTmp
$L += 1
$R -= 1
EndIf
Until $L > $R
__ArrayQuickSort1D($avArray, $iStart, $R)
__ArrayQuickSort1D($avArray, $L, $iEnd)
EndFunc ;==>__ArrayQuickSort1DСообщение отредактировал Andrey_A 11 марта 2012 - 21:00Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:32 / #83 -
InstallFont.vbs
Копирует и устанавливает выделенные шрифты в системную папку Font' InstallFont.vbs
'======================== Описание ====================================
' Копирует и устанавливает выделенные шрифты в системную папку Font
' Установка шрифта вызовом API и регистрация шрифта в реестре
'======================== Параметры ====================================
' {файл список}
' %L
'
' Автор: Аверин Андрей
' Версия: 1.2 (09.10.2010 - 28.12.2010)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru
'=======================================================================
Option Explicit
Dim FSO, WSH, ListFile, Path, Ext, i, TName, TPath
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
i = 0
Do While Not ListFile.AtEndOfStream
Path = ListFile.ReadLine
Ext = FSO.GetExtensionName(Path)
TName = FSO.GetBaseName(Path) & "." & Ext
TPath = WSH.SpecialFolders("Fonts") & "\" & TName
If (FSO.FileExists(Path)) And (FSO.FileExists(TPath) = False) Then
if UCase(Ext) = "TTF" Or UCase(Ext) = "OTF" Or UCase(Ext) = "TTC" Or UCase(Ext) = "FON" Then
FSO.CopyFile Path, TPath
WSH.Run "RunDll32.exe gdi32.dll,AddFontResourceA " & TName
WSH.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts\" &_
FSO.GetBaseName(Path) & " (TrueType)" ,TName,"REG_SZ"
i = i +1
End if
End If
Loop
MsgBox "Скопировано и зарегистрировано в систему " &_
i & " шрифта(ов)", vbInformation ,"Установка шрифтов"
ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : Set WSH = Nothing : WScript.QuitСообщение отредактировал Andrey_A 11 марта 2012 - 21:01Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:34 / #84 -
RunStopRestart.vbs
Запуск\Остановка\Перезапуск программы' RunStopRestart.vbs
'======================== Описание =====================================
' Запуск\Остановка\Перезапуск программы
'======================== Параметры =====================================
' 1-й параметр: полный\путь\к\программе.exe
' 2-й параметр:
' 0 - Перезапуск программы, если она запущена
' 1 - Завершает процесс программы
' 2 - Запускает второй экземпляр, третий, четвёртый....
' 3 - Запускает или завершает
' 4 - Запускает, если процесс не запущен и не запускает, если запущен
'======================== Примеры =====================================
' "%%WINDIR%%\SYSTEM32\notepad.exe" 3 - вкл\выкл блокнота
' "%%COMMANDER_PATH%%\TOTALCMD.EXE" - перезапуск ТС, если он запущен
'
' Автор: Аверин Андрей
' Версия: 1.1 (09.11.2011 - 14.01.2012)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru
'=======================================================================
Count = 0 : Title = "Запуск\Остановка\Перезапуск программы"
With WScript
Cnt = .Arguments.Count
If Cnt > 0 Then
Program = .Arguments(0)
If Cnt > 1 Then Count = .Arguments(1)
Else
MsgBox "Не хватает параметров!" & vbNewLine &_
"Должен быть минимум ОДИН параметра" & vbNewLine &_
"Полный путь к программе", vbOKOnly & vbInformation, Title
.Quit
End If
End With
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists(CreateObject("WScript.Shell").ExpandEnvironmentStrings(Program))Then
MsgBox "Указанная программа не обнаружена", vbOKOnly & vbInformation, Title
WScript.Quit
End If
Name = .GetFileName(Program)
End With
If Count <> 2 Then
For Each Proc In GetObject("winmgmts:").ExecQuery("SELECT * FROM Win32_Process")
If LCase(Proc.Name) = LCase(Name) Then
If Count <> 4 Then Proc.Terminate
cEnd = 1 : Exit For
End If
Next
End If
Select Case Count
Case 0 If cEnd = 1 Then ProgramRun
Case 2 ProgramRun
Case 3 If cEnd = 0 Then ProgramRun
Case 4 If cEnd = 0 Then ProgramRun
End Select
Sub ProgramRun : CreateObject("WScript.Shell").Exec(Program) : WScript.Quit : End SubСообщение отредактировал Andrey_A 11 марта 2012 - 21:01Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:35 / #85 -
Usb.vbs
Вызывает окно безопасного отключения USB-дисков (требуется deveject.exe)
Скачать deveject.exe' Usb.vbs
'========================================================================
' Вызывает окно безопасного отключения USB-дисков (требуется deveject.exe)
' Автор: SkOle & Аверин Андрей
' Версия: 1.1 (08.11.2011)
' Site: http://tc-image.3dn.ru
'==================== Изменяемые пути ==================================
Exe = "%COMMANDER_PATH%\Utilities\USB\deveject\deveject.exe"
'========================================================================
With CreateObject("WScript.Shell")
Exe = .ExpandEnvironmentStrings(Exe)
If Not CreateObject("Scripting.FileSystemObject").FileExists(Exe) Then
MsgBox "Не правильно указан путь до deveject.exe" & vbNewLine &_
"Дом.страница http://www.withopf.com/tools/deveject/", vbOKOnly & vbInformation,_
"Безопасное отключение USB-дисков"
WScript.Quit
End If
For Each objDisk In GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2").ExecQuery("SELECT * FROM Win32_DiskDrive")
If objDisk.InterfaceType = "USB" Then
If MsgBox("Отключить " & objDisk.Caption & " ?", vbYesNo + vbQuestion, "Безопасное извлечение устройств") = vbYes Then .Run Chr(34) & Exe & Chr(34) & " -EjectId:" & objDisk.PNPDeviceID
End If
Next
End With
WScript.QuitСообщение отредактировал Andrey_A 11 марта 2012 - 21:02Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:38 / #86 -
CopyXlsInText.au3
Копирование из файлов XLS, XLSX строк, столбцов в текстовый файл; CopyXlsInText.au3
; ================ Описание ===================================
; Копирование из файлов XLS, XLSX строк, столбцов в текстовый файл
; ================ Параметры ===================================
; В командной строке должно быть прописано 7 - 11 параметров:
; - - - - - - - - - - - - - - - - - Обязательные - - - - - - - - - - - - - - - - - - - -
; 1) Номер листа с какого считывать информацию
; 2) С какой строки начать считывание
; 3) С какого столбца начать считывание
; 4) К-во считываемых рядов (строк) (0 - все)
; 5) К-во считываемых колонок (столбцов)
; 6) Путь\к\файлу.xls
; 7) Путь\к\сохранению\файла.txt
; (можно вводить пути с переменными окружения)
; - - - - - - - - - - - - - - - Дополнительные - - - - - - - - - - - - - - - - - - - -
; 8) 1 = Удалять пустые строки 0 = оставить как есть
; 9) строка-вставка между колонками
; 10) строка-вставка в начале строки
; 11) строка-вставка в конце строки
; ================ Примеры ===================================
; 1 2 0 4 "%%COMMANDER_PATH%%\Files\Lists\CreateMenu\WcmMenuImage.xlsx" "%%COMMANDER_PATH%%\Text.ini"
; 1 2 0 4 "%%COMMANDER_PATH%%\Files\Lists\CreateMenu\WcmMenuImage.xlsx" "%%COMMANDER_PATH%%\Text.ini" 1 "___" "| " " |"
; 1 1 1 0 0 %P%N "%T%O.txt" 1 " " Копирование первого листа из xls под курсором в текстовый файл в соседнюю панель
;
; Автор: Аверин Андрей
; Версия: 1.0 (12.10.2010)
; Mail: Averin-And@yandex.ru
; Site: http://tc-image.3dn.ru
; ===============================================================
#include <Excel.au3>
If $CmdLine[0] < 7 Then
MsgBox(16 + 262144, "Запись из табличного файла строк и столбцов в файл", _
"Не хватает параметров!" & @CRLF & "Должно быть минимум СЕМЬ, а у вас" & _
$CmdLine[0] & @CRLF & "Пропишите и повторите попытку!" & @CRLF & _
"Подробную информацию читайте в коментариях скрипта", 10)
Exit
Endif
$List = Number($CmdLine[1])
$StartRow = Number($CmdLine[2])
$StartCol = Number($CmdLine[3])
$RowCnt = Number($CmdLine[4])
$ColCnt = Number($CmdLine[5])
$XlsFile = _TCHExpandEnv($CmdLine[6])
$TxtFile = _TCHExpandEnv($CmdLine[7])
$Text = ""
$Insert = ""
$Control = ""
$Contr = 0
$InsertRight = ""
$InsertLeft = ""
if $CmdLine[0] > 7 Then $Contr = $CmdLine[8]
if $CmdLine[0] > 8 Then $Insert = $CmdLine[9]
if $CmdLine[0] > 9 Then $InsertRight = $CmdLine[10]
if $CmdLine[0] > 10 Then $InsertLeft = $CmdLine[11]
; Открываем xls , считываем нужные строки, колонки и закрываем
$oInFile = _ExcelBookOpen($XlsFile, 0, True)
; номер листа
$oInFile.Sheets($List).Select()
$aData = _ExcelReadSheetToArray($oInFile, $StartRow, $StartCol, $RowCnt , $ColCnt)
_ExcelBookClose($oInFile, 0)
if $RowCnt = 0 Then $RowCnt = UBound($aData,1) - 1;размерность массива (к-во строк)
if $ColCnt = 0 Then $ColCnt = UBound($aData,2) - 1;размерность массива (к-во колонок)
; Открываем выходной файл для записи - с очисткой
$hFile = FileOpen($TxtFile, 2)
; Записываем данные
For $i=1 To $RowCnt
For $j=1 To $ColCnt
if $aData[$i][$j] = "" Then $aData[$i][$j] = ""
$Text = $Text & StringFormat("%s", $aData[$i][$j]) & $Insert
$Control = $Control & $Insert
Next
; проверка на пустые строки
if $Contr = 1 And StringCompare($Control, $Text,2) = 0 Then
Else
FileWriteLine($hFile, $InsertLeft & $Text & $InsertRight)
Endif
$Text = ""
$Control = ""
Next
; функция разворачивания переменных окружения
Func _TCHExpandEnv($sText)
$aResult = StringRegExp($sText, "%(\w+)%", 3)
If IsArray($aResult) Then
For $i = 0 To UBound($aResult)-1
$sText = StringReplace($sText, "%" & $aResult[$i] & "%", EnvGet($aResult[$i]))
Next
EndIf
Return $sText
EndFuncСообщение отредактировал Andrey_A 11 марта 2012 - 21:02Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:48 / #87 -
CountPhraseInText.vbs
Подсчёт к-ва раз встречающейся фразы в файле и вывод отчёта' CountPhraseInText.vbs
'======================== Описание =====================================
' Подсчёт количества раз встречающейся фразы в файле и вывод отчёта
'======================= Параметры =====================================
' 1-й параметр: Файл, в котором небходимо подсчитать фразу
' 2-й параметр: Фраза (если параметр отсутствует, она вводится в диалоге)
'======================== Примеры =====================================
' %P%N - подсчёт фразы в файле под курсором, фраза вводится в диалоге
' %P%N "привет" - подсчёт фразы "привет" в файле под курсором
' "%%COMMANDER_PATH%%\Language\Wcmd_Rus.mnu" " em_"
' Автор: Аверин Андрей
' Версия: 1.2 (2010 - 06.11.2011)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru
'=====================================================================
With WScript
Cnt = .Arguments.Count
If Cnt = 0 Then
MsgBox "Не хватает параметров!" & vbNewLine &_
"Нужен минимум один параметр %P%N",_
vbOKOnly & vbInformation, "Подсчёт фраз в тексте" : .Quit
End If
InFile = CreateObject("WScript.Shell").ExpandEnvironmentStrings(.Arguments(0))
If Cnt > 1 Then
fStr = .Arguments(1)
Else
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
fStr = InputBox("Введите тест для поиска", "Подсчёт к-ва текста", Clip)
End If
End With
With CreateObject("Scripting.FileSystemObject")
If Not .FileExists(InFile) Then WScript.Quit
On Error Resume Next
Set ts = .OpenTextFile(InFile, 1)
End With
Do Until ts.AtEndOfStream
Stroka = ts.ReadLine
For i = 1 To (Len(Stroka) - Len(fStr)+1)
If Mid(Stroka, i, Len(fStr)) = fStr Then s = s + 1
Next
Loop
MsgBox "Фраза" & Chr (34) & fStr & Chr (34) & vbNewLine &_
"повторяется в тексте " & Cstr(s) & " раз(а)",, "Результат:"
ts.Close : Set ts = Nothing : WScript.QuitСообщение отредактировал Andrey_A 11 марта 2012 - 21:03Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:49 / #88 -
InsertText.au3
Добавление текста до/после/над/после строк в выделенных текстовых файлах; InsertText.au3
; ====================== Описание =====================================
; Добавление текста до/после/над/после строк в выделенных текстовых файлах
;; Параметры: %L
; Автор: Loopback
; Версия: 1.0 (14.10.2010)
; ======================================================================
If $CmdLine[0] < 1 Then
MsgBox (0, "", "Недостаточно параметров, должно быть 1.")
Exit
EndIf
Global $aList = _TCHLoadFileList($CmdLine[1])
Global $gBackups = False, $gCaseSence = 0
Global Const $GUI_CHECKED = 1
Global $gRemoveEmpty = False
Global $gIniFile = StringLeft(@ScriptFullPath, StringInStr(@ScriptFullPath, ".", 0, -1)) & "ini"
$hGUI = GUICreate("Вставка текста", 549, 570, -1, -1)
$edTextLeft = GUICtrlCreateEdit("", 8, 96, 529, 73)
$btnOK = GUICtrlCreateButton("OK", 384, 528, 75, 25)
$btnCancel = GUICtrlCreateButton("Отмена", 464, 528, 75, 25)
GUICtrlCreateLabel("начинающейся на", 198, 70, 94, 17, 0x2)
$cbCaseSence = GUICtrlCreateCheckbox("Учитывать регистр", 8, 520, 137, 17)
$edMask = GUICtrlCreateInput("*.*", 8, 24, 265, 21)
GUICtrlCreateLabel("Маска файлов", 8, 6, 78, 17)
$edTextRight = GUICtrlCreateEdit("", 8, 208, 529, 73)
$edTextBefore = GUICtrlCreateEdit("", 8, 320, 529, 73)
$edTextAfter = GUICtrlCreateEdit("", 8, 432, 529, 73)
GUICtrlCreateLabel("заканчивающейся на", 176, 182, 113, 17, 0x2)
GUICtrlCreateLabel("начинающейся на", 196, 294, 95, 17, 0x2)
GUICtrlCreateLabel("заканчивающейся на", 176, 406, 113, 17, 0x2)
$ibFilterLeft = GUICtrlCreateInput("", 296, 66, 241, 21)
$ibFilterRight = GUICtrlCreateInput("", 296, 178, 241, 21)
$ibFilterBefore = GUICtrlCreateInput("", 296, 290, 241, 21)
$ibFilterAfter = GUICtrlCreateInput("", 296, 402, 241, 21)
GUICtrlCreateLabel("", 8, 56, 528, 2, 0x10)
GUIStartGroup()
$Radio1 = GUICtrlCreateRadio("Добавить к строке слева", 8, 69, 153, 17)
GUICtrlSetState(-1, $GUI_CHECKED)
GUICtrlSetTip(-1, "Приоритет над п.3")
$Radio3 = GUICtrlCreateRadio("Добавить сверху строки", 8, 293, 153, 17)
GUICtrlSetTip(-1, "Приоритет над п.1")
GUIStartGroup()
$Radio2 = GUICtrlCreateRadio("Добавить к строке справа", 8, 181, 161, 17)
GUICtrlSetState(-1, $GUI_CHECKED)
GUICtrlSetTip(-1, "Приоритет над п.4")
$Radio4 = GUICtrlCreateRadio("Добавить снизу строки", 8, 405, 153, 17)
GUICtrlSetTip(-1, "Приоритет над п.2")
$cbBackups = GUICtrlCreateCheckbox("Создавать резервные копии", 160, 520, 193, 17)
$cbRemoveEmpty = GUICtrlCreateCheckbox("Удалять пустые строки", 8, 544, 150, 17)
$cbCloseDone = GUICtrlCreateCheckbox("Закрывать по завершению", 160, 544, 160, 17)
Global $AccelTable[1][2] = [["^{ENTER}", $btnOK]]
GUISetAccelerators($AccelTable)
GUISetState(@SW_SHOW)
GUICtrlSetState($cbCaseSence, IniRead($gIniFile, "Settings", "CaseSenseSearch", 4))
GUICtrlSetState($cbBackups, IniRead($gIniFile, "Settings", "MakeBackups", 4))
GUICtrlSetState($cbRemoveEmpty, IniRead($gIniFile, "Settings", "RemoveEmptyLines", 4))
GUICtrlSetState($cbCloseDone, IniRead($gIniFile, "Settings", "CloseWhenDone", 1))
While 1
$nMsg = GUIGetMsg()
Switch $nMsg
Case -3, $btnCancel
Exit
Case $btnOK
$gMask = _MaskToRegexp(GUICtrlRead($edMask))
$gBackups = BitAND(GUICtrlRead($cbBackups), $GUI_CHECKED)
$gRemoveEmpty = BitAND(GUICtrlRead($cbRemoveEmpty), $GUI_CHECKED)
If BitAND(GUICtrlRead($cbCaseSence), $GUI_CHECKED) Then $gCaseSence = 1
WinSetState($hGUI, "", @SW_DISABLE)
IniWrite($gIniFile, "Settings", "CaseSenseSearch", GUICtrlRead($cbCaseSence))
IniWrite($gIniFile, "Settings", "MakeBackups", GUICtrlRead($cbBackups))
IniWrite($gIniFile, "Settings", "RemoveEmptyLines", GUICtrlRead($cbRemoveEmpty))
IniWrite($gIniFile, "Settings", "CloseWhenDone", GUICtrlRead($cbCloseDone))
For $i = 1 To $aList[0]
If StringRight($aList[$i], 1) = "\" Then
_DoFolder($aList[$i])
Else
_DoFile($aList[$i])
EndIf
Next
MsgBox (0, "", "Завершено.", 0, $hGUI)
If BitAND(GUICtrlRead($cbCloseDone), $GUI_CHECKED) Then Exit
WinSetState($hGUI, "", @SW_ENABLE)
EndSwitch
WEnd
Func _DoFolder($sFolder)
If $sFolder = "" Then Return
Local $sDirs = ""
Local $hSearch = FileFindFirstFile($sFolder & "*.*")
If @error Then Return
While 1
$sFile = FileFindNextFile($hSearch)
If @error Then ExitLoop
If @extended Then
$sDirs &= $sFolder & $sFile & "\" & @LF
ContinueLoop
EndIf
_DoFile($sFolder & $sFile)
Wend
FileClose($hSearch)
; Обработку каталогов приходится делать отдельно,
; чтобы не оставлять открытый поисковый хэндл,
; их максимально может быть 64
$aDirs = StringSplit($sDirs, @LF)
For $i = 1 To $aDirs[0]
_DoFolder($aDirs[$i])
Next
EndFunc
Func _ProcessLines(ByRef $aSrcFile, ByRef $aTrgFile, $sText, $sFilter, $nMode)
If $sText = "" Then Return
For $i = 1 To $aSrcFile[0]
Switch $nMode
Case 0, 2
If ($sFilter <> "") Then
$sLeft = StringLeft($aSrcFile[$i], StringLen($sFilter))
If $gCaseSence Then
If Not ($sLeft == $sFilter) Then ContinueLoop
Else
If $sLeft <> $sFilter Then ContinueLoop
EndIf
EndIf
If $nMode = 2 Then $aTrgFile[$i] = @CRLF & $aTrgFile[$i]
$aTrgFile[$i] = $sText & $aTrgFile[$i]
Case 1, 3
If ($sFilter <> "") Then
$sRight = StringRight($aSrcFile[$i], StringLen($sFilter))
If $gCaseSence Then
If Not ($sRight == $sFilter) Then ContinueLoop
Else
If $sRight <> $sFilter Then ContinueLoop
EndIf
EndIf
If $nMode = 3 Then $aTrgFile[$i] = $aTrgFile[$i] & @CRLF
$aTrgFile[$i] = $aTrgFile[$i] & $sText
EndSwitch
Next
EndFunc
Func _DoFile($sFile)
If StringRegExp(StringLower($sFile), $gMask) = 0 Then Return
Local $aSrcFile = _TCHLoadFileList($sFile)
If $gRemoveEmpty And ($aSrcFile[0] > 0) Then
Local $aTrgFile[$aSrcFile[0]+1] = [0]
For $i = 1 To $aSrcFile[0]
If $aSrcFile[$i] <> "" Then
$aTrgFile[0] += 1
$aTrgFile[$aTrgFile[0]] = $aSrcFile[$i]
EndIf
Next
ReDim $aTrgFile[$aTrgFile[0] + 1]
$aSrcFile = $aTrgFile
Else
Local $aTrgFile = $aSrcFile
EndIf
If BitAND(GUICtrlRead($Radio1), $GUI_CHECKED) Then
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextLeft), GUICtrlRead($ibFilterLeft), 0)
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextbefore), GUICtrlRead($ibFilterBefore), 2)
Else
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextbefore), GUICtrlRead($ibFilterBefore), 2)
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextLeft), GUICtrlRead($ibFilterLeft), 0)
EndIf
If BitAND(GUICtrlRead($Radio3), $GUI_CHECKED) Then
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextRight), GUICtrlRead($ibFilterRight), 1)
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextAfter), GUICtrlRead($ibFilterAfter), 3)
Else
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextAfter), GUICtrlRead($ibFilterAfter), 3)
_ProcessLines($aSrcFile, $aTrgFile, GUICtrlRead($edTextRight), GUICtrlRead($ibFilterRight), 1)
EndIf
If $gBackups Then FileCopy($sFile, $sFile & ".bak", 1); бэкап
Local $hFile = FileOpen($sFile, 2)
For $i = 1 To $aTrgFile[0]
FileWriteLine($hFile, $aTrgFile[$i])
Next
FileClose($hFile)
EndFunc
Func _MaskToRegexp($sMask)
$sMask = StringRegExpReplace($sMask, "(\\|\.|\+|\^|\(|\)|\[|\]|\{|\}|\$)", "\\\1")
$sMask = StringReplace($sMask, "?", ".")
$sMask = StringReplace($sMask, "*", ".+?")
Return StringLower("(?i)" & $sMask & "$")
EndFunc
; fast list load function
Func _TCHLoadFileList($sFileName, $nIncBlock = 1000)
Local $asList[$nIncBlock + 1] = [0]
Local $hfList = FileOpen($sFileName, 0)
Local $nCounter = 0
While 1
For $i = 1 To $nIncBlock
$asList[$nCounter + $i] = FileReadLine($hfList)
If @error Then
ReDim $asList[UBound($asList) + $i - $nIncBlock - 1]
ExitLoop(2)
EndIf
Next
$nCounter += $nIncBlock
ReDim $asList[UBound($asList)+$nIncBlock]
Wend
FileClose($hfList)
$asList[0] = UBound($asList)-1
Return $asList
EndFuncСообщение отредактировал Andrey_A 11 марта 2012 - 21:03Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:52 / #89 -
ReplaceInFiles.vbs
Поиск и замена текста в выделенных текстовых файлах' ReplaceInFiles.vbs
'================ Описание ======================
' Поиск и замена текста в выделенных текстовых файлах
'=============== Параметры ======================
' 1-й параметр: список тестовых файлов (обязательный)
' 2-й параметр: что найти
' 3-й параметр: чем заменить
' 2 и 3 параметры можно ввести в диалоговых окнах
'================ Примеры =======================
' %L "найти" "заменить"
' %L "найти"
' %L
' Автор: Аверин Андрей
' Версия: 1.1 (2009 - 28.04.2011)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru
'==================================================
Titles = "Поиск и замена"
With WScript
Cnt = .Arguments.Count
If Cnt > 0 Then
tFile = .Arguments(0)
If Cnt > 1 Then
Find = .Arguments(1)
If Cnt > 2 Then Replac = .Arguments(2)
End If
Else
MsgBox "Не хватает параметров!!!", vbOKOnly & vbInformation, Titles
WScript.Quit
End If
End With
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If Len(Find) = 0 Then Find = InputBox("Введите искомую строку", Titles, Clip)
If Len(Find) = 0 Then WScript.Quit
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
Replac = InputBox("Введите строку для замены", Titles, Clip)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ListFile = FSO.OpenTextFile(tFile, 1)
Do While Not ListFile.AtEndOfStream
Call ReplThisFile(ListFile.ReadLine)
Loop
'MsgBox "Замена завершена!", vbInformation , Titles
ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : WScript.Quit
Sub ReplThisFile(FilePath)
On Error Resume Next
Text = FSO.OpenTextFile(FilePath, 1, False, -2).ReadAll
Text = Replace(CStr(Text), Find, Replac, 1, -1, 1)
FSO.CopyFile FilePath, FilePath & ".bak"
FSO.OpenTextFile(FilePath, 2, False, -2).Write Text
End SubСообщение отредактировал Andrey_A 11 марта 2012 - 21:04Читайте: Справочные материалы по работе c TC + Онлайн справка TC
23 ноября 2011 - 20:57 / #90
Статистика форума, пользователей онлайн: 0 (за последние 30 минут)
---
- Создано тем
- 107
- Всего сообщений
- 4048
- Пользователей
- 99000
- Новый участник
- termojader
Powered by Bullet Energy Forum