импорт&экспрорт элементов политики

[araven Профиль]

поставил ISA 2000 хотел бы перенести настройки ограничения по посещаемым сайтам (порно любимое) и прочих настроек с работоющего ISA сервера. Как это сделать менее трудоемким путем или прийдется все вручную?

[Harry33 Профиль СайтICQ]

araven
В каком режиме работает ISA?

[araven Профиль]

Firewall + Proxy + cash

[Harry33 Профиль СайтICQ]

Вот тебе vbs

'////////////////////////////////////////////////////////////////////////////
'
' ISA Server Ad blocking import / export script
'
' Author: Jim Harrison
'
' Contact: jim@jalojash.org
' www.jalojash.org/isascripts
'
' Created: 4/15/02
'
' Purpose: Creates a destination set and a site & content rule to block advertisements in
' web pages
'
' Usage: Either dbl-click it from Windows explorer or as "cscript ISA_Ads.vbs" from a
' command line
'
' History: 4/15/02 - First working version
' 4/20/02 - Fixed bug in SCR creation that would cause "conf can't be read"
' event log errors
'
' ToDo: Lots - see each section for small details
' Make it Enterprise-policy aware
' Make it merge-smart
'
'////////////////////////////////////////////////////////////////////////////

'so we don't lie to ourselves about our variables
Option Explicit

'global class for general use
Dim Tools

'Let's do this
Set Tools = New ISATools
Main

'Let's undo this
Set Tools = Nothing


'////////////////////////////////////////////////////////////////////////////
'
' Sub Main
'
' Purpose: Handles the inital ISA and XML object creation and chains off to other routines
' depending on the options chosen
'
' Input: None
'
' Output: XMLDocument and ISA objects for other routines
'
' ToDo: nothing?
'
'////////////////////////////////////////////////////////////////////////////

Sub Main

'ISA variables
Dim FPC
Dim ISA

'XML variables
Dim XMLDoc

'Create the ISA Server admin object
Set FPC = CreateObject ( "FPC.Root" )
FPC.Refresh
Set ISA = FPC.Arrays.GetContainingArray

'create the XML document object
Set XMLDoc = CreateObject ( "Microsoft.XMLDom" )
XMLDoc.Async = False

'Let's get someone to make a decision
Select Case ImpExp
Case "import": Import XMLDoc, ISA
Case "export": Export XMLDoc, ISA
End Select

End Sub


'////////////////////////////////////////////////////////////////////////////
'
' Function ImpExp
'
' Purpose: Prompts the user for their choice of "Import" or "Export" and handles
' incorrect input
'
' Input: from the user via Tools class input routine
'
' Output: returns one of two valid options to caller
'
' ToDo: nothing?
'
'////////////////////////////////////////////////////////////////////////////

Function ImpExp ( )

Dim Answer
Answer = LCase ( Tools.GetAns ( Tools.ImpExp, "Import" ) )
Select Case Answer
Case "import", "export": ImpExp = Answer
Case Else:
Tools.ShowErr ( Tools.OptsErr )
ImpExp
End Select

End Function


'////////////////////////////////////////////////////////////////////////////
'
' Sub Import
'
' Purpose: Reads the input file and creates the destination set based on the data found
' there
'
' Input: XMLDoc and ISA objects from sub Main
' from the user via Tools class input routine
' from the xml file
'
' Output: creates a destination set in ISA with data from source XML
'
' ToDo: add capability to read CSV, TSV as well as XML
'
'////////////////////////////////////////////////////////////////////////////

Sub Import ( XMLDoc, ISA )

On Error Resume Next

Dim Ads
Dim DestinationSet
Dim Destination
Dim OldDest
Dim DType
Dim Ans
Dim InVal1
Dim InVal2
Dim InVal3
Const DestExist = &h80070002
Const Domain = 0
Const SingleIP = 1
Const IPRange = 2

Ans = Tools.GetAns ( Tools.SrcFileMsg, Tools.FileIn )
If Tools.FindFile ( Ans ) Then
Tools.FileIn = Ans
XMLDoc.Load ( Tools.FileIn )
Else
Tools.ShowErr ( Tools.FNFMsg )
Import XMLDoc, ISA
End If

