Total Commander

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

' Создать файл с текстом буфера обмена (при наличии) и открыть его в редакторе
' Параметры: "%P" "<путь к редактору>"
'===================================================================================
P = WScript.Arguments(0) : Ed = WScript.Arguments(1)
Set FSO  = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH  = CreateObject("WScript.Shell")
R = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
A = WSH.RegRead(R)
If A > 0 Then WSH.RegWrite R, 0, "REG_DWORD"
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If A > 0 Then WSH.RegWrite R, A, "REG_DWORD"
If Trim(Clip) = "" Then Quit
File = FSO.GetBaseName(FSO.GetTempName) & ".txt"
FSO.OpenTextFile(P & File, 2, True).Write Clip : WSH.Exec(Ed & " " & File) : Quit
Function Quit : Set WSH = Nothing : Set FSO = Nothing : WScript.Quit : End Function

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

' Перезапуск x32 <> x64. Закрыть 32-битный и запустить TC x64 (и наоборот). Для x86 только рестарт TC
' сохраните код в файл (напр. 1.vbs), скопируйте в папку (напр. %commander_path%\scripts) и запустите
' скрипт переименуется в SwitchTC32or64.vbs (можно изменить), в UserCmd.ini добавится эта команда,
' в меню добавляется последний пункт (32/64), который перезапускает TC с другой разрядностью

em_cmd = "SwitchTC32or64"	'имя скрипта и em_команды, можно изменить
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
commander_PATH = ExpStr("%COMMANDER_PATH%",0) : commander_INI = ExpStr("%COMMANDER_INI%",0)

Set TCS = CreateObject("TCScript.Helper")
	If not IsObject(TCS) Then MsgBox "Script Helper ActiveX for Total Commander" & vbTab & VbCr & VbCr & "для регистрации в системе выполните:" & VbCr & "TCWSHelp.exe /REGSERVER",vbSystemModal + vbInformation,"Отсутствует компонент ActiveX" : WScript.Quit
If not TCS.IsRunningTC Then WScript.Quit	'скрипт запущен не из ТС
	Set File = FSO.GetFile(WScript.ScriptFullName)
	if FSO.GetBaseName(File) <> em_cmd then File.Name = em_cmd & ".vbs"
UserCmd = ExpStr(commander_INI,1) & "UserCmd.ini"
	if FSO.FileExists(UserCmd) then txt = CleanLF(FSO.OpenTextFile(UserCmd,1).ReadAll) & vbNewLine else txt = ""
	If InStr(txt, "em_" & em_cmd) = 0 Then FSO.OpenTextFile(UserCmd, 2,1).Write txt & "[em_" & em_cmd & "]" & vbNewLine & "cmd=" & ExpStr(WScript.ScriptFullName,1) & em_cmd & ".vbs"

Menu = commander_PATH & "\Language\" & TCS.INIRead(commander_INI,"Configuration","Mainmenu","wcmd_eng.mnu")
x64 = (ExpStr("%PROCESSOR_ARCHITEW6432%",0) = "AMD64" or ExpStr("%PROCESSOR_ARCHITECTURE%",0) = "AMD64")
str32 = "MENUITEM ""32"", em_" & em_cmd : str64 = "MENUITEM ""64"", em_" & em_cmd : exe = commander_PATH & "\totalcmd.exe"
if LCase(ExpStr(ExpStr("%COMMANDER_EXE%",0),2)) = "totalcmd64.exe" Then Mode = 64 Else Mode = 32
If Mode = 32 then if x64 then exe = commander_PATH & "\totalcmd64.exe" else str64 = str32

txt = CleanLF(FSO.OpenTextFile(Menu, 1).ReadAll) : res = txt
If InStr(txt, "em_" & em_cmd) > 0 Then
	if Mode = 32 Then
		If not InStr(txt, str64) > 0 Then res = Replace(txt, str32, str64,1,-1,1)
	else
		If not InStr(txt, str32) > 0 Then res = Replace(txt, str64, str32,1,-1,1)
	end If
