http://dieseyer.de • all rights reserved • © 2011 v11.4
<head>
<!--
'v9.2***************************************************
' File: autologonsetzen.hta
' Autor: dieseyer@gmx.de
' http://dieseyer.de
'
'*******************************************************
WINDOWSTATE="maximize"
BORDER="none"
INNERBORDER="no"
SHOWINTASKBAR="no"
-->
<title>AutoLogon einschalten</title>
<HTA:APPLICATION ID="oHTA"
SCROLL="No"
SHOWINTASKBAR="yes"
NAVIGABLE="no"
APPLICATIONNAME="AutoLogon setzen"
>
<style type="text/css">
<!--
background:#02D020;
background:#1d2160;
background:#1d2160;
-->
<!--
html, body { font-Size:12pt; color:#E0C000; font-family:Verdana; /* font-weight:bold; */
background:#601010;
}
a { font-size:100%; color:#FFFFFF; text-decoration:underline; }
a:active { color:red; }
a:link { color:#FFE000; }
a:visited { color:#E0C000; }
a:hover { color:red; }
a:active { color:#E0C000; }
input, select, textarea
{ color:#1d2160; font-weight:bold; }
-->
</style>
</head>
<script language="VBscript">
Dim WSHNet : Set WSHNet = CreateObject("WScript.Network")
Dim WshShell : Set WSHShell = CreateObject("Wscript.Shell")
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim DriveList : Set DriveList = CreateObject("Scripting.FileSystemObject").Drives
Const Titel = "autologonsetzen.hta"
Dim PCxxx : PCxxx = ""
Dim TastEing
Dim Tst, AbfrageStart
'****************************************
Sub HTASize()
'****************************************
' window.moveto Links, Oben
window.moveto 30, 30 ' Position
' window.resizeto Breite, Höhe ' Größe
' window.resizeto 520, screen.height-23
window.resizeto 640, 480
End Sub
'**************************************************************
Sub StartAnzeige()
'**************************************************************
TastEing = 13
Dim Txt
Txt = Txt & " <Span style=""font-size:14pt""> "
Txt = Txt & " <fieldset><Legend align=""Center""> Für folgenden PC wird das AutoLogon gesetzt: </legend> "
Txt = Txt & " </Span><Span style=""font-size:10pt""> "
Txt = Txt & " <br> <input Type=""text"" Name=""PCxxx"" Value=""" & PCxxx & """ > "
Txt = Txt & " <br><br> "
Txt = Txt & " Primäres DNS-Suffix des Computers: "
Txt = Txt & " <br> <input Type=""text"" Name=""DNS"" Value=""" & "mein.zuhause.de"" > "
Txt = Txt & " <br><br> "
Txt = Txt & " Anmeldename (UserID) für das Autologon: "
Txt = Txt & " <br> <input Type=""text"" Name=""User"" Value=""" & "Users\dieseyer"" > "
Txt = Txt & " <br><br> "
Txt = Txt & " Passwort für den Anmeldenamen: "
Txt = Txt & " <br> <input Type=""Password"" Name=""Pwd"" Value=""SehrGeheim"" > "
Txt = Txt & " <br><br> "
Txt = Txt & " </fieldset></Span> "
Txt = Txt & " <br><br> "
Txt = Txt & " <INPUT TYPE=""button"" accesskey=""s"" onClick=""Eintragen()"" value=""aktivieren"" > oder "
Txt = Txt & " <input TYPE=""button"" accesskey=""r"" onClick=""Entfernen()"" value=""deaktivieren""> "
Txt = Txt & " <br><br> "
document.all.AnzeigeHTA.innerHTML = Txt
End Sub ' StartAnzeige()
'**************************************************************
Sub Entfernen
'**************************************************************
DNS = Document.All.DNS.Value
PCxxx = UCase( Document.All.PCxxx.Value ) & "." & DNS
' MsgBox PCxxx & vbCRLF & User & vbCRLF & Pwd, , "115 :: " & Titel
If not WMIpingOK( PCxxx ) Then
MsgBox """" & PCxxx & """ ist nicht erreichbar", , "118 :: " & Titel
Else
Const HKEY_LOCAL_MACHINE = &H80000002
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PCxxx & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "AutoAdminLogon"
strValue = 0
' MsgBox "strValue-AutoAdminLogon: " & strValue, , "127 :: " & Titel
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "DefaultPassword"
strValue = ""
' MsgBox "strValue-Pwd: " & strValue, , "133 :: " & Titel
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
Set oReg=nothing
MsgBox PCxxx & vbCRLF & vbCRLF & "ist nicht (mehr) auf AutoLogon gesetzt.", , "138 :: " & Titel
End If
End Sub ' Entfernen
'**************************************************************
Sub Eintragen
'**************************************************************
DNS = Document.All.DNS.Value
PCxxx = UCase( Document.All.PCxxx.Value ) & "." & DNS
User = UCase( Document.All.User.Value )
Pwd = Document.All.Pwd.Value
' MsgBox PCxxx & vbCRLF & User & vbCRLF & Pwd, , "152 :: " & Titel
If not WMIpingOK( PCxxx ) Then
MsgBox """" & PCxxx & """ ist nicht erreichbar", , "155 :: " & Titel
Else
Const HKEY_LOCAL_MACHINE = &H80000002
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & PCxxx & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "AutoAdminLogon"
strValue = 1
' MsgBox "strValue-AutoAdminLogon: " & strValue, , "165 :: " & Titel
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "DefaultUserName"
strValue = Mid( User, InStr( User, "\" ) + 1 )
' MsgBox "strValue-User: " & strValue, , "171 :: " & Titel
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "DefaultDomainName"
strValue = Left( User, InStr( User, "\" ) - 1 )
' MsgBox "strValue-DefaultDomainName: " & strValue, , "177 :: " & Titel
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon"
strValueName = "DefaultPassword"
strValue = Pwd
' MsgBox "strValue-Pwd: " & strValue, , "183 :: " & Titel
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
Set oReg=nothing
MsgBox PCxxx & vbCRLF & vbCRLF & "erfolgreich auf AutoLogon gesetzt.", , "188 :: " & Titel
End If
End Sub ' Eintragen
'**************************************************************
Function WMIpingOK( PCName ) ' 6.2 - http://dieseyer.de
'**************************************************************
' Aufruf z.B.: If not WMIpingOK( ZielPC ) Then MsgBox ZielPC & " ist nicht erreichbar." : WScript.Quit
Dim objPing, objStatus
WMIpingOK = True
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & PCName & "'")
For Each objStatus in objPing
If IsNull(objStatus.StatusCode) or objStatus.StatusCode<>0 Then
' WScript.Echo("machine " & machine & " is not reachable")
WMIpingOK = False
End If
Next
End Function ' WMIpingOK( PCName ) ' 6.2 - http://dieseyer.de
'**************************************************************
Function BeimLaden() ' ruft einige Routinen auf
'**************************************************************
call HTASize
' PCxxx = document.parentwindow.clipboardData.GetData("text")
call StartAnzeige()
End Function ' BeimLaden
'**************************************************************
Sub document_onKeyDown
'**************************************************************
If window.event.keyCode = 13 AND TastEing = 13 Then Call Eintragen()
End Sub
'----------------------------------------
</script>
<body onLoad="BeimLaden()" style="background-image:url(winpe.jpg)" >
<form >
<h2 align="center">www.dieseyer.de - autologonsetzen.hta</h2>
<table border="0" cellspacing="20px" width="0100%">
<tr >
<td align="Center" cellspacing="70%" >
<div ID=AnzeigeHTA >
</td>
</tr>
</table>
</form>
</body>
http://dieseyer.de • all rights reserved • © 2011 v11.4