Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

552 lines
12 KiB

<?XML version="1.0" ?>
<package>
<comment>
HKLM,%WINLOGON%,DefaultDomainName,%REG_SZ%,%BVTDOMAIN% --- ???
HKLM,%WINLOGON%,DefaultUserName,%REG_SZ%,%BVTUSER%
HKLM,%WINLOGON%,DefaultPassword,%REG_SZ%,%BVTPASSWORD%
HKLM,%WINLOGON%,AutoAdminLogon,%REG_SZ%,1
HKLM,%WINLOGON%,ForceAutoLogon,%REG_SZ%,1
HKLM,%WINLOGON%,passwordexpirywarning,%REG_DWORD%,0
passwordexpirywarning ???
</comment>
<job>
<resource id="keys">
DefaultUserName
DefaultPassword
DefaultDomainName
AutoAdminLogon
ForceAutoLogon
</resource>
<resource id="domainname">ntdev</resource>
<resource id="domainuser">winbld</resource>
<resource id="regpath">HKLM\SOFTWARE\Microsoft\WINDOWS NT\CurrentVersion\Winlogon</resource>
<resource id="Usage">
Name:
%SELF%
Manipulating the REGISTRY providing automatic logon
Usage:
%SELF% -h -d -u:%USER% -p:%PASS% -y:%DOMAIN% -a:%AUTO% -c
Where
-h show this message
-d enable debugging
-y domain. Default is %DOMAINNAME%
-u username. Default is "%DOMAINUSER%"
-p password. No default
-a Set AutoAdminLogon Feature. Only executed if explicitly set
-c Clean the keys known to %SELF%. Default keys are: %KEYS%
</resource>
<script language="VBScript">
<![CDATA[
Function ReadResource(sPresId)
On Error resume next
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Dim sPRes, asRes, uRes, tsRes
sPREs = GetResource(sPresId)
If Err.number <> 0 Then
Wscript.echo err.number & " " & err.description
' The Error description are not informative when failed getresource
IF Err.number = 7 Then
Wscript.echo chr(9) & "Null resource: " & _
sPresId
End If
IF Err.number = 5 Then
Wscript.echo chr(9) & "Undefined resource: " & _
sPresId
End If
Wscript.quit
End If
asRes = Split(WshShell.ExpandEnvironmentStrings(sPRes), VBNEWLINE)
Set ures = CreateObject("Scripting.Dictionary")
For Each tsRes in asRes
If 0 <> Len(tsRes) Then
uRes(tsRes) = 1
End If
Next
Dim tResource
tResource = uRes.Keys
If uBound(tResource) = 0 Then
ReadResource = tResource(0)
Else
ReadResource = tResource
End If
Set WshShell = Nothing
Set uRes = Nothing
End Function
]]>
</script>
<script language="VBScript">
<![CDATA[
sub showUsage
Const VBEXPECTED = 5
on error resume next
Dim oGenRplaceVarNamXp
Dim oExRplaceVarNamXp
Dim aoRplaceMatches, oMatch, sMatch, sLabel, sResource
Set oGenRplaceVarNamXp = new RegExp
Set oExRplaceVarNamXp = new RegExp
With oGenRplaceVarNamXp
.Global = True
.IgnoreCase = True
.Pattern = "%\w+%"
End With
With oExRplaceVarNamXp
.Global = True
.IgnoreCase = True
.Pattern = "%\w+%"
End With
Dim sLine,asTest
asTest = ReadResource("Usage")
For Each sLine in asTest
sLine = Replace(sLine, "%SELF%", WScript.ScriptName,1,10)
Set aoRplaceMatches = oGenRplaceVarNamXp.Execute(sLine)
For Each oMatch in aoRplaceMatches
sMatch = oMatch.value
sMatch = UCase(Mid(sMatch, 2, Len(sMatch)-2))
sLabel = LCase(sMatch)
Err.clear
sResource = GetResource(sLabel)
If err = 0 Then
sMatch = sResource
ElseIf err = VBEXPECTED Then
sMatch = "<" & sMatch & ">"
Else
Raise Err
End If
oExRplaceVarNamXp.Pattern = oMatch.value
sLine = oExRplaceVarNamXp.Replace(sLine, sMatch)
Next
WScript.echo sLine
Next
WScript.Quit(0)
End sub
]]>
</script>
<script language="VBScript">
<![CDATA[
option explicit
Public Function reQuoteObjArgs(objArgs)
Dim sLabelVar, sFoundLabel, sArgsDictionary, sArg, oArgs, nArg
Dim poQuotedCheckRegEx, poStringCheckRegEx, psQuotedCheckPt
Dim sConcatArgs, aRepArgs, spBadQuotedPart, spGoodQuotedPart, apQuoted
sConcatArgs = join(objArgs, " ")
psQuotedCheckPt = "\'[^\']+\'"
Set poQuotedCheckRegEx = New RegExp
With poQuotedCheckRegEx
.Global = True
.IgnoreCase = True
.Pattern = psQuotedCheckPt
End with
Set poStringCheckRegEx = New RegExp
With poQuotedCheckRegEx
.Global = True
.IgnoreCase = True
.Pattern = psQuotedCheckPt
End with
If True = poQuotedCheckRegEx.Test(sConcatArgs) Then
Set apQuoted = poQuotedCheckRegEx.Execute(sConcatArgs)
For each spBadQuotedPart in apQuoted
spGoodQuotedPart = Replace(spBadQuotedPart," ", "0x20", 1, 1000)
spGoodQuotedPart = Mid(spGoodQuotedPart,2, Len(spGoodQuotedPart) -2 )
poStringCheckRegEx.Pattern = Replace(spBadQuotedPart, "\", "\\", 1 ,100)
sConcatArgs = poStringCheckRegEx.Replace(sConcatArgs, spGoodQuotedPart)
Next
aRepArgs = Split(sConcatArgs, " ")
oArgs = Array()
Redim oArgs (ubound(aRepArgs) + 1)
For nArg = 0 To ubound(aRepArgs)
oArgs(nArg) = Replace(aRepArgs(nArg), "0x20", " ", 1, 100)
Next
reQuoteObjArgs = oArgs
Else
reQuoteObjArgs = objArgs
End If
End Function
Public Sub GetParams(sFlags, sVarNames, objArgs)
Dim sLabelVar, sFoundLabel, sArgsDictionary
Dim poKnownSwitchRegEx, psMaskKnownSwitch, nArg, mma, nma, nextlen, objargsnamed
Dim aFlags, aVarNames ' Arrays to split the sFlags and sVarNames
Set poKnownSwitchRegEx = New RegExp
Set sArgsDictionary = CreateObject("Scripting.Dictionary")
psMaskKnownSwitch = "[-/]\w+:?\b"
poKnownSwitchRegEx.Global = True
poKnownSwitchRegEx.IgnoreCase = True
poKnownSwitchRegEx.Pattern = psMaskKnownSwitch
If 0 = ubound(objArgs) Then
Exit Sub
End If
For nArg = 0 to uBound(objArgs)
If True = poKnownSwitchRegEx.Test(objArgs(nArg)) Then
Set mmA = poKnownSwitchRegEx.Execute(objArgs(nArg))
If mma.Count <> 1 Then
WScript.echo "Bad RegExp Count"
Err.Raise (1937)
Else
For each nma in mma
NextLen = nma.FirstIndex + nma.Length
sFoundLabel = CStr(Mid(objArgs(nArg), _
2 + nma.FirstIndex, _
nma.Length - 1))
' This is not If Right(sFoundLabel,1) = ":" Then
' required sFoundLabel = Left(sFoundLabel, len(sFoundLabel) - 1 )
' End If
If NextLen <> len(objArgs(nArg)) Then
sLabelVar = CStr(Mid(objArgs(nArg),NextLen + 1 ))
Else
sLabelVar = CInt(True)
End If
sArgsDictionary.add sFoundLabel, sLabelVar
Next
End If
End If
Next
aFlags = split(sFlags)
aVarNames = split(sVarNames)
If Ubound(aFlags) <> Ubound(aVarNames) Then
Exit Sub
End If
Dim tnCnt
For tnCnt = 0 to Ubound(aFlags)
If sArgsDictionary.Exists(aFlags(tnCnt)) Then
FeedVar sArgsDictionary(aFlags(tnCnt)), aVarNames(tnCnt)
End If
Next
Set sArgsDictionary = Nothing
Set poKnownSwitchRegEx = Nothing
End Sub
Private Sub FeedVar(sLabelVar, sLabel)
If VarType(sLabelVar) <> vbString Then
If VarType(sLabelVar) = VBBoolean Then
Execute(sLabel & "= CBool(" & sLabelVar & ")")
Else
Execute(sLabel & "=" & sLabelVar)
End If
Else
Execute(sLabel & "=" & """" & sLabelVar & """" )
End If
End Sub
]]>
</script>
<script language="VBScript">
<![CDATA[
Public Function sURLDecoded (sTestPassInputv)
Dim oHexBackDict, sOutPut
Set oHexBackDict = CreateObject("Scripting.Dictionary")
For nCnt = 32 To 64
sOutPut = "%" & Hex(nCnt)
oHexBackDict.Add sOutPut, Chr(nCnt)
Next
''For Each sOutPut in oHexBackDict.Keys
''
'' WScript.echo sOutPut & " -> " & oHexBackDict(sOutPut)
''
''Next
For Each sOutPut in oHexBackDict.Keys
sTestPassInputv = Replace(sTestPassInputv, sOutPut, oHexBackDict(sOutPut), 1, 1000)
Next
sURLDecoded = sTestPassInputv
End Function
]]>
</script>
<script language="VBScript">
<![CDATA[
option explicit
Dim opShell
Dim sRegPathDir, oKeyList, aKeys, nCnt, sKey
Dim spDomainUser, spDomainName
Dim Help, Debug, siDomainUser, siDomainName, siPassword, sBClean
Dim apCopyArgs, nRawArg
Dim sTestPassInputv
''sTestPassInputv="v%21%202lar%40e"
''WScript.echo sURLDecoded(sTestPassInputv)
''WScript.quit
sRegPathDir = CStr(GetResource("regpath"))
aKeys = ReadResource("keys")
Set opShell = WScript.CreateObject("WScript.Shell")
apCopyArgs = Array()
Redim apCopyArgs (Wscript.arguments.Count)
For nRawArg = 0 to Wscript.arguments.Count - 1
apCopyArgs(nRawArg) = Wscript.arguments(nRawArg)
Next
apCopyArgs = reQuoteObjArgs(apCopyArgs)
Call GetParams("h d u: y: p: c", _
"Help Debug siDomainUser siDomainName siPassword sbClean", _
apCopyArgs)
if Help <> "" Then
ShowUsage
End If
Set oKeyList = CreateObject("Scripting.Dictionary")
For nCnt = 0 to UBound(aKeys)
oKeyList.add aKeys(nCnt), ""
'' create keys but leave them undefined
Next
If "" <> siDomainUser Then
oKeyList("DefaultUserName") = siDomainUser
End If
If "" <> siDomainName Then
oKeyList("DefaultDomainName") = siDomainName
End If
If "" <> siPassword Then
oKeyList("DefaultPassword") = sURLDecoded(siPassword)
oKeyList("AutoAdminLogon") = "1"
oKeyList("ForceAutoLogon") = "1"
End If
If True = sbClean Then
oKeyList("ForceAutoLogon") = "0"
oKeyList("AutoAdminLogon") = "0"
For Each sKey in oKeyList.Keys
If Debug Then
WScript.echo sKey & "=" & oKeyList(sKey)
End If
Next
End If
If True = sbClean Then
For Each sKey in oKeyList.Keys
on error resume next
err.clear
If "" = oKeyList(sKey) Then
opShell.RegWrite sRegPathDir & "\" & sKey, oKeyList(sKey) ,"REG_SZ"
opShell.RegDelete sRegPathDir & "\" & sKey
If Debug Then
WScript.Echo sRegPathDir & "\" & sKey & " deleted"
End If
Else
opShell.RegWrite sRegPathDir & "\" & sKey, oKeyList(sKey) ,"REG_SZ"
If Debug Then
WScript.Echo opShell.RegRead(sRegPathDir & "\" & sKey)
End If
End If
Next
Else
For Each sKey in oKeyList.Keys
If "" <> oKeyList(sKey) Then
If Debug Then
WScript.echo "Set " & sKey & " = " & oKeyList(sKey)
End If
opShell.RegWrite sRegPathDir & "\" & sKey, oKeyList(sKey) ,"REG_SZ"
WScript.Echo sKey & "=" & opShell.RegRead(sRegPathDir & "\" & sKey)
End If
Next
opShell.RegWrite sRegPathDir & "\" & "passwordexpirywarning", 0, "REG_DWORD"
If Debug Then
WScript.Echo "passwordexpirywarning=" & _
opShell.RegRead(sRegPathDir & "\" & "passwordexpirywarning")
End If
End If
Set opShell = nothing
WScript.quit(0)
]]>
</script>
</job>
</package>