Else
	If Mode = 32 Then res = txt & vbNewLine & str64 Else res = txt & vbNewLine & str32
End If
if res <> txt Then FSO.OpenTextFile(Menu, 2).Write res

Do While TCS.IsRunningTC
	TCS.SendCommand "cm_Exit": WScript.Sleep 100 : n = n + 1
	If n > 200 Then Exit Do
Loop

WshShell.Run (exe & " /i=" & commander_INI)
WScript.Quit

Function ExpStr(str, n)	'Раскрыть системные переменные, выделить имя файла или папки
	if n = 1 then ExpStr = FSO.GetParentFolderName(str) & "\" else if n = 2 then ExpStr = FSO.GetFileName(str) else if n = 3 then ExpStr = FSO.GetBaseName(str) else ExpStr = WshShell.ExpandEnvironmentStrings(str)
End Function

Function CleanLF(AllText)	'Удаление лишних пустых строк в конце текста
	Do While (Right(AllText, Len(vbNewLine)) = vbNewLine)
		AllText = Left(AllText, Len(AllText) - Len(vbNewLine))
	Loop
	CleanLF = AllText
End Function

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

' ===================================================================
'  Автор:		SkOle, Оренбург
'  Описание:	Предоставляет текущему каталогу общий доступ
'  Параметры:	%P%N
' ===================================================================

Dim WSH, FSO
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "
ootcimv2")
Set objNewShare = objWMIService.Get("Win32_Share")

DESCRIPTION = InputBox("Укажите описание для создаваемого ресурса", "Создание общего ресурса")

errReturn = objNewShare.Create(WSH.CurrentDirectory, FSO.GetFolder(WSH.CurrentDirectory).Name, 0, TRUE, DESCRIPTION)

If errReturn = 0 Then
	MsgBox "Общий ресурс для каталога " & WSH.CurrentDirectory & " успешно создан", vbInformation, "Уведомление"
End If

Set FSO = Nothing
Set WSH = Nothing

Wscript.Quit

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

' ===================================================================
'  Автор:		SkOle, Оренбург
'  Описание:	Убирает у текущего каталога общий доступ,
                                если таковой имеется
'  Параметры:	%P%N
' ===================================================================

Dim WSH, FSO
Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "
ootcimv2")
Set colShares = objWMIService.ExecQuery ("Select * from Win32_Share Where Name = '" & FSO.GetFolder(WSH.CurrentDirectory).Name & "'")

For Each objShare in colShares
    errReturn = objShare.Delete
Next

If errReturn = 0 Then
	MsgBox "Общий ресурс для каталога " & WSH.CurrentDirectory & " успешно удален", vbInformation, "Уведомление"
End If

Set FSO = Nothing
Set WSH = Nothing

WScript.Quit

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

' ==============================================================
'  Автор:		SkOle, Оренбург
'  Описание:	Устанавливает текущий шрифт в систему
'  Параметры:	%P%N
' ==============================================================

Option Explicit 
Dim FSO 
Set FSO = CreateObject("Scripting.FileSystemObject") 
  
If WScript.Arguments.Count > 0 Then
	If FSO.FileExists(WScript.Arguments(0)) Then 
		If (LCase(FSO.GetExtensionName(WScript.Arguments(0))) = "ttf") or (LCase(FSO.GetExtensionName(WScript.Arguments(0))) = "fon") or (LCase(FSO.GetExtensionName(WScript.Arguments(0))) = "otf") Then
			Dim WSH 
			Set WSH = CreateObject("WScript.Shell") 
			
			FSO.CopyFile WScript.Arguments(0), WSH.SpecialFolders("Fonts") & "" 
			WSH.Run "RunDll32.exe gdi32.dll,AddFontResourceA " & FSO.GetBaseName(WScript.Arguments(0)) 
			
			Set WSH = Nothing
		Else
			MsgBox "Данный файл не является шрифтом", vbCritical, "Ошибка"
		End If
	End If
