skole
|
 Posted: Tue Feb 21, 2012 20:25 Post subject: |
 |
|
Еще в тему, может кому понадобится... если Batya доработает, то хорошо 
Создание шары из текущего каталога
| Code: | ' ===================================================================
' Автор: 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 |
Удаление шары, если текущий каталог таким является
| Code: | ' ===================================================================
' Автор: 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 |
Установка шрифта
| Code: | ' ==============================================================
' Автор: 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 |
Аналог ChoiseEditor и пр. вешается на F4
| Code: | ' ===================================================================
' Автор: 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 |
ну и пример использования... необходимая секция из wincmd.ini
| Code: | [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 |
Last edited by skole on Sun Feb 26, 2012 09:41; edited 1 time in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
