patrick-it
Goto Top

VB GebObject - Cannot create ActiveX component

Hallo zusammen,

ich muss für Windows 10 ein Programm erstellen, das 2 Benutzer erstellt, bei denen das Passwort nie abläuft und nicht gewechselt werden kann. Ausserdem sollen die beiden User in der "Administrators" Gruppe sein. Dazu habe ich ein Visual Basic Programm erstellt, welches bei der Ausführung leider einen Fehler anzeigt.
Module Module1
    Sub SetUserFlag(ByRef objUser As Object, Flag As Integer)
        Dim Flags
        Flags = objUser.Get("UserFlags")  

        objUser.put("Userflags", Flags Or Flag)  
        objUser.setinfo()
    End Sub

    Sub Main()
        Const ADS_UF_DONT_EXPIRE_PASSW As Integer = &H10000
        Const ADS_UF_PASSWD_CANT_CHANGE As Integer = &H40
        Const UserLabT As String = "LabTech"  
        Const UserLabA As String = "Labadmin"  
        Const Group As String = "Administrators"  

        Dim Passwort As String = "blabla" & Year(Now())  

        Dim obUser1 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabT)  
        Dim obUser2 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabA)  

        Dim oDomain As Object = GetObject("WinNT://" & My.Computer.Name)  

        Dim oUser1 As Object = oDomain.Create("user", UserLabT)  
        Dim oUser2 As Object = oDomain.Create("user", UserLabA)  

        Dim oGroup As Object = oDomain.GetObject("Group", Group)  

        oUser1.setInfo()
        oUser1.SetPassword(Passwort)
        oUser1.SetInfo()

        SetUserFlag(obUser1, +ADS_UF_DONT_EXPIRE_PASSW)
        SetUserFlag(obUser1, +ADS_UF_PASSWD_CANT_CHANGE)

        oUser2.setInfo()
        oUser2.setpassword("blabla")  
        oUser2.setInfo()

        SetUserFlag(obUser2, +ADS_UF_DONT_EXPIRE_PASSW)
        SetUserFlag(obUser2, +ADS_UF_PASSWD_CANT_CHANGE)

        oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabT)  
        oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabA)  

    End Sub

End Module

Ich hoffe auf schnelle Hilfe

Gruss Patrick face-smile
capture

Content-Key: 305169

Url: https://administrator.de/contentid/305169

Ausgedruckt am: 28.03.2024 um 12:03 Uhr

Mitglied: SlainteMhath
SlainteMhath 23.05.2016 um 09:10:19 Uhr
Goto Top
Moin,

warum den in VB?
Ich würde dsas entweder mittels
NET USER username "password" /ADD  
NET LOCALGROUP "group" "user" /add  

oder per PowerShell machen.

lg,
Slainte
Mitglied: emeriks
emeriks 23.05.2016 um 09:22:20 Uhr
Goto Top
Hi,
wenn Du in Zeile 24/25 die User erst erstellt, dann kannst Du sie doch nicht schon in Zeile 19/20 beziehen wollen? Kommentier mal 19/20 aus.

E.
Mitglied: Patrick-IT
Patrick-IT 23.05.2016 um 09:42:58 Uhr
Goto Top
Hab den Code jetzt verändert
Module Module1
    Sub SetUserFlag(ByRef objUser As Object, Flag As Integer)
        Dim Flags
        Flags = objUser.Get("UserFlags")  

        objUser.put("Userflags", Flags Or Flag)  
        objUser.setinfo()
    End Sub

    Sub Main()
        Const ADS_UF_DONT_EXPIRE_PASSW As Integer = &H10000
        Const ADS_UF_PASSWD_CANT_CHANGE As Integer = &H40
        Const UserLabT As String = "LabTech"  
        Const UserLabA As String = "Labadmin"  
        Const Group As String = "Administrators"  

        Dim Passwort As String = "blabla" & Year(Now())  

        Dim oDomain As Object = GetObject("WinNT://" & My.Computer.Name)  

        Dim oUser1 As Object = oDomain.Create("user", UserLabT)  
        Dim oUser2 As Object = oDomain.Create("user", UserLabA)  

        Dim obUser1 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabT)  
        Dim obUser2 As Object = GetObject("WinNT://" & My.Computer.Name & "/" & UserLabA)  



        Dim oGroup As Object = oDomain.GetObject("Group", Group)  

        oUser1.setInfo()
        oUser1.SetPassword(Passwort)
        oUser1.SetInfo()

        SetUserFlag(obUser1, +ADS_UF_DONT_EXPIRE_PASSW)
        SetUserFlag(obUser1, +ADS_UF_PASSWD_CANT_CHANGE)

        oUser2.setInfo()
        oUser2.setpassword("blabla")  
        oUser2.setInfo()

        SetUserFlag(obUser2, +ADS_UF_DONT_EXPIRE_PASSW)
        SetUserFlag(obUser2, +ADS_UF_PASSWD_CANT_CHANGE)

        oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabT)  
        oGroup.Add("WinNT://" & My.Computer.Name & "/" & UserLabA)  

    End Sub

