VBNet - Форум - Автоматизация создания папки при созд. польз. в AD

Вопрос: Автоматизация создания папки при созд. польз. в AD Добавлено: 16.07.09 16:23

Автор вопроса: outofdate

Есть такой скриптик, был найден на просторах интернета. Его задача отслеживать в эвентах появление нового пользователя. При срабатывании скрипт ругает 22 строку и выдает ошибку invalid procedure call or argument mid.

Помогите исправить? Скрипт очень полезен.)

Dim strTemp, strRight, intPos1, intPos2
Dim intCode, intType, strSource
Const strLeft = "записи:"
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\.\root\cimv2")
Set objCollection = objWMI.ExecNotificationQuery("SELECT * FROM __InstanceCreationEvent " & _
        "WITHIN 1 WHERE TargetInstance ISA 'Win32_NTLogEvent'")
Do
    Set objItem = objCollection.NextEvent
    intCode = objItem.TargetInstance.EventCode
    intType = objItem.TargetInstance.EventType
    strSource = objItem.TargetInstance.SourceName
        If StrComp(strSource, "Security", vbTextCompare) = 0 And intType = 4 Then
            If intCode = 624 Or intCode = 629 Then
                If intCode = 624 Then
                    strRight = "Новый"
                Else
                    strRight = "Конечный"
                End If
                strTemp = objItem.TargetInstance.Message
                intPos1 = InStr(1, strTemp, strLeft, vbTextCompare) + Len(strLeft)
                intPos2 = InStr(1, strTemp, strRight, vbTextCompare)
                strTemp = Trim(Mid(strTemp, intPos1, intPos2 - intPos1))
                strTemp = Replace(strTemp, vbTab, "")
                strTemp = Replace(strTemp, vbNewLine, "")
                If intCode = 624 Then
                    'WScript.Echo "Создана учётная запись: " & strTemp
                    Call Create_DocFolder(strTemp)
                Else
                    'WScript.Echo "Отключена учётная запись: " & strTemp
                    Call Move_DocFolder(strTemp)
                End If
            End If
        End If
    Set objItem = Nothing
Loop

Function Create_DocFolder(strUser)
Dim objFS, objFolder, strResult
Const strDocuments = "c:\test\"
Set objFS = CreateObject("Scripting.FileSystemObject")
If Not objFS.FolderExists(strDocuments & strUser) Then
    Set objFolder = objFS.GetFolder(strDocuments)
    objFolder.SubFolders.Add strUser
    Set objFolder = Nothing
    strResult = Set_Security(strUser, strDocuments)
    'WScript.Echo strResult
End If
Set objFS = Nothing
End Function

Function Move_DocFolder(strUser)
Dim objFS, objFolder
Const strDocuments = "c:\test\"
Const strBackup = "c:\test"
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(strDocuments & strUser) Then
    Set objFolder = objFS.GetFolder(strDocuments & strUser)
    objFolder.Copy strBackup, True
    objFolder.Delete True
    Set objFolder = Nothing
End If
Set objFS = Nothing
End Function

Function Set_Security(strUser, strPath)
Dim objWMI, objSecSettings, objSD, objItem
Dim objCollection, objSID, objTrustee, objNewACE, objGroup
Dim strComputer, strDomain, strUserSID, strResult
Dim arrACE, intResult
Const strNetDrive = "w:"

Const ACCESS_ALLOWED = 0
Const ACCESS_DENIED = 1
Const SE_DACL_PROTECTED = 4096
Const FLAG_SYNCHRONIZE = 1048576
Const VIEW_FOLDERS_EXECUTE_FILES = 32
Const LIST_FOLDER_READ_DATA = 1
Const READ_ATTRIBUTES = 128
Const READ_ADDITIONAL_ATTRIBUTES = 8
Const CREATE_FILES_WRITE_DATA = 2
Const CREATE_FOLDERS_APPEND_DATA = 4
Const WRITE_ATTRIBUTES = 256
Const WRITE_ADDITIONAL_ATTRIBUTES = 16
Const DEL_SUBFOLDERS_FILES = 64
Const DEL = 65536
Const READ_DAC = 131072
Const WRITE_DAC = 262144
Const WRITE_OWNER = 524288

