[решено] Создание линка - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

- - [решено] Создание линка (http://forum.oszone.net/showthread.php?t=289901)

Создание линка

Здравствуйте.
Есть контроллер домена
Есть скрипт VBS, который создает файлопомойку для юзеров вида:

Пупкин Вася
|
----Private
|
----Public

Мне необходимо создать наравне с папками Private и Public ярлык, который ведет вверх на ступеньку.
Задача тривиальная, но я беру название пользователя как DisplayName с контроллера, оно написано кириллицей для удобства дорогих юзеров.
Я получаю путь для создания папок, все отрабатывает, папки создаются, несмотря на кириллицу
Но с линком проблема, он создается через объект WScript.Shell, и ни в какую не хочет создаваться, и что самое интересное, в ошибке вместо нормальной кириллицы вопросики, а самое смешное то, что я не знаю в какой кодировке отдает данных контроллер и какую кодировку может принять WScript.Shell
Ниже отрывок скрипта

код

Если сделать MsgBox strUserFolderPath, то все корректно отображается..
Пробовал перекодировать строку, но методом тыка не получилось узнать кодировки, надоело голову ломать, буду рад услышать советы, и может как-то можно через другой объект линки создавать?

Цитата:

Цитата nanervax

ярлык, который ведет вверх на ступеньку. »

Каков глубинный смысл сего действа?

Цитата:

Цитата nanervax

Ниже отрывок скрипта »

В Вашем отрывке кода не хватает главного — определения «strDestFolder». И используйте, пожалуйста, тэг [code] и фолдинг.

Цитата:

Цитата nanervax

и что самое интересное, в ошибке вместо нормальной кириллицы вопросики, »

Покажите скриншот ошибки. Покажите весь код.

Цитата:

Цитата nanervax

а самое смешное то, что я не знаю в какой кодировке отдает данных контроллер и какую кодировку может принять WScript.Shell »

И там, и там — внутри юникод, снаружи ANSI/1251 (или какой иной язык у Вас будет установлен).

Цитата:

Цитата Iska

Каков глубинный смысл сего действа? »

Дать возможность юзеру видеть публичные шары других юзеров

Цитата:

Цитата Iska

В Вашем отрывке кода не хватает главного — определения «strDestFolder» »

Вне фрагмента переменные конечно определены, я вроде еще не совсем деградировал)))

Цитата:

Цитата Iska

И используйте, пожалуйста, тэг [code] и фолдинг. »

Хорошо, просто я новичок... буду знать.

Цитата:

Цитата Iska

Покажите скриншот ошибки. Покажите весь код. »

Скрин прилепил

Весь код

Код:

Public strUserSID, strGroupUsersSID, strGroupAdminsSID

Dim objConnection, objCommand, objFso, objRSet, objRecordSet, objRootDSE, objShortCut, objShell

Dim strQuery, strDNSDomain, strDestFolder, strUser, strOU, strUserFolderPath, strUserPrivatePath, strUserPublicPath, strMail, strNTDomain, strUserDomain, strNeedDomain, strDestNetDepartments, strDestNetUsers

Dim objWMI, objCollection, objItem

const ADS_UF_ACCOUNTDISABLE = 2



strDestFolder = "E:\share\Users\"

strNeedDomain = "mydomain.ru"

strDestNetUsers = "\\share_ip\share\Users\"



Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strNTDomain & "' AND Name='Domain Users'")

If Err.Number = 0 Then

        For Each objItem In objCollection

                strGroupUsersSID = objItem.SID

        Next

End if

Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strNTDomain & "' AND Name='Domain Admins'")

If Err.Number = 0 Then

        For Each objItem In objCollection

                strGroupAdminsSID = objItem.SID

        Next

End if



set objFso = createobject ("scripting.filesystemobject")



Set objRootDSE = GetObject("LDAP://RootDSE")

strDNSDomain = objRootDSE.Get("defaultNamingContext")

strNTDomain = Mid(Split(strDNSDomain, ",dc=", -1, vbTextCompare)(0), 4)

Set objWMI = GetObject("winmgmts:\\.\root\cimv2")

Set objRootDSE = Nothing



Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")

Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000

objCommand.Properties("Timeout") = 30