Set Ads = XMLDoc.SelectSingleNode ( "Ads" )

'try to create the DS, and ask] for merge if fails
Set DestinationSet = MakeDs ( ISA )

'came back to do it; let's see what there is to do
For Each Destination in Ads.SelectNodes ( "Destination" )

DType = CInt ( Destination.GetAttribute ( "Type" ) )

Select Case DType
Case Domain
InVal1 = Destination.GetAttribute ( "DomainName" )
InVal2 = ""
Case SingleIP
InVal1 = Destination.GetAttribute ( "IP_From" )
InVal2 = ""
Case IPRange
InVal1 = Destination.GetAttribute ( "IP_From" )
InVal2 = Destination.GetAttribute ( "IP_To" )
End Select

InVal3 = Destination.GetAttribute ( "Path" )
DestinationSet.Add InVal1, InVal2, InVal3

Err.Clear

Next

DestinationSet.Save

MakeScr ISA

Tools.Showinfo "Done with the Import thingy.."

End Sub


'////////////////////////////////////////////////////////////////////////////
'
' Function MakeDs
'
' Purpose: creates a destination set named according to user input
'
' Input: ISA object from Sub Import
' from the user via Tools class input routine
'
' Output: returns a destination set object to sub Import
'
' ToDo: Ds Merge support
'
'////////////////////////////////////////////////////////////////////////////

Function MakeDs ( ISA )

On Error Resume Next
Dim Rtn
Dim Ans
Const DupDs = &h800700b7

Err.Clear
Rtn = Tools.GetAns ( Tools.DsQuery, Tools.DsName )

Set MakeDs = ISA.PolicyElements.DestinationSets.Add ( Rtn )
Select Case Err.Number
Case 0
Tools.DsName = Rtn
MakeDs.Description = Tools.DsDescr
Exit Function
Case DupDs
If Not Tools.AskYN ( Tools.DsDup ) Then
If Not Tools.AskYN ( Tools.QuitMsg ) Then Set MakeDs = MakeDs ( ISA )
End If
Err.Clear
Case Else
If Not Tools.AskYN ( Tools.DsErr ) Then WScript.Quit
End Select

Set MakeDs = MakeDs ( ISA )

Err.Clear

End Function


'////////////////////////////////////////////////////////////////////////////
'
' Function MakeScr
'
' Purpose: creates a Site and Content Rule associated with the chosen destination set
'
' Input: XMLDoc and ISA objects from Import subroutine
' from the user via Tools class input routine
'
' Output: creates a new S&C rule
'
' ToDo: option to change data in existing S&C Rule
' ability to import this as well
'
'////////////////////////////////////////////////////////////////////////////

Function MakeScr ( ISA )

On Error Resume Next
Dim Rtn
Dim TempScr
Const DupScr = &h800700b7
Const fpcArrayScope = 0
Const fpcEnterpriseScope = 1

Err.Clear
Rtn = Tools.GetAns ( Tools.ScrQuery, Tools.ScrName )

Set MakeScr = ISA.ArrayPolicy.SiteAndContentRules.Add ( Rtn )
' Wscript.Echo "MakeScr ( " & Rtn & " ) = 0x" & Hex ( Err.Number )
Select Case Err.Number
Case 0
Tools.ScrName = Rtn
Case Else
If Not Tools.AskYN ( Tools.ScrDup ) Then
WScript.Quit
Else
Set MakeScr = MakeScr ( ISA )
End If
End Select

MakeScr.Description = Tools.ScrDescr
MakeScr.Enabled = "True"
MakeScr.Action = "1"
MakeScr.AppliesToContentMethod = "0"
MakeScr.SetDestination "3", Tools.DsName
MakeScr.SetSchedule ( "Always" ), fpcArrayScope
MakeScr.AppliesToMethod = "0"
MakeScr.Save

End Function


'////////////////////////////////////////////////////////////////////////////
'
' Sub Export
'
' Purpose: Creates an xml file containing the data in the chosen destination set
'
' Input: from the user via Tools class input routines
' properties of the specified destination set
'
' Output: creates an xml file according to user input
'
' ToDo: option to merge data in existing XML, CSV, TSV file
'
'////////////////////////////////////////////////////////////////////////////

