ISA Server 2006 - PPTP / RRAS Probleme mit Update KB956570

How to disable this update
If you encounter problems after you install this update, you can disable this update.

At the command prompt, type the following command:
cscript KB956570.vbs
Restart the computer that is running ISA Server.

----------------------------------------------------------------------------

Const SE_VPS_GUID = "{143F5698-103B-12D4-FF34-1F34767DEabc}"
Const SE_VPS_NAME = "BindRandomizationCount"
Const SE_VPS_VALUE = 0

Sub SetValue()

' Create the root object.
Dim root ' The FPCLib.FPC root object
Set root = CreateObject("FPC.Root")

'Declare the other objects needed.
Dim array ' An FPCArray object
Dim VendorSets ' An FPCVendorParametersSets collection
Dim VendorSet ' An FPCVendorParametersSet object

' Get references to the array object
' and the network rules collection.
Set array = root.GetContainingArray
Set VendorSets = array.VendorParametersSets

On Error Resume Next
Set VendorSet = VendorSets.Item( SE_VPS_GUID )

If Err.Number <> 0 Then
Err.Clear

' Add the item
Set VendorSet = VendorSets.Add( SE_VPS_GUID )
CheckError
WScript.Echo "New VendorSet added... " & VendorSet.Name

Else
WScript.Echo "Existing VendorSet found... value- " & VendorSet.Value(SE_VPS_NAME)
End If

if VendorSet.Value(SE_VPS_NAME) <> SE_VPS_VALUE Then

Err.Clear
VendorSet.Value(SE_VPS_NAME) = SE_VPS_VALUE

If Err.Number <> 0 Then
CheckError
Else
VendorSets.Save false, true
CheckError

If Err.Number = 0 Then
WScript.Echo "Done with " & SE_VPS_NAME & ", saved!"
End If
End If
Else
WScript.Echo "Done with " & SE_VPS_NAME & ", no change!"
End If

End Sub

Sub CheckError()

If Err.Number <> 0 Then
WScript.Echo "An error occurred: 0x" & Hex(Err.Number) & " " & Err.Description
Err.Clear
End If

End Sub

SetValue

ISA 2006 Backup Script

' based on: http://www.it-training-grote.de/download/isabackup/backup.htm

' Usage: cscript /nologo ISABackup.vbs strBackupShare

' - strBackupShare (String) UNC Path of the Share where the Backup will be stored


' Should the Script send any notification E-Mails
Const blSendMails = true

' The E-Mail Server to use when sending Backup notifications
Const strEmailServer = server.local"

' The E-Mail Address from which the Mails will appear to come from
Const strEmailFromAddr = "postmaster@domain.tld"

' The Recipients od the Backup notifications. Multiple Recipients are to be separated with a semicolon.
Const strEmailRecipients = "info@domain.tld"

Private Sub SendEmail (ByVal strFrom, strRecipient, strSubject, strText, strServer, isUrgent)

Dim objEmail

Set objEmail = CreateObject("CDO.Message")

objEmail.From = strFrom
objEmail.To = strRecipient
objEmail.Subject = strSubject
objEmail.Textbody = strText

If isUrgent Then

With objEmail.Fields

.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High"
.Item("urn:schemas:mailheader:X-Priority") = 2
.Item("urn:schemas:httpmail:importance") = 2
.Update

End With

End If

With objEmail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update

End With

objEmail.Send

End Sub

Function LogConsoleOutput (ByVal strText)

strText = GetTimeString & ": " & strText

objEventLogFile.WriteLine strText

strConsoleOutput = strConsoleOutput & strText & vbCrLf

WScript.echo strText

End Function

Function AppendZeroToTen (byVal Input)

If (Input < 10) Then
AppendZeroToTen = "0" & Input
Else
AppendZeroToTen = Input
End If

End Function

Function GetDateString

Dim dtmCurrentDate, dtmDay, dtmMonth, dtmYear

dtmCurrentDate = date()

dtmDay = DatePart("d", dtmCurrentDate)
dtmMonth = DatePart("m", dtmCurrentDate)
dtmYear = DatePart("yyyy", dtmCurrentDate)

GetDateString = AppendZeroToTen(dtmDay) & "." &_
AppendZeroToTen(dtmMonth) & "." &_
AppendZeroToTen(dtmYear)

End Function

Function GetTimeString

Dim dtmCurrentTime, dtmHour, dtmMinute, dtmSecond

dtmCurrentTime = time()

dtmHour = DatePart("h", dtmCurrentTime)
dtmMinute = DatePart("n", dtmCurrentTime)
dtmSecond = DatePart("s", dtmCurrentTime)

GetTimeString = AppendZeroToTen(dtmHour) & ":" &_
AppendZeroToTen(dtmMinute) & ":" &_
AppendZeroToTen(dtmSecond)

End Function

Function DeleteIfExists (byVal strFile)

if objFSO.FileExists(strFile) Then

objFSO.DeleteFile(strFile)

End If

End Function

Dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objNetWork : set objNetWork = CreateObject("WScript.Network")
Dim strBackupShare : strBackupShare = WScript.Arguments(0)
Dim objXMLDOM : set objXMLDOM = CreateObject("Msxml2.DOMDocument")
Dim objFPC : set objFPC = WScript.CreateObject("fpc.Root")
Dim objISAArray : set objISAArray = objFPC.GetContainingArray
Dim strFileName
Dim blErrorsOccurred : blErrorsOccurred = false
Dim strHostName : strHostName = objNetWork.ComputerName
Dim strEmailSubject : strEmailSubject = strHostName & ": Backup am " & GetDateString & " durchgeführt"
Dim strConsoleOutput


strScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
strEventLogFile = strScriptPath & "logs\" & strHostName & "-D" & Replace(GetDateString,".","") & "-T" & Replace(GetTimeString,":","") & ".txt"

DeleteIfExists (strEventLogFile)
set objEventLogFile = objFSO.CreateTextFile(strEventLogFile, CopyOverwrite)

LogConsoleOutput "Starting Backup"
LogConsoleOutput "Logging to Text File " & strEventLogFile

strFileName = strBackupShare & "\" & strHostName & "-D" & Replace(GetDateString,".","") & "-T" & Replace(GetTimeString,":","") & ".xml"

LogConsoleOutput "Exporting Configuration"

objISAArray.Export objXMLDOM, 0

LogConsoleOutput "Saving exported Configuration to File " & strFileName

objXMLDOM.save(strFileName)

LogConsoleOutput "Backup Finished"

If blSendMails Then

Call SendEmail (strEmailFromAddr, strEmailRecipients, strEmailSubject, strConsoleOutput, strEmailServer, blErrorsOccurred)

End If

objEventLogFile.Close