strQuery = "<LDAP://OU=ProfitUsers," & strDNSDomain &  ">;(objectCategory=organizationalUnit);Name;OneLevel"

objCommand.CommandText = strQuery

Set objRecordSet = objCommand.Execute

If Err.Number = 0 Then

        objRecordSet.MoveFirst

        Do Until objRecordSet.EOF

                strOU = objRecordSet.Fields("Name").Value

                if StrComp(strOU,"Sys") <> 0 Then

                        strQuery = "<LDAP://OU=" & strOU & ",OU=ProfitUsers," & strDNSDomain & ">;(&(objectCategory=Person)(objectClass=User));DisplayName,userAccountControl,samAccountName,mail;Subtree"

                        objCommand.CommandText = strQuery

                        Set objRSet = objCommand.Execute

                        If Err.Number = 0 Then

                                objRSet.MoveFirst

                                Do Until objRSet.EOF

                                        If Not CBool(objRSet.Fields("userAccountControl").Value And ADS_UF_ACCOUNTDISABLE) Then

                                                Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strNTDomain & "' AND Name='" & objRSet.Fields("samAccountName").Value & "'")

                                                If Err.Number = 0 Then

                                                        For Each objItem In objCollection

                                                                strUserSID = objItem.SID

                                                        Next

                                                        strUser = objRSet.Fields("DisplayName").Value

                                                        strMail = objRSet.Fields("mail").Value

                                                        strUserFolderPath = objFso.BuildPath(strDestFolder,strUser)

                                                        strUserPublicPath = objFso.BuildPath(strUserFolderPath,"Public")

                                                        strUserPrivatePath = objFso.BuildPath(strUserFolderPath,"Private")

                                                        If Len(strMail)<>0 Then

                                                                strUserDomain = Mid(Split(strMail, "@", -1, vbTextCompare)(1), 1)

                                                                If StrComp(strUserDomain,strNeedDomain) = 0 Then

                                                                        If Not objFso.FolderExists(strUserFolderPath) Then

                                                                                objFso.createFolder strUserFolderPath

                                                                                Call Modify_Own (strNTDomain, objWMI, strUserFolderPath)

                                                                                set objShell = WScript.CreateObject ("WScript.Shell")

                                                                                Set objShortCut = objShell.CreateShortcut(strUserFolderPath & "\asd.lnk")

                                                                                objShortCut.TargetPath = strDestNetUsers

                                                                                objShortCut.Save

                                                                                objFso.createFolder strUserPublicPath

                                                                                Call Modify_Own (strNTDomain, objWMI, strUserPublicPath)

                                                                                objFso.createFolder strUserPrivatePath

                                                                                Call Modify_Own (strNTDomain, objWMI, strUserPrivatePath)

                                                                                Call Modify_ACL(objWMI, strUserPrivatePath, strNTDomain, strUser, 1)

                                                                                Call Modify_ACL(objWMI, strUserPublicPath, strNTDomain, strUser, 0)

                                                                        End if

                                                                End if

                                                        End if

                                                End if

                                        End if

                                objRSet.MoveNext

                                Loop

                        End if

                End if

        objRecordSet.MoveNext

        Loop

End if







Sub Modify_ACL(objWMIServ, strDir, strDom, strSAN, intMode)

Dim objSecSettings, objSD, objSID

Dim strName, strSID2, intFlags, lngMask

Const SE_DACL_PROTECTED                                 =         4096



Const FULL_CONTROLL                                         =        2032127

Const SYNCHRONIZE                                                =        1048576

Const TAKEOWNERSHIP                                         =        524288

Const CHANGEPERMISSIONS                                 =        262144

Const MODIFY                                                         =        197055

Const READANDEXECUTE                                         =        131241

Const READ                                                         =        131209

Const READPERMISSIONS                                 =        131072

Const DELETE                                                        =        65536

Const WRITE                                                        =        278

Const WRITEATTRIBUTES                                        =        256

Const READATTRIBUTES                                        =        128

Const DELETESUBDIRECTORIESANDFILES                =        64

Const EXECUTEFILE                                                =        32

Const TRAVERSE                                                =        32

Const WRITEEXTENDEDATTRIBUTES                        =        16

Const READEXTENDEDATTRIBUTES                        =        8

Const APPENDDATA                                                =        4

Const CREATEDIRECTORIES                                =        4