Sub Export ( XMLDoc, ISA )

Dim Ads
Dim DestinationSet
Dim Destination
Dim Dest
Dim DType
Dim NewDest
Dim Rtn

'Destination set info
Const Domain = 0
Const SingleIP = 1
Const IPRange = 2

AskDestFile

Set DestinationSet = GetDs ( ISA )

XMLDoc.LoadXML ( "<Ads/>" )
Set Ads = XMLDoc.SelectSingleNode ( "Ads" )
Ads.AppendChild ( XMLDoc.CreateComment ( Tools.XMLComm ) )
For Each Destination in DestinationSet
Set Dest = XMLDoc.CreateNode ( 1, "Destination", "" )
Set NewDest = Ads.AppendChild ( Dest )
DType = Destination.Type
NewDest.SetAttribute "Type", DType
Select Case DType
Case Domain
NewDest.SetAttribute "DomainName", Destination.DomainName
Case SingleIP
NewDest.SetAttribute "IP_From", Destination.IP_From
Case IPRange
NewDest.SetAttribute "IP_From", Destination.IP_From
NewDest.SetAttribute "IP_To", Destination.IP_To
End Select
NewDest.SetAttribute "Path", Destination.Path
Next

XMLDoc.Save Tools.FileOut

Tools.Showinfo "Done with the Export thingy.." & vbCrLf & "Saved it as: " & Tools.FileOut

End Sub


'////////////////////////////////////////////////////////////////////////////
'
' Function AskDestFile
'
' Purpose: Prompts the user for a place to save the output file
' Verifies the existence of the file
'
' Input: from the user via Tools class input routines
'
' Output: returns a verified file location
'
' ToDo: error checking and file merge support
'
'////////////////////////////////////////////////////////////////////////////

Function AskDestFile

Dim Rtn

'find out where to save the exported data
AskDestFile = Tools.GetAns ( Tools.DestFileMsg, Tools.FileOut )
If Tools.FindFile ( AskDestFile ) Then
Tools.ShowErr ( Tools.FileExistsMsg )
AskDestFile
Else
Tools.FileOut = AskDestFile
End If

End Function


'////////////////////////////////////////////////////////////////////////////
'
' Function GetDs
'
' Purpose: Prompts the user for the Destination Set of choice
'
' Input: ISA object from Export function
' from the user via Tools class input routines
' verifies the specified destination set
'
' Output: returns a DestinationSet object
'
' ToDo: error checking
'
'////////////////////////////////////////////////////////////////////////////

Function GetDs ( ISA )

On Error Resume Next
Dim Rtn
'find out what Ds to export
Rtn = Tools.GetAns ( Tools.DsQuery, Tools.DsName )
Set GetDs = ISA.PolicyElements.DestinationSets.Item ( Rtn )
If Err Then
Tools.ShowErr ( Tools.DsErrMsg )
Set GetDs = GetDs ( ISA )
End If
On Error Goto 0

End Function


'////////////////////////////////////////////////////////////////////////////
'
' Class ISATools
'
' Purpose: the heart and soul of this beastie
' contains all the common methods and properties needed by various subs
' and functions
'
' Input: from subs and functions
'
' Output: returns properties and method results to calling routines
'
' ToDo: depends on functionality added to main Script
'
'////////////////////////////////////////////////////////////////////////////

Class ISATools

'Script-specific text
Private Version
Private ScriptTitle

'general mesages
Private ImpExpMsg
Private OptsErrMsg
Private QuitMsg

'File option Msgs
Private CurrPath
Private OutFileMsg1
Private OutFileMsg2
Private InFileMsg
Private FileNotFound

'file option variables
Private OutFile
Private InFile

'destination set information
Private DsQueryMsg
Private DsDupMsg
Private DsErrMsg
Private Ds_Name
Private Ds_Descr
Private NoDsMsg

'Site & Content Rule info
Private ScrQueryMsg
Private ScrDupMsg
Private ScrErrMsg
Private Scr_Name
Private Scr_Descr
Private NoScrMsg

'Export XML data
Private XMLComment

'Some useful objects
Private WshShell
Private FSO