End Module
doch leider bekomme ich den Fehler immernoch face-sad
Mitglied: emeriks
emeriks 23.05.2016 um 11:12:41 Uhr
Goto Top
doch leider bekomme ich den Fehler immernoch
Na logisch!
Die User sind erst mit Ausführung der Zeilen 33 bzw. 40 erstellt. Also kannst Du auch erst danach mittels GetObject eine Referenz darauf beziehen.

Mal am Rande: Wozu brauchst Du die Referenzen obUser1 und obUser2 (Zeilen 24/25) überhaupt? Diese werden doch gar nicht weiter verwendet?

Und noch ein Hinweis: Zeile 15 --> Hast Du ein englisches Windows? Falls nein, dann muss das hier "Administratoren" lauten.
Mitglied: 129413
129413 23.05.2016 aktualisiert um 15:17:19 Uhr
Goto Top
Und als Ergänzung: Prüfen ob der User überhaupt schon existiert sollte man natürlich auch, z.B. mit einem TryCatch um das GetObject und dann das Objekt auf "Nothing" prüfen, bevor man überhaupt einen User mit dem Namen erstellt ...

Gruß skybird
Mitglied: emeriks
emeriks 23.05.2016 um 15:26:43 Uhr
Goto Top
Zitat von @129413:

Und als Ergänzung: Prüfen ob der User überhaupt schon existiert sollte man natürlich auch, z.B. mit einem TryCatch um das GetObject und dann das Objekt auf "Nothing" prüfen, bevor man überhaupt einen User mit dem Namen erstellt ...
VBA kann kein Try..Catch. Nicht meines Wissens.
Wenn, dann über "on error resume next".
Mitglied: 129413
129413 23.05.2016 aktualisiert um 15:34:06 Uhr
Goto Top
Hmm ja, sieht für mich aber nach VB.Net Konsolen-Code aus ...

Vor allem die Fehlermeldung in der Konsole:
Microsoft.VisualBasic.Interaction ....

Und dem Module ...

Und sowas, mit Variable deklarieren und Wert direkt zuweisen
Dim Passwort As String = "blabla"
geht in VBA ja auch nicht.

Das hat der TO sicher in die falsche Kategorie gepostet.
Mitglied: SlainteMhath
SlainteMhath 23.05.2016 um 15:33:17 Uhr
Goto Top
VBA kann kein Try..Catch.
Der Code (und die Fehlermeldung) sieht eher nach VB.NET als nach VBA aus face-smile

@Patrick-IT
Geh doch mal mit Step-Trough durch den Code und sag uns, bei welchem GetObject genau der Fehler Auftritt - dann wird's evtl. einfacher .)
Mitglied: emeriks
emeriks 23.05.2016 um 15:41:04 Uhr
Goto Top
Ja, habt recht. Habe mich vom gewählten Themenbereich täuschen lassen ...
Mitglied: 129413
129413 23.05.2016 aktualisiert um 16:50:43 Uhr
Goto Top
mal schnell hingezimmert:
Module Module1
    Sub SetUserFlag(ByRef objUser As Object, Flag As Integer)
        Dim Flags As Object
        Flags = objUser.Get("UserFlags")  
        objUser.put("Userflags", Flags Or Flag)  
    End Sub
    Sub Main()
        Dim oGroup As Object = Nothing, strAdminGroup As String = ""  
        Const ADS_UF_DONT_EXPIRE_PASSW As Integer = &H10000
        Const ADS_UF_PASSWD_CANT_CHANGE As Integer = &H40

        Dim obj As Object = GetObject("winmgmts://./root/cimv2").ExecQuery("Select * From Win32_Group where SID='S-1-5-32-544'")  
        For Each o as Object In obj
            If strAdminGroup = "" Then strAdminGroup = o.Name  
        Next

        Dim users As String() = {"LabTech", "LabAdmin"}  
        Dim Passwort As String = "blabla" & Year(Now())  

        Dim oDomain As Object = GetObject("WinNT://" & My.Computer.Name)  
        Try
            oGroup = oDomain.GetObject("Group", strAdminGroup)  
        Catch ex As Exception
        End Try

        For Each user As String In users
            Dim oUser As Object = Nothing
            Try
                oUser = GetObject("WinNT://" & My.Computer.Name & "/" & user & ",user")  
            Catch ex As Exception
            End Try
            If oUser Is Nothing Then
                oUser = oDomain.Create("user", user)  
                If Not oUser Is Nothing Then
                    oUser.Setinfo()
                    oUser.SetPassword(Passwort)
                    SetUserFlag(oUser, +ADS_UF_DONT_EXPIRE_PASSW)
                    SetUserFlag(oUser, +ADS_UF_PASSWD_CANT_CHANGE)
                    oUser.SetInfo()
                    If Not oGroup Is Nothing Then oGroup.Add("WinNT://" & My.Computer.Name & "/" & user)  
                End If
            End If
        Next
    End Sub
End Module