Const CREATEFILES                                                =        2

Const WRITEDATA                                                =        2

Const READDATA                                                =        1

Const LISTDIRECTORY                                        =        1



Const OBJECT_INHERIT_ACE                                =        1

Const CONTAINER_INHERIT_ACE                        =        2

Const NO_PROPAGATE_INHERIT_ACE                =        4

Const INHERIT_ONLY_ACE                                =        8

Const INHERITED_ACE                                        =        16





Set objSecSettings = objWMIServ.Get("Win32_LogicalFileSecuritySetting.Path='" & strDir & "'")

If Err.Number = 0 Then

        If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then

                If Not IsNull(objSD.DACL) Then

                        objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED

                        objSecSettings.SetSecurityDescriptor(objSD)

                        If intMode = 0 Then ' Public

                                strName = "Domain Users"

                                strSID2 = strGroupUsersSID

                                intFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE

                                lngMask = FULL_CONTROLL - DELETE - DELETESUBDIRECTORIESANDFILES - TAKEOWNERSHIP - CHANGEPERMISSIONS

                                Call Grant_Perm (strName, strDom, strSID2, intFlags,lngMask,objSD,objWMIServ)

                                strName = strSAN

                                strSID2 = strUserSID

                                intFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE

                                lngMask = FULL_CONTROLL - DELETE - TAKEOWNERSHIP - CHANGEPERMISSIONS

                                Call Grant_Perm (strName, strDom, strSID2, intFlags,lngMask,objSD,objWMIServ)

                        ElseIf intMode = 1 Then ' Private

                                strName = strSAN

                                strSID2 = strUserSID

                                intFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE

                                lngMask = FULL_CONTROLL - DELETE - TAKEOWNERSHIP - CHANGEPERMISSIONS

                                Call Erase_Perm (objSD)

                                Call Grant_Perm (strName, strDom, strSID2, intFlags,lngMask,objSD,objWMIServ)

                                strName = "Domain Admins"

                                strSID2 = strGroupAdminsSID

                                intFlags = OBJECT_INHERIT_ACE + CONTAINER_INHERIT_ACE

                                lngMask = FULL_CONTROLL

                                Call Grant_Perm (strName, strDom, strSID2, intFlags,lngMask,objSD,objWMIServ)

                        End If

                        if intMode <> 1 Then

                                objSD.ControlFlags = objSD.ControlFlags - SE_DACL_PROTECTED

                        End if

                        objSecSettings.SetSecurityDescriptor(objSD)

                        If Err.Number <> 0 Then

                                Err.Clear

                        End If

                End If

        End If

Else

        Err.Clear

End If

End Sub



Sub Grant_Perm (strName2, strDom2, strSID3, intFlags2, lngMask2, objSD2, objWMIServ2)

Dim objTrustee, objACE

Dim i, arrACE

Dim objSID



arrACE = objSD2.DACL

Set objSID = objWMIServ2.Get("Win32_SID.SID='" & strSID3 & "'")

Set objTrustee = objWMIServ2.Get("Win32_Trustee").Spawninstance_()

objTrustee.Domain = strDom2

objTrustee.Name = strName2

objTrustee.SID = objSID.BinaryRepresentation

objTrustee.SidLength = objSID.SidLength

objTrustee.SIDString = strSID3

Set objACE = objWMIServ2.Get("Win32_Ace").Spawninstance_()

objACE.AceType = 0

objACE.AceFlags = intFlags2

objACE.AccessMask = lngMask2

objACE.Trustee = objTrustee

i = UBound(arrACE) + 1

ReDim Preserve arrACE(i)

Set arrACE(i) = objACE

Set objTrustee = Nothing

Set objSID = Nothing

Set objACE = Nothing

objSD2.DACL = arrACE

Erase arrACE

End Sub



Sub Erase_Perm (objSD2)

Dim i, arrACE



arrACE =  Array(): i = -1

objSD2.DACL = arrACE

Erase arrACE

End Sub



Sub Modify_Own (strDom3, objWMIServ1, path)

Dim objSID, objSecSettings, objSD3

Dim strName1, strSID4



Set objSecSettings = objWMIServ1.Get("Win32_LogicalFileSecuritySetting.Path='" & path & "'")