'////////////////////////////////////////////////////////////////////////////
'
' Sub Class_Initialize
'
' Purpose: defines the default state for class properties
'
' Input: called by the "set Tools = New ISATools" command
'
' Output: Err.Success or Err.Failure to caller ( intrinsic )
'
' ToDo: depends on changes in class
'
'////////////////////////////////////////////////////////////////////////////

Private Sub Class_Initialize ( )
'Create those useful objects
Set WshShell = CreateObject ( "WScript.Shell" )
Set FSO = CreateObject ( "Scripting.FileSystemObject" )

'Script-specific text
Version = "1.0"
ScriptTitle = "ISA Server Ad import / export tool ver. " & Version

'General mesages
ImpExpMsg = "Do you want to Import or Export ad filter settings?"
OptsErrMsg = "Sorry; that's not a valid option"
QuitMsg = "Do you want to quit?"

'Export XML data
XMLComment = "You can hand edit this file, but please do not change the format" & _
vbCrLf & "as the script depends on the present schema." & _
vbCrLf & vbCrLf & "This is a list of ad sites that I've compiled over time." & _
vbCrLf & "Feel free to add to it as you please." & _
vbCrLf & "So that we can keep things current, please email your additions back to" & _
vbCrLf & "jim@jalojash.org for posting to my scripting site." & _
vbCrLf & vbCrLf & "If you want to hand-edit this, feel free to grab XMLNotepad from" &_
vbCrLf & "http://msdn.microsoft.com/library/en-us/dnxml/html/xpsetup.exe"

'File variable defaults
CurrPath = Left ( WScript.ScriptFullName, Len ( WScript.ScriptFullName )-Len ( WScript.ScriptName ) )
OutFile = CurrPath & "ISA_Ads.xml"
InFile = OutFile

'File option Msgs
OutFileMsg1 = "Where do you want to put the export file?"
OutFileMsg2 = "That file already exists; please choose another file name or path"
InFileMsg = "Where is the source file?"
FileNotFound = "I can't locate that file; please check the path and re-enter"

'Ds messages
DsDupMsg = "That Destination Set already exists; would you like to create a new one?"
DsErrMsg = "Error 0x" & Hex ( Err.Number ) & " was encountered while trying to create the DS." & _
vbCrLf & "Would you like to try again?"
DsQuerymsg = "What Destination Set would you like to use?"
NoDsMsg = "The specified Destination Set was not found; please check your entry."
Ds_Name = "NoAds"
Ds_Descr = "Ad Blocking Destination Set"

'Scr messages
ScrDupMsg = "That Site & content Rule already exists; would you like to create another?"
ScrErrMsg = "Error 0x" & Hex ( Err.Number ) & " was encountered while trying to create the SCR." & _
vbCrLf & "Would you like to try again?"
ScrQuerymsg = "What would you like to name the new Site & Content Rule?"
NoScrMsg = "The specified Site & Content Rule was not found; please check your entry."
Scr_Name = Ds_Name
Scr_Descr = "Ad Blocking Site & Content Rule"
End Sub


'////////////////////////////////////////////////////////////////////////////
'
' Sub Class_Terminate
'
' Purpose: destroys the class and its data
'
' Input: called by the "set Tools = Nothing" command
'
' Output: Err.Success or Err.Failure to caller ( intrinsic )
'
' ToDo: depends on changes in class
'
'////////////////////////////////////////////////////////////////////////////

Private Sub Class_Terminate ( )
Set WshShell = Nothing
Set FSO = Nothing
End Sub


'////////////////////////////////////////////////////////////////////////////
'
' Class properties
'
' Purpose: provide access to global data via class
'
' Input: only for "property Let" actions
'
' Output: only for "property Get" actions
'
' ToDo: depends on changes in class
'
'////////////////////////////////////////////////////////////////////////////

'Returns text held in ImpExpMsg variable
Public Property Get ImpExp
ImpExp = ImpExpMsg
End Property

'Returns text held in OutFile variable
Public Property Get FileOut
FileOut = OutFile
End Property

'Modifies text held in OutFile variable
Public Property Let FileOut ( InVal )
OutFile = InVal
End Property

