[Iska]

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

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

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

В Вашем отрывке кода не хватает главного — определения «strDestFolder». И используйте, пожалуйста, тэг [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;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

И там, и там — внутри юникод, снаружи 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 вроде, уже и не помню.. »

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