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

nanervax · Отправлено: **10:11, 27-10-2014** | #3

Цитата 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, в этом проблема? как обойти?