'Returns text held in InFile variable
Public Property Get FileIn
FileIn = InFile
End property

'Modifies text held in InFile variable
Public Property Let FileIn ( InVal )
InFile = InVal
End Property

'Returns text held in OutFileMsg1 variable
Public Property Get DestFileMsg
DestFileMsg = OutFileMsg1
End Property

'Returns text held in OutFileMsg2 variable
Public Property Get FileExistsMsg
FileExistsMsg = OutFileMsg2
End Property

'Returns text held in InFileMsg variable
Public Property Get SrcFileMsg
SrcFileMsg = InFileMsg
End property

'Returns text held in FilenotFound variable
Public Property Get FNFMsg
FNFMsg = FileNotFound
End Property

'Returns text held in OptsErrMsg variable
Public Property Get OptsErr
OptsErr = OptsErrMsg
End Property

'Returns text held in DsQueryMsg variable
Public Property Get DsQuery
DsQuery = DsQueryMsg
End property

'Returns text held in NoDsmsg variable
Public Property Get DsNFMsg
DsNFMsg = NoDsMsg
End property

'Returns text held in DsDupMsg variable
Public Property Get DsDup
DsDup = DsDupMsg
End Property

'Returns text held in DsErrMsg variable
Public Property Get DsErr
DsErr = DsErrMsg
End Property

'Returns text held in Ds_Name variable
Public Property Get DsName
DsName = Ds_Name
End Property

'Modifies text held in Ds_Name variable
Public Property Let DsName ( InVal )
Ds_Name = InVal
End Property

'Returns text held in Ds_Descr variable
Public Property Get DsDescr
DsDescr = Ds_Descr
End property

'Returns text held in SrcQueryMsg variable
Public Property Get ScrQuery
ScrQuery = ScrQueryMsg
End property

'Returns text held in ScrDupMsg variable
Public Property Get ScrDup
ScrDup = ScrDupMsg
End Property

'Returns text held in ScrErrMsg variable
Public Property Get ScrErr
ScrErr = ScrErrMsg
End Property

'Returns text held in Scr_Name variable
Public Property Get ScrName
ScrName = Scr_Name
End Property

'Modifies text held in Scr_Name variable
Public Property Let ScrName ( InVal )
Scr_Name = InVal
End Property

'Returns text held in Scr_Descr variable
Public Property Get ScrDescr
ScrDescr = Scr_Descr
End property

'Returns text held in XMLComment variable
Public Property Get XMLComm
XMLComm = XMLComment
End property

'////////////////////////////////////////////////////////////////////////////
'
' Class Methods
'
' Purpose: provide common actions via the class
'
' Input: only as required by each function
'
' Output: depends on the function
'
' ToDo: depends on changes in class
'
'////////////////////////////////////////////////////////////////////////////

'Returns status of file existence ( True/False )
Public Function FindFile ( InVal )
On Error Resume Next
FindFile = FSO.GetFile ( InVal )
If Err Then
FindFile = False
Else
FindFile = True
End If
On Error Goto 0
End Function

'Returns status of user action when prompted with informational "Msg"
Public Function ShowInfo ( Msg )
ShowInfo = WshShell.Popup ( Msg, 2, ScriptTitle, vbInformation + vbOk )
End Function

'Returns status of user action when prompted with Error "Msg"
Public Function ShowErr ( Msg )
ShowErr = WshShell.Popup ( Msg, 2, ScriptTitle, vbExclamation + vbOk )
End Function

'Returns user input when prompted with "Msg" and provided with "Default" answer
Public Function GetAns ( Msg, Default )
Dim Answer
Answer = InputBox ( Msg, ScriptTitle, Default )
If Answer = "" Then
If AskYN ( QuitMsg ) Then WScript.Quit
GetAns Msg, Default
Else
GetAns = Answer
End If
End Function

'Returns status of user action ( Yes=True, No=False ) when prompted with "Msg"
Public Function AskYN ( Msg )
Select Case WshShell.Popup ( Msg, , ScriptTitle, vbQuestion + vbYesNo )
Case vbYes: AskYN = TRUE
Case vbNo: AskYN = FALSE
Case Else: AskYN = AskYN ( Msg )
End Select
End Function

End Class