End If 

Set FSO = Nothing
WScript.Quit

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

' ===================================================================
'  Автор:		SkOle, Оренбург
'  Описание:	Выбирает, через какую программу открыть текущий файл
'				Выбор издет из списка в wincmd.ini
'  Параметры:	%P%N
' ===================================================================

Const Section = "ExternalApplication"

If WScript.Arguments.Count > 0 Then
        Dim WSH, FSO, Ext
        
        Set WSH = CreateObject("WScript.Shell") 
        Set FSO = CreateObject("Scripting.FileSystemObject") 
        
        Commander_Path = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%")
        Ext = FSO.GetExtensionName(WScript.Arguments(0))
        Ini = ReadIni (Commander_Path & "wincmd.ini", Section, Ext)
        If Ini <> "" Then
                Exe = Replace(Ini, "%COMMANDER_PATH%", Commander_Path)
                Ext =  Trim(Left(FSO.GetExtensionName(Exe), 3))
                If LCase(Ext) = "vbs" Then
                        WSH.Run Exe & " " & chr(34) & WScript.Arguments(0) & chr(34) 
                Else
                        WSH.Run chr(34) & Exe & chr(34) & " " & chr(34) & WScript.Arguments(0) & chr(34) 
                End If       
        Else
                Ini = ReadIni (Commander_Path & "wincmd.ini", Section, "default")
                Exe = Replace(Ini, "%COMMANDER_PATH%", Commander_Path)
                WSH.Run chr(34) & Exe & chr(34) & " " & chr(34) & WScript.Arguments(0) & chr(34) 
        End If
                
        Set WSH = Nothing
        Set FSO = Nothing
End If

' Функция чтения INI-файла была взята с форума wincmd.ru

Function ReadIni( myFilePath, mySection, myKey )
        Const ForReading   = 1
        Const ForWriting   = 2
        Const ForAppending = 8

        Dim intEqualPos
        Dim objFSO, objIniFile
        Dim strFilePath, strKey, strLeftString, strLine, strSection

        Set objFSO = CreateObject( "Scripting.FileSystemObject" )

        ReadIni = ""
        strFilePath = Trim( myFilePath )
        strSection  = Trim( mySection )
        strKey = Trim( myKey )

        If objFSO.FileExists( strFilePath ) Then
                Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
                Do While objIniFile.AtEndOfStream = False
                strLine = Trim( objIniFile.ReadLine )

                If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                        strLine = Trim( objIniFile.ReadLine )

                Do While Left( strLine, 1 ) <> "["
                        intEqualPos = InStr( 1, strLine, "=", 1 )
                        If intEqualPos > 0 Then
                                strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        If LCase( strLeftString ) = LCase( strKey ) Then
                                ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
                                If ReadIni = "" Then
                                        ReadIni = " "
                                End If
                                Exit Do
                        End If
                End If

                If objIniFile.AtEndOfStream Then Exit Do
                        strLine = Trim( objIniFile.ReadLine )
                        Loop
                        Exit Do
                End If
                Loop
                objIniFile.Close
        Else
		MsgBox strFilePath & " не найден", vbCritical, "Ошибка"
        Wscript.Quit 1
    End If
End Function

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

[ExternalApplication]
; По умолчанию
default=%COMMANDER_PATH%	oolswin32
otepad++
otepad++.exe
; Внешние утилиты
exe=wscript "%COMMANDER_PATH%	oolswin32
estorator
estorator.vbs"
iso=wscript "%COMMANDER_PATH%	oolswin32ultraisoultraiso.vbs"
ico=%COMMANDER_PATH%	oolswin32icofxicofx.exe
psd=%COMMANDER_PATH%	oolswin32photoshopphotoshop.exe