' Option Explicit
' Собрал: Орлов В.И.
' цшдшфьы"нфтвучюкг
' icq:5279603
' Изменен:29.11.2010
' include файл.
' Способ подключения этого файла в скрипте .vbs:
' ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile("include.inf", 1).ReadAll
' ######################## - CОДЕРЖАНИЕ - ######################################################
' WSHShell - Объект "WScript.Shell"
' WSHNetwork - Объект "WScript.Network"
' objSysInfo - Объект "ADSystemInfo"
' FSO - Объект "Scripting.FileSystemObject"
' UserName - Возвращает имя текущего пользователя. например Admin.
' CompName - Возвращает имя текущего компьютера. например PC001.
' FullUserName - Возвращает полное имя текущего пользователя. например "CN=Admin,CN=Users,DC=domain,DC=lan".
' FullCompName - Возвращает полное имя текущего компьютера. например "CN=PC001,OU=Компьютеры,DC=domain,DC=lan".
' Domain - Возвращает имя домена. Например "WorkDomain"
' PathToScript - Возвращает путь до скрипта. Например "c:\folder" или "\\server\share\folder"
'CMDEXEC - Выполняет команду DOS и возвращает то что вернула команда на консоль
' Function cmdexec(comand)
'IIF - Возвращает v1 или v2 в зависимости от условия expression Истина/Ложь
' Function IIF(expression, v1, v2)
'ADUsers - Возвращает список пользователей(логинов) в домене из AD.
' Function ADUsers(uType)
' Если uType равен:
' 0 или "" - Не отключенные пользователи
' 1 - Отключенные пользователи
'dir - Возвращает содержание пап(ок/ки). помечает в начале строки D - папка, f - файл
' Function dir(Path, sFldr)
' Если Path = "" то текущая папка (откуда запущен скрипт).
' Если sFldr = "0" или "" то ТОЛЬКО текущая папка.
' Если sFldr = "1", то возвратит содержимое текущей папки и ее подпапок.
'ClearLog - Проверяет размер логфайла и затирет его начало до указанного размера + первую строку.
' Function ClearLog(LogFile, LogSize) ' Возвращает true/false в зависимости от завершения.
' LogFile - Путь к логфайлу.
' LogSize - Лимитированный размер лог файла в байтах.
'role - Устанавливает права пользователя user на папку dir : Запись, Чтение, Изменение, Выполнение
' Function role(user, dir)
' Возвращает 0 при удачной смене прав
'SizePrint - Возвращает округленное значение с префиксом. Например SizePrint(10000) = "9,766 Kb"
' Function SizePrint(Value)
'DelOld - Удаляет из папки sFldr файлы старше iDays дней относительно текушего времени
' Function DelOld(sFldr, iDays)
' и возвращает список удаленных файлов
' sFldr - Полный путь к папке ("\\server\disk$\folder")
' iDays - Количество дней за какое оставить файлы т.е. Удалит файлы дата которых меньше (Now - iDays)
'DefaultPrinter - Возвращает принтер по умолчанию
' Function DefaultPrinter()
'RunDos - Выполнить команду в DOS
' Function RunDos(command, arg, visible)
' command - команда DOS
' arg - ключи (можно несколько команд через &&)
' visible - 1/0 (Истина/Ложь) показать/скрыть окно выполнения
'enver - Получить переменную среды (аналог в .bat: "echo %windir%" например)
' Function enver("windir")
'OpenFile - Открыть диалогове окно "Выбор файла"
' Function OpenFile(Path, Filtr)
' filtr - Расширение открываемых файлов. "*" - все типы
' path - Путь к каталогу. "." - текущий каталог
'SystemDir - Возвращвет полный путь к системной папке
' Function SystemDir(sDir)
'``````````````````` SDIR `````````````````````````````````````````````````````
'Desktop - Рабочий стол `
'Favorites - Избранное `
'Fonts - Шрифты `
'MyDocuments - Мои документы `
'NetHood - Сетевое окружение `
'PrintHood - Принтеры `
'Programs - подменю Программы из меню Пуск текущего пользователя `
'Recent - подменю Документы из меню Пуск текущего пользователя `
'SendTo - подменю Отправить из контекстного меню файлов `
'StartMenu - Главное меню `
'Startup - Автозагрузка из подменю Программы `
'Templates - Шаблоны `
'Appdata - Application data текущего пользователя `
'AllUsersDesktop - Рабочий стол для всех пользователей `
'AllUsersStartMenu- Меню пуск всех пользователей `
'AllUsersPrograms - Меню Программы для всех пользователей `
'AllUsersStartup - Автозаргузка для всех пользователей `
'``````````````````````````````````````````````````````````````````````````````
'CreateLink - Cоздание ярлыка
' Function CreateLink(PathLink, Programma, NameLink, DirProga)
' PathLink - Папка, где будет создан ярлык.
' Programma - Полный путь к программе (d:\dir\proga.exe)
' NameLink - Так как будет называться ярлык
' DirProga - Рабочая папка. Если = "", то в той же папке что и Programma
' если DirProga = "dell", то ярлык будет удален
'DirTest - Проверка существования папки. Возвращает размер папки либо -1 при его отсутствии
' Function DirTest(strFolderName)
'FilTest - Проверка существования файла. Возвращает размер файла либо -1 при его отсутствии.
' Function FilTest(strFullFileName)
' Если размер файла равен 0, возвращает True
'TestDisk - Проверка существования диска. Возвращает бул.
' Function TestDisk(Dname, Dpath)
' Dname - Имя диска например N: или P:
' Dpath - Путь к подключаемому общему ресурсу сетевого диска. например \\server\share
' Dpath - Для локальных дисков равен "" (ничему)
'log - Дописывает новую строку sData в файл FileLog (если нет, создает файл)
' Function log(sData, FileLog)
'UserGroups - Возвращает строку с блоками [группа] в группы в которые входит текущий юзер.
' Function UserGroups()
'InGroup - Проверка принадлежности текущего пользователя к группе. Возвращает бул.
' Function InGroup(strGroup)
' strGroup - группа, принадлежность к которой проверяем
'DelFile - Удаляет файл если такой существует. Возвращает бул.
' Function DelFile(strFullFileName)
'THEEND - Пишеться в самом конце. Корректное завершение скрипта
' Function TheEnd()
'#########################################################################################################
' = = = = = = = = = = Задание параметров = = = = = = = = = = = = = = = = = = = = = = =
Dim WshNetwork, objSysInfo, FSO, WSHShell, PublicStr
PublicStr = ""
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objSysInfo = WScript.CreateObject("ADSystemInfo")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim UserName, CompName, FullUserName, FullCompName, PathToScript, Domain
UserName = WshNetwork.UserName
CompName = WshNetwork.ComputerName
FullUserName = objSysInfo.userName
FullCompName = objSysInfo.ComputerName
Domain = WshNetwork.UserDomain
PathToScript = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")-1)
Dim UserObj
Set UserObj = GetObject("LDAP://" & FullUserName)
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Function run(arg1, arg2) ' А это чудо вообще не знаю зачем мне нужно! :)
Execute arg1 & "(""" & arg2 & """)" ' Выполняет команду arg1 с параметром arg2
end Function
' ######################################################################################
' # ФУНКЦИИ ############################################################################
' ######################################################################################
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' convert_cyr_string
'
' Принимает строку в кодировке src и возвращает строку в кодировке dst
' srs и dst может принимать значение "w" - Windows-1251, "d" - Dos-ibm866, "u" - UTF-8
'
function convert_cyr_string(str,src,dst)
src = lcase(src)
dst = lcase(dst)
dim Fsrc, Fdst, ArrFdos, ArrFwin, ArrFutf, d, Simv, n
ArrFdos = split("128;129;130;131;132;133;134;135;136;137;138;139;140;141;142;143;144;" & _
"145;146;147;148;149;150;151;152;153;154;155;156;157;158;159;160;161" & _
";162;163;164;165;166;167;168;169;170;171;172;173;174;175;224;225;22" & _
"6;227;228;229;230;231;232;233;234;235;236;237;238;239;240;241",";")
ArrFwin = split("192;193;194;195;196;197;198;199;200;201;202;203;204;205;206;207;208;" & _
"209;210;211;212;213;214;215;216;217;218;219;220;221;222;223;224;225" & _
";226;227;228;229;230;231;232;233;234;235;236;237;238;239;240;241;24" & _
"2;243;244;245;246;247;248;249;250;251;252;253;254;255;168;184",";")
ArrFutf = split("208:144;208:145;208:146;208:147;208:148;208:149;208:150;208:151;208:" & _
"152;208:153;208:154;208:155;208:156;208:157;208:158;208:159;208:160" & _
";208:161;208:162;208:163;208:164;208:165;208:166;208:167;208:168;20" & _
"8:169;208:170;208:171;208:172;208:173;208:174;208:175;208:176;208:1" & _
"77;208:178;208:179;208:180;208:181;208:182;208:183;208:184;208:185;" & _
"208:186;208:187;208:188;208:189;208:190;208:191;209:128;209:129;209" & _
":130;209:131;209:132;209:133;209:134;209:135;209:136;209:137;209:13" & _
"8;209:139;209:140;209:141;209:142;209:143;208:129;209:145",";")
if (src = "w" and dst = "w") or (src = "d" and dst = "d") or (src = "u" and dst = "u") then
convert_cyr_string = str
exit function
end if
if src = "w" then
Fsrc = ArrFwin
elseif lcase(src) = "d" then
Fsrc = ArrFdos
elseif lcase(src) = "u" then
Fsrc = ArrFutf
else
convert_cyr_string = "Err: The variable src isn't true"
exit function
end if
if dst = "w" then
Fdst = ArrFwin
elseif dst = "d" then
Fdst = ArrFdos
elseif dst = "u" then
Fdst = ArrFutf
else
convert_cyr_string = "Err: The variable dst isn't true"
exit function
end if
Set d = CreateObject("Scripting.Dictionary")
for n=0 to ubound(Fsrc)
d.Add Fsrc(n), Fdst(n)
next
if (src = "w" and dst = "d") or (src = "d" and dst = "w") then
for n = 1 to len(str)
if d.item(cStr(asc(mid(str,n,1)))) <> "" then
Simv = Simv & chr(d.item(cStr(asc(mid(str,n,1)))))
else
Simv = Simv & mid(str,n,1)
end if
next
elseif src = "u" then
for n = 1 to len(str)
if asc(mid(str,n,1)) = 208 or asc(mid(str,n,1)) = 209 then
Simv = Simv & chr(d.Item(cStr(asc(left(mid(str,n,2),1)) & ":" & asc(right(mid(str,n,2),1)))))
n = n + 1
else
Simv = Simv & mid(str,n,1)
end if
next
elseif dst = "u" then
for n = 1 to len(str)
if d.item(cStr(asc(mid(str,n,1)))) <> "" Then
Simv = Simv & chr(left(d.item(cStr(asc(mid(str,n,1)))),3)) & chr(right(d.item(cStr(asc(mid(str,n,1)))),3))
else
Simv = Simv & mid(str,n,1)
end if
next
end if
set d = Nothing
convert_cyr_string = Simv
end function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' CMDEXEC
'
' Выполняет команду DOS и возвращает то что вернула команда на консоль
function cmdexec(comand)
dim n, strOut, Arr1, WshExec, OutStream, InStream
Set WshExec = WshShell.Exec("cmd")
Set OutStream = WshExec.StdOut
Set InStream = WshExec.StdIn
InStream.WriteLine comand
InStream.WriteLine "exit"
StrOut = vbNewLine
Arr1 = Split(OutStream.ReadAll, vbNewLine)
for n = 2 to ubound(Arr1) - 2
StrOut = StrOut & replace(replace(Arr1(n),chr(10),""), chr(13), vbNewLine) & vbNewLine
next
cmdexec = replace(Left(CStr(StrOut),Len(CStr(StrOut))-4),vbNewLine & vbNewLine, vbNewLine)
Set WshExec = Nothing
Set OutStream = Nothing
Set InStream = Nothing
end function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'IIF
'
' Возвращает v1 или v2 в зависимости от условия expression Истина/Ложь
'
function IIF(expression, v1, v2)
if expression then
IIF = v1
else
IIF = v2
end if
end function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'ADUsers
'
' Возвращает список пользователей(логинов) в домене из AD.
' Если Type равен:
' 0 или "" - Не отключенные пользователи
' 1 - Отключенные пользователи
'
function ADUsers(uType)
Dim UAC, Pstr
Pstr = PublicStr
PublicStr = ""
if strComp(uType, 1) = 0 then
UAC = "66082, 66050, 514" 'msgbox "Только отключенные пользователи" ' Спорно
else
UAC = "66048, 512" ', 66080" 'msgbox "НЕ отключенные пользователи"
' Спорно :)) "с" и "порно" - читать слитно! :)
end if
Dim objRootDSE
Dim objDomain
Dim strOutputFileName, objOutputFileName, GarbageRC
Set objRootDSE = GetObject("LDAP://RootDSE")
Set objDomain = GetObject("LDAP://" & objRootDSE.Get("DefaultNamingContext"))
Call Sub_EnumOUs(objDomain.ADsPath, UAC)
ADUsers = PublicStr
PublicStr = Pstr
end function
Sub Sub_EnumOUs(sADsPath, UAC)
Dim objContainer
Set objContainer = GetObject(sADsPath)
'objContainer.Filter = Array("organizationalUnit")
' Раскоментировать если надо пройтись только по OU. Увеличивает скорость работы.
'objContainer.Filter = Array("container")
' Раскоментировать если надо пройтись только по CN. Увеличивает скорость работы.
objContainer.Filter = Array("organizationalUnit", "container")
' Закоментировать если раскоментировали одну из предыдущих двух строк
Dim objOrganizationalUnit
For Each objOrganizationalUnit in objContainer
Sub_EnumUsers objOrganizationalUnit.ADsPath, UAC
Sub_EnumOUs objOrganizationalUnit.ADsPath, UAC
Next
End Sub
Sub Sub_EnumUsers(sADsPath, UAC)
Dim objADobject
Dim objContainer
Set objContainer = GetObject(sADsPath)
objContainer.Filter = Array("User")
For Each objADobject in objContainer
If objADobject.Class = "user" Then
If InStr(1,UAC,cStr(objADobject.userAccountControl)) Then
PublicStr = PublicStr & objADobject.sAMAccountName & chr(10)
End If
End If
Next
End Sub
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'dir
'
' Возвращает содержание пап(ок/ки).
' Если Path = "" то текущая папка.
' Если sFldr = "0" или "" то ТОЛЬКО текущая папка.
' Если sFldr = "1", то возвратит содержимое текущей папки и ее подпапок.
function dir(Path, Depth)
dim dirThis, fff, ddd, sDir, SubFolder
if CStr(Depth) = "0" or Trim(CStr(Depth)) = "" or CStr(Depth) = "1" then
' значит вывести список текущего каталога [первый проход(единственный)]
if Trim(Cstr(Path)) = "" then
Path = PathToScript
end if
if FSO.FolderExists(Path) then
set dirThis = FSO.GetFolder(Path)
fordir = "=> " & Path & ":" & vbNewLine
For each ddd In dirThis.Subfolders
fordir = fordir & "D " & ddd.Name & vbNewLine
Next
For Each fff in dirThis.files
fordir = fordir & "f " & fff.Name & vbNewLine
next
end if
if CStr(Depth) = "1" then
' значит вывести список подкаталогов [первый проход(единственный)]
set Sdir = dirThis.SubFolders
For Each SubFolder in Sdir
dir SubFolder.Path, fordir
Next
end if
end if
if CStr(Depth) <> "0" and CStr(Depth) <> "1" then
' Значит это уже сабфолдер [только второй и следующие проходы]
set dirThis = fso.getFolder(Path)
fordir = Depth & "=> " & Path & ":" & vbNewLine
For each ddd In dirThis.Subfolders
fordir = fordir & "D " & ddd.Name & vbNewLine
Next
for each fff in dirThis.files
fordir = fordir & "f " & fff.Name & vbNewLine
next
set Sdir = dirThis.SubFolders
For Each SubFolder in Sdir
dir SubFolder.Path, fordir
Next
end if
dir = fordir
end function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'ClearLog
'
'Проверяет размер логфайла и затирет его начало до указанного размера.
Function ClearLog(LogFile, LogSize)
dim str
ClearLog = False
if FilTest(LogFile) then
if FSO.getFile(LogFile).size > LogSize then
str = right(FSO.OpenTextFile(LogFile, 1, false).ReadAll, LogSize)
str = mid(str, instr(str, vbnewline) + 2, len(str))
FSO.OpenTextFile(LogFile, 2, True).Write str
ClearLog = True
end if
end if
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'role
'
'Устанавливает права пользователя user на папку или файл path : Запись, Чтение, Изменение, Выполнение
Function role(user, path)
role = False
If DirTest(path) or FilTest(path) Then
' role = WSHShell.Run("cacls " & path & " /E /P " & Domain & "\" & user & ":F",0,True)
role = WSHShell.Run("cacls " & path & " /E /P " & user & ":C",0,True)
End If
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'SizePrint
'
' Возвращает округленное значение с префиксом. Например SizePrint(10000) = "9,766 Kb"
Function SizePrint(Value)
KB=1024
MB=KB*1024
GB=MB*1024
TB=GB*1024
If Value < KB Then
SizePrint = Round(Value, 3) & chr(9) & "b "
ElseIf Value >= KB AND Value < MB Then
SizePrint = Round(Value/KB, 3) & chr(9) & "Kb"
ElseIf Value >= MB AND Value < GB Then
SizePrint = Round(Value/MB, 3) & chr(9) & "Mb"
ElseIf Value >= GB AND Value < TB Then
SizePrint = Round(Value/GB, 3) & chr(9) & "Gb"
Else
SizePrint = Round(Value/TB, 3) & chr(9) & "Tb"
End If
End Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'DelOld
'
' Удаляет из папки sFldr файлы старше iDays дней относительно текушего времени
' и возвращает список удаленных файлов
' sFldr - Полный путь к папке ("\\server\disk$\folder")
' iDays - Количество дней за какое оставить файлы т.е. Удалит файлы дата которых меньше (Now - iDays)
Function DelOld(sFldr, iDays)
Dim oI, files
For Each oI In FSO.GetFolder(sFldr).Files
If DateDiff("d", oI.DateLastModified, Now) > iDays Then
files = files & oI.DateLastModified & " " & SizePrint(oI.size) & " " & oI.Name & chr(13) & chr(10)
oI.Delete
End if
Next
if trim(files) <> "" then
DelOld = files
else
DelOld = ""
end if
End Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'DefaultPrinter
'
' Возвращает принтер по умолчанию
Function DefaultPrinter()
DefaultPrinter = Left(WSHShell.RegRead("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device" & _
"") ,InStr(WSHShell.RegRead("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"), ",") - 1)
End Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'RunDos
'
' Выполнить команду в DOS
' command - команда DOS
' arg - ключи (можно несколько команд через &&)
' visible - 1/0 (Истина/Ложь) показать/скрыть окно выполнения
'
Function RunDos(command, arg, visible)
RunDos = WshShell.Run("cmd /C " & command & " " & arg,visible,True) ' Здесь True - ждать завершения команды
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'enver
'
' Получить переменную среды (аналог в .bat: "echo %windir%" например)
Function enver(perem)
enver = WSHshell.ExpandEnvironmentStrings("%" & perem & "%")
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'OpenFile
'
' Открыть диалогове окно "Выбор файла"
' filtr - Расширение открываемых файлов. "*" - все типы
' path - Путь к каталогу. "." - текущий каталог
Function OpenFile(Path, Filtr)
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Тип файлов - *." & Filtr & "|*." & Filtr
objDialog.FilterIndex = 2
objDialog.InitialDir = Path
intResult = objDialog.ShowOpen
OpenFile = objDialog.FileName
Set objDialog = Nothing
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'SystemDir
'
' Возвращвет полный путь к системной папке
'``````````````````````````````````````````````````````````````````````````````
'Desktop - Рабочий стол `
'Favorites - Избранное `
'Fonts - Шрифты `
'MyDocuments - Мои документы `
'NetHood - Сетевое окружение `
'PrintHood - Принтеры `
'Programs - подменю Программы из меню Пуск текущего пользователя `
'Recent - подменю Документы из меню Пуск текущего пользователя `
'SendTo - подменю Отправить из контекстного меню файлов `
'StartMenu - Главное меню `
'Startup - Автозагрузка из подменю Программы `
'Templates - Шаблоны `
'Appdata - Application data текущего пользователя `
'AllUsersDesktop - Рабочий стол для всех пользователей `
'AllUsersStartMenu- Меню пуск всех пользователей `
'AllUsersPrograms - Меню Программы для всех пользователей `
'AllUsersStartup - Автозаргузка для всех пользователей `
' `
Function SystemDir(sDir)
SystemDir = WSHShell.SpecialFolders(sDir)
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'CreateLink
'
' Cоздание ярлыка `
' PathLink - Папка, где будет создан ярлык `
' Programma - Полный путь к программе (d:\dir\proga.exe) `
' NameLink - Так как будет называться ярлык `
' DirProga - Рабочая папка. Если = "", то в той же папке что и Programma `
' если DirProga = "dell", то ярлык будет удален `
'``````````````````````````````````````````````````````````````````````````````
Function CreateLink(PathLink, Programma, NameLink, DirProga)
if right(PathLink, 1) <> "\" then PathLink = PathLink & "\"
if lcase(trim(DirProga)) = "dell" then
DelFile PathLink & NameLink & ".lnk"
elseif Not FSO.FileExists(PathLink & NameLink & ".lnk") Then
Dim t2, i
if trim(DirProga) = "" then
t2 = Split(Programma,"\")
DirProga = t2(0)
for i=1 to UBound(t2) - 1
DirProga = DirProga & "\" & t2(i)
next
end if
Set MyShortcut = WSHShell.CreateShortcut(PathLink & NameLink & ".lnk")
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings (Programma)
MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings (DirProga)
MyShortcut.Windowstyle="4"
MyShortcut.IconLocation = WSHShell.ExpandEnvironmentStrings (Programma)
MyShortcut.Save
Set MyShortcut = Nothing
End If
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'DirTest
'
' Проверка существования папки. Возвращает размер папки либо -1 при его отсутствии
Function DirTest(strFolderName)
if FSO.FolderExists(strFolderName) then
DirTest = FSO.GetFolder(strFolderName).Size
else
DirTest = -1
end if
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'FilTest
'
' Проверка существования файла. Возвращает размер файла либо -1 при его отсутствии
Function FilTest(strFullFileName)
if FSO.FileExists(strFullFileName) then
FilTest = FSO.getFile(strFullFileName).size
else
FilTest = -1
end if
End Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'TestDisk
'
' Function TestDisk(Dname, Dpath) возвращает true если есть такой диск.
' Dname - Имя подключенного сетевого диска например N: или P:
' Dpath - Путь к подключаемому общему ресурсу этого диска. например \\server\share
' Dpath - для локальных дисков равен "" (ничему)
Function TestDisk(Dname, Dpath)
Dim objDrv
TestDisk = false
Set objDrv = FSO.Drives
For Each Drive In objDrv
if Drive.IsReady then
if lcase(Drive.Path) = lcase(Dname) and lcase(Drive.ShareName) = lcase(Dpath) then
TestDisk = true
Exit for
end if
end if
next
Set objDrv = Nothing
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'log
'
' Дописывает новую строку sData в файл FileLog (если нет, создает файл)
Function log(sData, FileLog)
Dim ts, ForAppending
ForAppending = 8
Set ts = FSO.OpenTextFile(FileLog, ForAppending, True)
ts.WriteLine(sData)
ts.Close
Set ts = Nothing
End Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'UserGroups
'
' Возвращает строку с блоками [группа] в группы в которые входит текущий юзер.
Function UserGroups()
For Each GroupObj In UserObj.Groups
UserGroups=UserGroups & "[" & Right(GroupObj.Name, Len(GroupObj.Name)-3) & "]"
Next
end Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' InGroup
'
' Проверка принадлежности текущего пользователя к группе
' strGroup - группа, принадлежность к которой проверяем
Function InGroup(strGroup)
InGroup=False
For Each GroupObj In UserObj.Groups
If Lcase(Trim("CN=" & StrGroup)) = LCase(Trim(GroupObj.Name)) Then
InGroup=True
Exit For
End If
Next
End Function
'---------------------------------------------------------------------------------------
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'DelFile
'
' Удаляет файл если такой существует
Function DelFile(strFullFileName)
On Error Resume Next
Err.Clear
If FSO.FileExists(strFullFileName) Then
FSO.GetFile(strFullFileName).Delete
if Err.Number <> 0 then
DelFile = False
else
DelFile = True
end if
else
DelFile = False
End If
Err.Clear
On Error GoTo 0
End Function
' =====================================================================================
' =====================================================================================
' THE END
Function TheEnd()
set WshNetwork = nothing
set objSysInfo = nothing
set FSO = nothing
Set UserObj = nothing
Set WSHShell = nothing
wscript.quit 0
' ==== EXIT ====
end Function
' ######################################################################################
' # КОНЕЦ ФУНКЦИЙ#######################################################################
' ######################################################################################