Set objWSNet = CreateObject("WScript.Network")
strComputer = objWSNet.ComputerName
strDomain = objWSNet.UserDomain
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\CIMV2")
Set objCollection = objWMI.ExecQuery("SELECT SID FROM Win32_Account WHERE Name='" & strUser & "' AND Domain='" & strDomain & "'")
If objCollection.Count > 0 Then
    'начато формирование новой записи для ACL
    For Each objItem In objCollection
        strUserSID = objItem.SID
    Next
    Set objSID = objWMI.Get("Win32_SID.SID='" & strUserSID & "'")
    Set objTrustee = objWMI.Get("Win32_Trustee").Spawninstance_()
    objTrustee.Domain = strDomain
    objTrustee.Name = strUser
    objTrustee.SID = objSID.BinaryRepresentation
    objTrustee.SidLength = objSID.SidLength
    objTrustee.SIDString = strUserSID
    Set objSID = Nothing
    Set objNewACE = objWMI.Get("Win32_Ace").Spawninstance_()
    objNewACE.AceType = ACCESS_ALLOWED
    objNewACE.AccessMask = VIEW_FOLDERS_EXECUTE_FILES + LIST_FOLDER_READ_DATA + READ_ATTRIBUTES + _
            READ_ADDITIONAL_ATTRIBUTES + CREATE_FILES_WRITE_DATA + CREATE_FOLDERS_APPEND_DATA + _
            WRITE_ATTRIBUTES + WRITE_ADDITIONAL_ATTRIBUTES + DEL_SUBFOLDERS_FILES + READ_DAC + FLAG_SYNCHRONIZE
    objNewACE.Trustee = objTrustee
    Set objTrustee = Nothing
    'завершено формирование новой записи для ACL
    objWSNet.MapNetworkDrive strNetDrive, Left(strPath, Len(strPath) - 1)
    'попытка чтения дескриптора безопасности каталога
    Set objSecSettings = objWMI.Get("Win32_LogicalFileSecuritySetting.Path='" & strNetDrive & "\\" & strUser & "'")
    If objSecSettings.GetSecurityDescriptor(objSD) = 0 Then
        arrACE = objSD.DACL 'чтение массива записей ACL
        'начато добавление новой записи в массив ACL
        ReDim Preserve arrACE(UBound(arrACE) + 1)
        Set arrACE(UBound(arrACE)) = objNewACE
        If Not CBool(objSD.ControlFlags And SE_DACL_PROTECTED) Then
            'Отключение наследования
            objSD.ControlFlags = objSD.ControlFlags + SE_DACL_PROTECTED
        End If
        objSD.DACL = arrACE
        Set objNewACE = Nothing
        Erase arrACE
        'завершено добавление новой записи в массив ACL
        'попытка изменения дескриптора безопасности каталога
        intResult = objSecSettings.SetSecurityDescriptor(objSD)
        Select Case intResult
            Case 0: strResult = "Дескриптор безопасности успешно обработан."
            Case 2: strResult = "Отсутствует доступ к необходимой информации."
            Case 9: strResult = "Для выполнения операции нет достаточных прав."
            Case 21: strResult = "Заданы недопустимые значения параметров."
            Case Else: strResult = "Неизвестная ошибка."
        End Select
    Else
        strResult = "Не удалось прочитать дескриптор безопасности объекта " & UCase(strPath) & "."
    End If
    Set objSD = Nothing
    Set objSecSettings = Nothing
    objWSNet.RemoveNetworkDrive strNetDrive, True
    Set objWSNet = Nothing
Else
    strResult = "Не обнаружена учётная запись " & UCase(strUser) & "."
End If
Set objCollection = Nothing
Set objWMI = Nothing
Set_Security = strResult
End Function

Ответить

Ответы Всего ответов: 1

Номер ответа: 1 Автор ответа: alroy Вопросов: 3 Ответов: 28	Профиль \| \| #1	Добавлено: 30.07.09 12:40
	как я полагаю что при вызове процедуры mid - (Mid(strTemp, intPos1, intPos2 - intPos1)) аргументы были ошибочные или неправильные совет поставь msgbox перед mid и посмотри какие попадают аргументы в нее Например так - MsgBox "Это переменнная strTemp: " & strTemp & " " & "Это переменнная intPos1: " & intPos1 & " " &"Это переменнная intPos2: " и посмотри какие туда попадают данные ... надеюсь поможет Ответить

Страница: 1 |