[решено] Создание линка

[nanervax]

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

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

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


strQuery = "<LDAP://OU=" & strOU & ",OU=myou," & strDNSDomain & ">;(&(objectCategory=Person)(objectClass=User));DisplayName,userAccountControl,samAccountName,mail;Subtre e"
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& "\test.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

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

[Iska]

ярлык, который ведет вверх на ступеньку. »
Каков глубинный смысл сего действа?

Ниже отрывок скрипта »
В Вашем отрывке кода не хватает главного — определения «strDestFolder». И используйте, пожалуйста, тэг [code] (http://forum.oszone.net/misc.php?do=bbcode#code) и фолдинг.

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

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

[nanervax]

Каков глубинный смысл сего действа? »
Дать возможность юзеру видеть публичные шары других юзеров
В Вашем отрывке кода не хватает главного — определения «strDestFolder» »
Вне фрагмента переменные конечно определены, я вроде еще не совсем деградировал)))
И используйте, пожалуйста, тэг и фолдинг. »
Хорошо, просто я новичок... буду знать.
Покажите скриншот ошибки. Покажите весь код. »
Скрин прилепил


[code]
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;Subtre e"
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


И там, и там — внутри юникод, снаружи ANSI/1251 (или какой иной язык у Вас будет установлен). »
Даже не знаю что делать с этим, выполняется скрипт на нерусифицированной win 2008 r2, в этом проблема? как обойти?

[Iska]

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

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

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

[nanervax]

Честно я сильно модифицировал чужой код, "If Err.Number" поудаляю... я вообще только начал костылять на vbs, даже профильных книжек не читал, тут я просто вынес
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.... куда ковырять?
функцию конверт ввел, тестил с ней, пробовал играться с кодировками и ни к чему не привело, теперь она просто висит там... просто я не знаю из какой кодировки в какую конвертировать, и из-за этого ли эта беда.

[nanervax]

Вообще кириллица из WSH VBScript выводится — по WScript.Echo, MsgBox? »
Прошу прощения, выводятся крокозябры! видно из-за того что винда не русифицированна...
Тю, просто в cmd кириллица вопросами((( буду ковырять

[nanervax]

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

[Iska]

"Language for non-unicode Programs" ("intl.cpl" - "Change System Locale") поставил русский, »
Так у Вас не стояло? Как же раньше работали и ни разу не столкнулись с подобной проблемой?

перекодировал скрипт в ANSI »
А была какая?

[nanervax]

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

[Iska]

UTF-8 вроде, уже и не помню.. »
Ничего, главное — вовремя ;).