If Err.Number = 0 Then

        If objSecSettings.GetSecurityDescriptor(objSD3) = 0 Then

                strName1 = "Domain Admins"

                strSID4 = strGroupAdminsSID

                Set objSID = objWMIServ1.Get("Win32_SID.SID='" & strSID4 & "'")

                objSD3.Owner.Domain = strDom3

                objSD3.Owner.Name = strName1

                objSD3.Owner.SID = objSID.BinaryRepresentation

                objSD3.Owner.SidLength = objSID.SidLength

                objSD3.Owner.SIDString = strSID4

        End if

End if

objSecSettings.SetSecurityDescriptor(objSD3)

End Sub



function convert(txt, srcCharset, dstCharset)

set stream = createobject("ADODB.Stream")

with stream

.Type = 2 : .Mode = 3 : .Charset = srcCharset

.Open

.WriteText txt, 0

.Position = 0

.Charset = dstCharset : convert = .ReadText

end with

end function

Цитата:

Цитата Iska

И там, и там — внутри юникод, снаружи ANSI/1251 (или какой иной язык у Вас будет установлен). »

Даже не знаю что делать с этим, выполняется скрипт на нерусифицированной win 2008 r2, в этом проблема? как обойти?

Цитата:

Цитата nanervax

Вне фрагмента переменные конечно определены, »

Ключевое — именно «вне»: Вы видите, где и чем определяется. Я по огрызку кода — не вижу.

Цитата:

Цитата nanervax

Весь код »

Ну, не весь же ;). Где-то должно быть определение «objWMI», инструкция «On Error Resume Next» (без чего нет никакого толку от попытки «If Err.Number…» — до неё просто дело не дойдёт). В сообщении об ошибке написано «Unable to save shortcut …» и указана строка «71», но в приведённом коде строка «objShortCut.Save», могущая вызывать данную ошибку — это строка «73». Присутствует функция «convert», которая нигде в приведённом коде не используется.

Визуально не вижу, как и почему может возникать ошибка. Равно не могу сказать по поводу символов «?» в сообщении об ошибке. Вообще кириллица из WSH VBScript выводится — по WScript.Echo, MsgBox?

Честно я сильно модифицировал чужой код, "If Err.Number" поудаляю... я вообще только начал костылять на vbs, даже профильных книжек не читал, тут я просто вынес

Цитата:

Цитата nanervax

Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strNTDomain & "' AND Name='Domain Users'")
If Err.Number = 0 Then
For Each objItem In objCollection
strGroupUsersSID = objItem.SID
Next
End if
Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Domain='" & strNTDomain & "' AND Name='Domain Admins'")
If Err.Number = 0 Then
For Each objItem In objCollection
strGroupAdminsSID = objItem.SID
Next
End if »

за определение переменной objWMI, в исходном коде этот фрагмент находится после определения, внутри цикла, но я подумал что меня тут помидорами закидают, если увидят, что я в цикле получаю все время одно и тоже значение=) вынес вверх, а переместить определение WMI забыл... не судите строго...
MsgBox выводит отлично, да и, как вы можете видеть, папки то создаются private, public.... куда ковырять?
функцию конверт ввел, тестил с ней, пробовал играться с кодировками и ни к чему не привело, теперь она просто висит там... просто я не знаю из какой кодировки в какую конвертировать, и из-за этого ли эта беда.

Цитата:

Цитата Iska

Вообще кириллица из WSH VBScript выводится — по WScript.Echo, MsgBox? »

Прошу прощения, выводятся крокозябры! видно из-за того что винда не русифицированна...
Тю, просто в cmd кириллица вопросами((( буду ковырять

"Language for non-unicode Programs" ("intl.cpl" - "Change System Locale") поставил русский, перекодировал скрипт в ANSI, все заработало, спасибо Iska за попытки помочь

Цитата:

Цитата nanervax

"Language for non-unicode Programs" ("intl.cpl" - "Change System Locale") поставил русский, »

Так у Вас не стояло? Как же раньше работали и ни разу не столкнулись с подобной проблемой?

Цитата:

Цитата nanervax

перекодировал скрипт в ANSI »

А была какая?

UTF-8 вроде, уже и не помню..

Цитата:

Цитата nanervax

UTF-8 вроде, уже и не помню.. »

Ничего, главное — вовремя ;).