Victor_Dobrov
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код: '==========================================================================
' SelRestHtmBeforeCm.vbs © Victor Dobrov
' Добавление к выбранным html-файлам в активной панели связанных папок (и наоборот) и выполнение команды TC.
' Внимание! Скрипт не сохраняет данные, которые были в буфере обмена перед запуском!
' Параметры: командаTC (например cm_Copy или 905)
'==========================================================================
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TCS = CreateObject("TCScript.Helper") 'необходим ActiveX-компонент TCWSHelp.exe
If not IsObject(TCS) Then MsgBox "Необходимо установить Script Helper ActiveX for Total Commander ",,"Ошибка!" : WScript.Quit 'ошибка регистрации TCWSHelp.exe
if WScript.Arguments.Count > 0 then cmd = WScript.Arguments.UnNamed(0) else cmd = 905 'Copy files
TCS.Wait = True : TCS.LockTC True
Mark = TCS.GetSrcSelectedFiles(True)
TCS.SendCommand 523 'SelectAll
if Join(Mark) = Join(TCS.GetSrcSelectedFiles(True)) then TCS.SendCommand cmd : WScript.Quit 'выбрано всё
TCS.SetTextToClip(Join(Mark, vbNewLine))
if UBound(Mark) = 0 then TCS.SendCommand 524 else TCS.SendCommand 2033, True 'cm_LoadSelectionFromClip
TCS.SendCommand 525 'Invert Selection
Rest = TCS.GetSrcSelectedFiles(True) 'массив невыбранных объектов
TCS.SendCommand 525 'Invert Selection
For i = 0 to UBound(Mark)
M = FSO.GetAbsolutePathName(Mark(i)) : B = "" : C = ""
if LCase(Right(M, 6)) = "_files" then M = Left(M, len(M)-6) & ".files" 'Opera saves
A = LCase(FSO.GetExtensionName(M))
if A = "files" Then
B = FSO.GetParentFolderName(M) & "\" & FSO.GetBaseName(M) & ".htm"
C = FSO.GetParentFolderName(M) & "\" & FSO.GetBaseName(M) & ".html"
elseIf A = "htm" or A = "html" Then
B = FSO.GetParentFolderName(M) & "\" & FSO.GetBaseName(M) & ".files\"
C = FSO.GetParentFolderName(M) & "\" & FSO.GetBaseName(M) & "_files\"
end if
if B > "" then
D = Join(Filter(Rest, B, true, 1), vbNewLine) : E = Join(Filter(Rest, C, true, 1), vbNewLine)
if D > "" and InStr(L, D) = 0 then L = L & vbNewLine & D
if E > "" and InStr(L, E) = 0 then L = L & vbNewLine & E
end if
Next
TCS.SetTextToClip(Join(Mark, vbNewLine) & L)
if UBound(Mark) > 0 or Len(L) > 0 then TCS.SendCommand 2033, True 'cm_LoadSelectionFromClip
TCS.LockTC False
TCS.SendCommand cmd 'cm_Copy, cm_RenMov, cm_Delete, cm_PackFiles и т.п.
' if L > "" then ShowHint "Добавлено связанных html-объектов: " & UBound(Split(L, vbNewLine)) & VbCr & L, 3
WScript.Quit
Sub ShowHint(Message, Wait) 'отображать хинт указанное время
IF not IsObject(Hint) then Set Hint = CreateObject("Internet.HHCtrl")
While (Right(Message, 1) = VbCr or Right(Message, 1) = vbLf) and Len(Message) > 0
Message = Left(Message, Len(Message)-1)
Wend
Hint.TextPopup Message, "Arial,10",12,16,1,1 : WScript.Sleep Wait*1000
End Sub
|
? Код создан и опубликован с помощью SciTE-Ru |
