O Import de blacklist no ISA Server 2006 pode ser “automatizado” desde que montado com os scripts corretos e com o download de uma blacklist confiavel.

Abaixo o procedimento:
(Pacote montado pode ser solicitado para envio por e-mail)

1 – Criando a bat de importaçao
No ISA Server 2006, Criar em c:\Blacklist um arquivo .bat e edita-lo conforme abaixo (nome sugerido: Execute-Import-In-Isa-2006.bat):

.\ISA_Fill_Domain_Name_Set.vbs ADV .\BL\adv\domains
.\ISA_Fill_URL_Set.vbs ADV .\BL\adv\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs aggressive .\BL\aggressive\domains
.\ISA_Fill_URL_Set.vbs aggressive .\BL\aggressive\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs alcohol .\BL\alcohol\domains
.\ISA_Fill_URL_Set.vbs alcohol .\BL\alcohol\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs anonvpn .\BL\anonvpn\domains
.\ISA_Fill_URL_Set.vbs anonvpn .\BL\anonvpn\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs automobile .\BL\automobile\domains
.\ISA_Fill_URL_Set.vbs automobile .\BL\automobile\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs chat .\BL\chat\domains
.\ISA_Fill_URL_Set.vbs chat .\BL\chat\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs costtraps .\BL\costtraps\domains
.\ISA_Fill_URL_Set.vbs costtraps .\BL\costtraps\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs dating .\BL\dating\domains
.\ISA_Fill_URL_Set.vbs dating .\BL\dating\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs downloads .\BL\downloads\domains
.\ISA_Fill_URL_Set.vbs downloads .\BL\downloads\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs drugs .\BL\drugs\domains
.\ISA_Fill_URL_Set.vbs drugs .\BL\drugs\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs dynamic .\BL\dynamic\domainsr
.\ISA_Fill_URL_Set.vbs dynamic .\BL\dynamic\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs education .\BL\education\domains
.\ISA_Fill_URL_Set.vbs education .\BL\education\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs finance .\BL\finance\domains
.\ISA_Fill_URL_Set.vbs finance .\BL\finance\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs fortunetelling .\BL\fortunetelling\domains
.\ISA_Fill_URL_Set.vbs fortunetelling .\BL\fortunetelling\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs forum .\BL\forum\domains
.\ISA_Fill_URL_Set.vbs forum .\BL\forum\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs gamble .\BL\gamble\domains
.\ISA_Fill_URL_Set.vbs gamble .\BL\gamble\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs government .\BL\government\domains
.\ISA_Fill_URL_Set.vbs government .\BL\government\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs hacking .\BL\hacking\domains
.\ISA_Fill_URL_Set.vbs hacking .\BL\hacking\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs hobby .\BL\hobby\domains
.\ISA_Fill_URL_Set.vbs hobby .\BL\hobby\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs homestyle .\BL\homestyle\domains
.\ISA_Fill_URL_Set.vbs homestyle .\BL\homestyle\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs hospitals .\BL\hospitals\domains
.\ISA_Fill_URL_Set.vbs hospitals .\BL\hospitals\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs imagehosting .\BL\imagehosting\domains
.\ISA_Fill_URL_Set.vbs imagehosting .\BL\imagehosting\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs isp .\BL\isp\domains
.\ISA_Fill_URL_Set.vbs isp .\BL\isp\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs jobsearch .\BL\jobsearch\domains
.\ISA_Fill_URL_Set.vbs jobsearch .\BL\jobsearch\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs library .\BL\library\domains
.\ISA_Fill_URL_Set.vbs library .\BL\library\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs military .\BL\military\domains
.\ISA_Fill_URL_Set.vbs military .\BL\military\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs models .\BL\models\domains
.\ISA_Fill_URL_Set.vbs models .\BL\models\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs movies .\BL\movies\domains
.\ISA_Fill_URL_Set.vbs movies .\BL\movies\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs music .\BL\music\domains
.\ISA_Fill_URL_Set.vbs music .\BL\music\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs news .\BL\news\domains
.\ISA_Fill_URL_Set.vbs news .\BL\news\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs podcasts .\BL\podcasts\domains
.\ISA_Fill_URL_Set.vbs podcasts .\BL\podcasts\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs politics .\BL\politics\domains
.\ISA_Fill_URL_Set.vbs politics .\BL\politics\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs recreation .\BL\recreation\domains
.\ISA_Fill_URL_Set.vbs recreation .\BL\recreation\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs radiotv .\BL\radiotv\domains
.\ISA_Fill_URL_Set.vbs radiotv .\BL\radiotv\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs redirector .\BL\redirector\domains
.\ISA_Fill_URL_Set.vbs redirector .\BL\redirector\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs religion .\BL\religion\domains
.\ISA_Fill_URL_Set.vbs religion .\BL\religion\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs remotecontrol .\BL\remotecontrol\domains
.\ISA_Fill_URL_Set.vbs remotecontrol .\BL\remotecontrol\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs ringtones .\BL\ringtones\domains
.\ISA_Fill_URL_Set.vbs ringtones .\BL\ringtones\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs science .\BL\science\domains
.\ISA_Fill_URL_Set.vbs science .\BL\science\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs searchengines .\BL\searchengines\domains
.\ISA_Fill_URL_Set.vbs searchengines .\BL\searchengines\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs sex .\BL\sex\domains
.\ISA_Fill_URL_Set.vbs sex .\BL\sex\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs shopping .\BL\shopping\domains
.\ISA_Fill_URL_Set.vbs shopping .\BL\shopping\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs socialnet .\BL\socialnet\domains
.\ISA_Fill_URL_Set.vbs socialnet .\BL\socialnet\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs spyware .\BL\spyware\domains
.\ISA_Fill_URL_Set.vbs spyware .\BL\spyware\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs tracker .\BL\tracker\domains
.\ISA_Fill_URL_Set.vbs tracker .\BL\tracker\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs updatesites .\BL\updatesites\domains
.\ISA_Fill_URL_Set.vbs updatesites .\BL\updatesites\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs urlshortener .\BL\urlshortener\domains
.\ISA_Fill_URL_Set.vbs urlshortener .\BL\urlshortener\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs violence .\BL\violence\domains
.\ISA_Fill_URL_Set.vbs violence .\BL\violence\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs warez .\BL\warez\domains
.\ISA_Fill_URL_Set.vbs warez .\BL\warez\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs weapons .\BL\weapons\domains
.\ISA_Fill_URL_Set.vbs weapons .\BL\weapons\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs webmail .\BL\webmail\domains
.\ISA_Fill_URL_Set.vbs webmail .\BL\webmail\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs webphone .\BL\webphone\domains
.\ISA_Fill_URL_Set.vbs webphone .\BL\webphone\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs webradio .\BL\webradio\domains
.\ISA_Fill_URL_Set.vbs webradio .\BL\webradio\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs webtv .\BL\webtv\domains
.\ISA_Fill_URL_Set.vbs webtv .\BL\webtv\urls /prependstar

.\ISA_Fill_Domain_Name_Set.vbs porn .\BL\porn\domains
.\ISA_Fill_URL_Set.vbs porn .\BL\porn\urls /prependstar

2 – No ISA Server 2006, Criar em c:\Blacklist o primeiro arquivo .vbs obrigatoriamente com o nome: ISA_Fill_URL_Set.vbs

'*************************************************************************************
' Script Name: ISA_Fill_URL_Set.vbs
' Version: 1.3
' Author: Jason Fossen ( http://www.ISAscripts.org )
'Last Updated: 10.Jun.2008
' Purpose: Automatically update an ISA Server URL Set with URLs; for example,
' these could be URLs of spammers, pornographers, hacking sites, etc.
' Arguments: First arg is name of URL Set, in double-quotes if necessary. The
' second arg is the HTTP URL, local full path, or file name (if in same
' folder as script) of a text file containing the URL data. This file,
' if it contains comments, must use #-marks or semicolons to denote comments.
' Each line must be just one URL.
' This script is compatible with the lists at http://www.urlblacklist.com and
' with other similarly-formatted lists of URLs. The file with URLs can
' use either Windows-style or UNIX-style newlines, both work fine.
' Note: The fastest way to see that the URL Set had been filled correctly
' is to close and open the ISA MMC console again, not by refreshing.
' Works on both ISA Standard and Enterprise editions.
' Thanks to Alexander Willacker for the /*pendstar switches!
' Legal: Public Domain. Modify and redistribute freely. No rights reserved.
' SCRIPT PROVIDED "AS IS" WITHOUT WARRANTIES OR GUARANTEES OF ANY KIND.
' USE AT YOUR OWN RISK. Test on non-production servers first!
'*************************************************************************************

Option Explicit
On Error Resume Next

ReDim aURLsArray(0) 'Array of URLs to be added to the URL Set.
Dim sUrlSetName 'Name of URL Set to be created and/or updated.
Dim bUseLocalURLsFile 'If true, use local file. If false, get URLs from http URL.
Dim sURLsFilePath 'An HTTP URL or a local filesystem path to a file of URLs.
Dim oFPC 'See MakeIsaObjects()
Dim oIsaArray 'See MakeIsaObjects()
Dim bAppendStar : bAppendStar = False 'Assume that a trailing asterisk should not be added.
Dim bPrependStar : bPrependStar = False 'Assume that a leading asterisk & dot should not be added.

Dim oFileSystem : Set oFileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Call CatchAnyErrorsAndQuit("Problems creating the FileSystemObject.")

'*************************************************************************************
' Main()
'*************************************************************************************
Call ProcessCommandLineArguments()
Call CreateIsaObjects()
Call MakeArrayOfURLs()
Call CreateUrlSet()
Call EmptyTheUrlSet()
Call CreateNewURLs()

'*************************************************************************************
' Procedures
'*************************************************************************************

Sub ProcessCommandLineArguments()
On Error Resume Next
'
' First arg...
'
sUrlSetName = WScript.Arguments.Item(0)
Dim sArg : sArg = LCase(sUrlSetName)
If (WScript.Arguments.Count = 0) Or (WScript.Arguments.Count > 4) Or (sArg = "/?")_
Or (sArg = "-?") Or (sArg = "/h") Or (sArg = "/help") Or (sArg = "--help") Then
Call ShowHelpAndQuit()
End If

'
' Second arg...
'
sURLsFilePath = WScript.Arguments.Item(1)

If InStr(LCase(sURLsFilePath), "http://") = 0 Then
bUseLocalURLsFile = True 'Use a local text file.
Else
bUseLocalURLsFile = False 'Use an http URL.
End If

'
' Check to see whether a trailing asterisk should be added if not already present.
'
For Each sArg In WScript.Arguments
If LCase(sArg) = "/appendstar" Then bAppendStar = True
Next

'
' Check to see whether a leading asterisk should be added if not already present.
'
For Each sArg In WScript.Arguments
If LCase(sArg) = "/prependstar" Then bPrependStar = True
Next

On Error Goto 0
End Sub

Sub CreateIsaObjects()
'This sub is just a placeholder for something to add later on...
Set oFPC = CreateObject("FPC.Root")
Set oIsaArray = oFPC.GetContainingArray
Call CatchAnyErrorsAndQuit("Problems connecting to ISA Server or ISA Array.")
End Sub

Sub MakeArrayOfURLs()
If bUseLocalURLsFile Then
If Not ParseInputFile(sURLsFilePath, aURLsArray) Then
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems reading the local URLs file: " & sURLsFilePath)
End If
Else 'Get the URLs file from the http URL...
Dim sUrlText : sUrlText = HttpGetText(sURLsFilePath)
If InStr(sUrlText, "GET-Error!") 0 Then ' "GET-Error!" would be returned by HttpGetText() function, not the web server.
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems getting URLs file from " & sUrlToURLsFile)
End If

If oFileSystem.FileExists("URLs-downloaded-from-url.txt") Then
oFileSystem.DeleteFile "URLs-downloaded-from-url.txt", True 'Delete prior URLs file, if it exists.
End If

If Not AppendToFile(sUrlText, "URLs-downloaded-from-url.txt") Then
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems writing to the URLs-downloaded-from-url.txt file.")
End If

If Not ParseInputFile("URLs-downloaded-from-url.txt", aURLsArray) Then
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems reading file: URLs-downloaded-from-url.txt")
End If
End If

End Sub

Sub CreateUrlSet()
On Error Resume Next
Dim cUrlSets 'FPCUrlSets collection.
Dim oUrlSet 'FPCUrlSet object.

'Set oFPC = CreateObject("FPC.Root")
'Set oIsaArray = oFPC.GetContainingArray
Set cUrlSets = oIsaArray.RuleElements.UrlSets

Set oUrlSet = cUrlSets.Add(sUrlSetName)

If Err.Number = -2147024713 Then
Err.Clear 'Already exists, so ignore error.
Else
cUrlSets.Save
End If

Call CatchAnyErrorsAndQuit("Problems recreating URL Set named " & sUrlSetName)
On Error Goto 0
End Sub

Sub EmptyTheUrlSet()
'Note: Clear the URL Set instead of deleting it because it may be used in rules already.
Dim cUrlSets 'FPCUrlSets collection.
Dim cUrlSet 'FPCUrlSet collection.
Dim sURL

'Set oFPC = CreateObject("FPC.Root")
'Set oIsaArray = oFPC.GetContainingArray
Set cUrlSet = oIsaArray.RuleElements.UrlSets.Item(sUrlSetName)

For Each sURL In cUrlSet
cUrlSet.Remove(sURL)
Next

cUrlSet.Save

Call CatchAnyErrorsAndQuit("Problems emptying URL Set named " & sUrlSetName)
End Sub

Sub CreateNewURLs()
On Error Resume Next
Dim cURLs 'FPCURLSets collection.
Dim oURL 'FPCURL object.
Dim cUrlSet 'FPCUrlSet collection.
Dim cUrlSets 'FPCUrlSets collection.
Dim sIPaddress, sMask, sURL, sURLName, sLeftChar

Set cUrlSet = oIsaArray.RuleElements.UrlSets.Item(sUrlSetName)

For Each sURL In aURLsArray
If Len(sURL) 0 Then
sLeftChar = Left(sURL,1)
If (sLeftChar "#") And (sLeftChar ";") And (sLeftChar "<") Then

If bAppendStar Then
'It might seem strange, but appending an asterisk to the end seems not to interfere with any
'other matching, and is probably the behavior most admins want anyway. It even works fine
'when you get entries like "www.domain.com*" and "www.domain.com/folder/file.html*".

sURL = sURL & "*" 'Append an asterisk to the end.
sURL = Replace(sURL, "**", "*") 'Correct if last char was already an asterisk.
End If

cUrlSet.Add(sURL)

If Err.Number = -2147024713 Then Err.Clear 'URL already added, so ignore error.
'WScript.Echo sURL & " was added." 'For debugging...

If bPrependStar Then
'Blocking devil.com will not block http://www.devil.com and vice versa. So every Domain
'should be added as *.devil.com and devil.com

sURL = "*." & sURL 'Preppend an asterisk & dot at the beginning.
sURL = Replace(sURL, "*.*.", "*.") 'Correct if first chars were already an asterisk & dot.

cUrlSet.Add(sURL)

If Err.Number = -2147024713 Then Err.Clear 'URL already added, so ignore error.
'WScript.Echo sURL & " was added." 'For debugging...

End If
End If
End If
Next

cUrlSet.Save

Call CatchAnyErrorsAndQuit("Problems creating new URL objects in " & sUrlSetName)
On Error Goto 0
End Sub

Sub CatchAnyErrorsAndQuit(sMessage)
Dim oStdErr
If Err.Number 0 Then
Set oStdErr = WScript.StdErr 'Write to standard error stream.
oStdErr.WriteLine vbCrLf
oStdErr.WriteLine ">>>>>> ERROR: " & sMessage
oStdErr.WriteLine "Error Number: " & Err.Number
oStdErr.WriteLine " Description: " & Err.Description
oStdErr.WriteLine "Error Source: " & Err.Source
oStdErr.WriteLine " Script Name: " & WScript.ScriptName
oStdErr.WriteLine vbCrLf
WScript.Quit Err.Number
End If
End Sub

Sub ShowHelpAndQuit()
Dim sUsage : sUsage = vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "ISA_FILL_URL_SET.VBS UrlSetName FilePath [/appendstar] [/prependstar]" & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "Creates or updates an ISA Server URL Set (`UrlSet`)" & vbCrLf
sUsage = sUsage & "with the URLs from a text file (`FilePath`) obtained from" & vbCrLf
sUsage = sUsage & "either an HTTP URL or a local filesystem path." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & " UrlSet Name of URL Set to be created or" & vbCrLf
sUsage = sUsage & " updated with URL entries. " & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & " FilePath A full HTTP URL or local filesystem path" & vbCrLf
sUsage = sUsage & " to a text file containing URLs. All" & vbCrLf
sUsage = sUsage & " comments must start with # or ;. Examples" & vbCrLf
sUsage = sUsage & " might be `filename.txt`, `c:\filename.txt`," & vbCrLf
sUsage = sUsage & " or `http://www.fqdn.com/filename.asp`." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & " /appendstar Optional. Will automatically append an asterisk" & vbCrLf
sUsage = sUsage & " to every URL imported (which is probably what" & vbCrLf
sUsage = sUsage & " you want). Don't worry, this doesn't break" & vbCrLf
sUsage = sUsage & " URL matching when no path, or a full path, is" & vbCrLf
sUsage = sUsage & " specified in the URL, e.g., isascripts.org* and" & vbCrLf
sUsage = sUsage & " isascripts.org/index.html* still match fine." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & " /prependstar Optional. Will automatically prepend an asterisk & dot" & vbCrLf
sUsage = sUsage & " to every URL imported. (e.g. Blocking devil.com will" & vbcrlf
sUsage = sUsage & " not block http://www.devil.com and vice versa. So every Domain" & vbcrlf
sUsage = sUsage & " will be added as *.devil.com and devil.com" & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "Note that all URLs defined in the URL Set are deleted" & vbCrLf
sUsage = sUsage & "prior to importing the URLs from the text file. If necessary," & vbCrLf
sUsage = sUsage & "the URL Set object will be created first. Place double-quotes" & vbCrLf
sUsage = sUsage & "around the UrlSet and FilePath arguments if they contain" & vbCrLf
sUsage = sUsage & "any space characters. When providing an HTTP URL, the downloaded" & vbCrLf
sUsage = sUsage & "file will be saved as 'URLs-downloaded-from-url.txt` in the " & vbCrLf
sUsage = sUsage & "same folder as the script; it will be overwritten whenever a URL" & vbCrLf
sUsage = sUsage & "path is used again." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "Public domain. No rights reserved. SCRIPT PROVIDED ""AS IS"" WITHOUT WARRANTIES" & vbCrLf
sUsage = sUsage & "OR GUARANTEES OF ANY KIND. USE AT YOUR OWN RISK. ( http://www.ISAscripts.org )" & vbCrLf
sUsage = sUsage & vbCrLf

WScript.Echo sUsage
WScript.Quit
End Sub

'*************************************************************************************
' Functions
'*************************************************************************************

Function IsIpAddress(sInput)
'Regular expression would be more accurate, but slower...quick-n-dirty will do since
'having a "*.dottedIPaddress" URL doesn't break anything if an IP address sneaks by...

IsIpAddress = False

Dim sEnd
sInput = LCase(sInput)
sEnd = Right(sInput,1) 'This will catch 98% of cases, so it's faster than RegEx.
If (sEnd = "m") Or (sEnd = "u") Or (sEnd = "l") Or (sEnd = "v") Or (sEnd = "g")_
Or (sEnd = "t") Or (sEnd = "z") Or (sEnd = "o") Or (sEnd = "e") Or (sEnd = "s")_
Or (sEnd = "r") Or (sEnd = "n") Or (sEnd = "c") Or (sEnd = "k") Or (sEnd = "e") Then Exit Function

Dim aArray, x
aArray = Split(sInput,".")
If UBound(aArray) 3 Then Exit Function

If Not (IsNumeric(aArray(0)) And IsNumeric(aArray(1)) And IsNumeric(aArray(2)) And IsNumeric(aArray(3))) Then Exit Function

IsIpAddress = True
End Function

Function HttpGetText(sURL)
On Error Resume Next

If Not IsObject(oHTTP) Then Dim oHTTP : Set oHTTP = WScript.CreateObject("Microsoft.XMLHTTP")

oHTTP.Open "GET", sURL, False 'False = Script waits until the full HTTP response is received.
oHTTP.Send 'Send the HTTP command as defined with the Open method.

If Err.Number = 0 Then
HttpGetText = oHTTP.ResponseText
HttpGetText = Replace(HttpGetText, vbLf, vbCrLf) 'Flip UNIX new lines to DOS, if necessary.
Else
HttpGetText = "GET-Error! Error Number: " & Err.Number
End If
End Function

'*********************************************************************************
' Script Name: Parse_Input_File.vbs
' Version: 1.1
' Author: Jason Fossen
'Last Updated: 29.Mar.2004
' Purpose: Sorts lines of a text file into an array.
' Usage: Function returns true if no problems, false otherwise. Pass global
' variable of an array into second argument of function; this will be
' resized and populated with lines from text file. Blank and empty
' trailing lines from file, if any, are excluded from the array. The
' array global variable must be declared with "ReDim", not just "Dim".
' The file can be passed in with full path or just the file name if
' the file is in the same folder as the script.
' Note: You must declare the global array variable with "ReDim" before
' passing it into the function; make it of size one because it
' will be ReDim-ed without preservation again anyway.
' Legal: Public Domain. Modify and redistribute freely. No rights reserved.
' Use at your own risk. Do not run on networks for which you do not
' have prior written permission to do so. Script provided "AS IS".
'*********************************************************************************

Function ParseInputFile(ByVal sFile, ByRef aArray)
On Error Resume Next
Const ForReading = 1
Const OpenUsingDefault = -2
Dim sCurrentFolder, oFileSystem, oInputFile, i, iCurrentSize
Dim iPreserveCounter, oFile, oTextStream, iLineCount, sLine

'Expand environmental variables, if any.
If InStr(sFile, "%") 0 Then
If Not IsObject(oWshShell) Then Set oWshShell = WScript.CreateObject("WScript.Shell")
sFile = oWshShell.ExpandEnvironmentStrings(sFile)
End If

'Assume input file is in current folder if a full path is not given.
If InStr(sFile, "\") = 0 Then
sCurrentFolder = WScript.ScriptFullName
sCurrentFolder = Left(sCurrentFolder, InstrRev(sCurrentFolder, "\"))
sFile = sCurrentFolder & sFile
End If

'Verify that file exists and is readable, return false if not.
If Not IsObject(oFileSystem) Then Set oFileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set oFile = oFileSystem.GetFile(sFile)
Set oTextStream = oFile.OpenAsTextStream(ForReading, OpenUsingDefault)
If Err.Number 0 Then
'WScript.Echo "Problem opening " & sFile & " (" & Err.Description & ")"
ParseInputFile = False
Exit Function
End If

'Count the number of lines in file, not including an empty line at the very end (if present).
iLineCount = 0
Do While Not oTextStream.AtEndOfStream
oTextStream.SkipLine
iLineCount = iLineCount + 1
Loop

'ReDim the array to be equal to expected size of the input from file.
If iLineCount 0 Then
ReDim aArray(iLineCount - 1)
oTextStream.Close
Set oTextStream = Nothing
Else 'The input file was empty!
ReDim aArray(0)
'aArray(0) = "" 'Assign default here if desired.
oTextStream.Close
Set oTextStream = Nothing
Set oFile = Nothing
Set oFileSystem = Nothing
If Err.Number = 0 Then
ParseInputFile = True
Else
ParseInputFile = False
End If
Exit Function
End If

'Read each line of file into an element of the array, excluding blank lines.
Set oTextStream = oFile.OpenAsTextStream(ForReading, OpenUsingDefault)
i = 0
iPreserveCounter = 0
Do While Not oTextStream.AtEndOfStream
sLine = Trim(oTextStream.ReadLine) 'Note the trimming here.
If Len(sLine) 0 Then
aArray(i) = sLine
i = i + 1
Else
iPreserveCounter = iPreserveCounter + 1 'Keep track of blank lines.
End If
Loop
oTextStream.Close
Set oTextStream = Nothing

'If there were blank lines in the file, trim the array of empty elements.
If iPreserveCounter 0 Then
iCurrentSize = UBound(aArray)
ReDim Preserve aArray(iCurrentSize - iPreserveCounter)
End If

Set oFile = Nothing
Set oFileSystem = Nothing

If Err.Number = 0 Then
ParseInputFile = True
Else
ParseInputFile = False
End If
End Function

'**********************************************************************************
' Script Name: Append_To_File.vbs
' Version: 1.3
' Author: Jason Fossen
'Last Updated: 28.Jul.2004
' Purpose: Function to append line(s) to the end of a text file.
' If the file does not exist, it will be created. If the full
' path to the file is not supplied, it is assumed to be in the
' same folder as the script. Function returns true if no
' errors, false otherwise.
' Notes: Because this function would repeatedly open and close the file,
' this function is not appropriate for writing many lines to a single
' file one line at a time. Many megs of text can be appended in one shot.
' Legal: Public Domain. Modify and redistribute freely. No rights reserved.
'**********************************************************************************

Function AppendToFile(sData, sFile)
On Error Resume Next

Const ForAppending = 8 'Request NTFS appending permission.
Const ForOverWriting = 2 'Request NTFS writing permission.
Const ForReading = 1 'Request NTFS read permission.
Const OpenAsASCII = 0 'ASCII text format.
Const OpenAsUnicode = -1 'Unicode text format.
Const OpenUsingDefault = -2 'ASCII is default for FAT32, Unicode default for NTFS.

Dim sCurrentFolder, oTextStream

'Create FileSystemObject if it doesn't exist yet.
If Not IsObject(oFileSystem) Then Set oFileSystem = WScript.CreateObject("Scripting.FileSystemObject")

'Expand any environmental variables to their full paths.
If InStr(sFile, "%") 0 Then
If Not IsObject(oWshShell) Then Set oWshShell = WScript.CreateObject("WScript.Shell")
sFile = oWshShell.ExpandEnvironmentStrings(sFile)
End If

'Use current folder of script for output file path, if not path is given.
If InStr(sFile, "\") = 0 Then
sCurrentFolder = WScript.ScriptFullName
sCurrentFolder = Left(sCurrentFolder, InstrRev(sCurrentFolder, "\"))
sFile = sCurrentFolder & sFile
End If

'Get output file if it exists, or create one if it doesn't.
If Not oFileSystem.FileExists(sFile) Then
Set oTextStream = oFileSystem.CreateTextFile(sFile)
Else
Set oFile = oFileSystem.GetFile(sFile)
Set oTextStream = oFile.OpenAsTextStream(ForAppending, OpenUsingDefault)
End If

'Must write data to a new line, so check the column number first.
If oTextStream.Column = 1 Then
oTextStream.Write(sData)
Else
oTextStream.WriteBlankLines(1)
oTextStream.Write(sData)
End If

oTextStream.Close

If Err.Number = 0 Then
AppendToFile = True
Else
AppendToFile = False
End If
End Function

'END OF SCRIPT************************************************************************

3 – No ISA Server 2006, Criar em c:\Blacklist o segundo arquivo .vbs obrigatoriamente com o nome: ISA_Fill_Domain_Name_Set.vbs

'*************************************************************************************
' Script Name: ISA_Fill_Domain_Name_Set.vbs
' Version: 1.2
' Author: Jason Fossen ( http://www.ISAscripts.org )
'Last Updated: 18.Feb.2008
' Purpose: Automatically update an ISA Server Domain Name Set with domains; for example,
' these could be domains of spammers, pornographers, hacking sites, etc.
' Arguments: First arg is name of Domain Name Set, in double-quotes if necessary. The
' second arg is the HTTP URL, local full path, or file name (if in same
' folder as script) of a text file containing the domain data. This file,
' if it contains comments, must use #-marks or semicolons to denote comments.
' Each line must be just a domain name, but if IP addresses are in the list, they
' will be ignored automatically. This script is compatible with, but does not
' require or depend on, the lists at:
' http://urlblacklist.com
' http://www.squidguard.org/blacklists/
' It also works if a listed domain begins or ends with a period, or begins
' with "*." as a wildcard. The file with the domains can use either
' Windows-style or UNIX-style newlines, it's compatible with both. Note that
' each domain will be added twice: once with a prepended "*." and another
' without the leading "*." wildcard, since ISA won't match on just the plain
' domain name in a URL if the domain has "*." prepended to it in the set.
' Note: Depending on the speed of the ISA box, importing a 10MB file with 500,000
' domains can take between two and four hours. This is a bottleneck imposed
' by ISA, not the Windows Script Host or VBScript. Hence, schedule your
' imports during off-peak hours and run the script with the Start command
' to launch it with a lower multi-tasking priority; for example, like this:
' "start /belownormal cscript.exe ImportBlacklist.vbs Bad-Sites domains"
' Note: The fastest way to see that the Domain Name Set had been filled correctly
' is to close and open the ISA MMC console again, not by refreshing.
' Works on both ISA Standard and Enterprise.
' Legal: Public Domain. Modify and redistribute freely. No rights reserved.
' SCRIPT PROVIDED "AS IS" WITHOUT WARRANTIES OR GUARANTEES OF ANY KIND.
' USE AT YOUR OWN RISK. Test on non-production servers first!
'*************************************************************************************

Option Explicit
On Error Resume Next

ReDim aDomainsArray(0) 'Array of Domains to be added to the Domain Name Set.
Dim sDomainNameSetName 'Name of Domain Name Set to be created and/or updated.
Dim bUseLocalDomainsFile 'If true, use local file. If false, get domains from http URL.
Dim sDomainsFilePath 'An HTTP URL or a local filesystem path to a file of domains.
Dim oFPC 'See MakeIsaObjects()
Dim oIsaArray 'See MakeIsaObjects()

Dim oFileSystem : Set oFileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Call CatchAnyErrorsAndQuit("Problems creating the FileSystemObject.")

'*************************************************************************************
' Main()
'*************************************************************************************
Call ProcessCommandLineArguments()
Call CreateIsaObjects()
Call MakeArrayOfDomains()
Call CreateDomainNameSet()
Call EmptyTheDomainNameSet()
Call CreateNewDomains()

'*************************************************************************************
' Procedures
'*************************************************************************************

Sub ProcessCommandLineArguments()
On Error Resume Next
'
' First arg...
'
sDomainNameSetName = WScript.Arguments.Item(0)
Dim sArg : sArg = LCase(sDomainNameSetName)
If (WScript.Arguments.Count = 0) Or (WScript.Arguments.Count => 3) Or (sArg = "/?")_
Or (sArg = "-?") Or (sArg = "/h") Or (sArg = "/help") Or (sArg = "--help") Then
Call ShowHelpAndQuit()
End If

'
' Second arg...
'
sDomainsFilePath = WScript.Arguments.Item(1)

If InStr(LCase(sDomainsFilePath), "http://") = 0 Then
bUseLocalDomainsFile = True 'Use a local text file.
Else
bUseLocalDomainsFile = False 'Use an http URL.
End If
On Error Goto 0
End Sub

Sub CreateIsaObjects()
'This sub is just a placeholder for something to add later on...
Set oFPC = CreateObject("FPC.Root")
Set oIsaArray = oFPC.GetContainingArray
Call CatchAnyErrorsAndQuit("Problems connecting to ISA Server or ISA Array.")
End Sub

Sub MakeArrayOfDomains()
If bUseLocalDomainsFile Then
If Not ParseInputFile(sDomainsFilePath, aDomainsArray) Then
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems reading the local domains file: " & sDomainsFilePath)
End If
Else 'Get the domains file from the http URL...
Dim sUrlText : sUrlText = HttpGetText(sDomainsFilePath)
If InStr(sUrlText, "GET-Error!") 0 Then ' "GET-Error!" would be returned by HttpGetText() function, not the web server.
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems getting domains file from " & sUrlToDomainsFile)
End If

If oFileSystem.FileExists("domains-downloaded-from-url.txt") Then
oFileSystem.DeleteFile "domains-downloaded-from-url.txt", True 'Delete prior domains file, if it exists.
End If

If Not AppendToFile(sUrlText, "domains-downloaded-from-url.txt") Then
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems writing to the domains-downloaded-from-url.txt file.")
End If

If Not ParseInputFile("domains-downloaded-from-url.txt", aDomainsArray) Then
Err.Raise -1
Call CatchAnyErrorsAndQuit("Problems reading file: domains-downloaded-from-url.txt")
End If
End If

End Sub

Sub CreateDomainNameSet()
On Error Resume Next
Dim cDomainNameSets 'FPCDomainNameSets collection.
Dim oDomainNameSet 'FPCDomainNameSet object.

'Set oFPC = CreateObject("FPC.Root")
'Set oIsaArray = oFPC.GetContainingArray
Set cDomainNameSets = oIsaArray.RuleElements.DomainNameSets

Set oDomainNameSet = cDomainNameSets.Add(sDomainNameSetName)

If Err.Number = -2147024713 Then
Err.Clear 'Already exists, so ignore error.
Else
cDomainNameSets.Save
End If

Call CatchAnyErrorsAndQuit("Problems recreating Domain Name Set named " & sDomainNameSetName)
On Error Goto 0
End Sub

Sub EmptyTheDomainNameSet()
'Note: Clear the Domain Name Set instead of deleting it because it may be used in rules already.
Dim cDomainNameSets 'FPCDomainNameSets collection.
Dim cDomainNameSet 'FPCDomainNameSet collection.
Dim sDomain

'Set oFPC = CreateObject("FPC.Root")
'Set oIsaArray = oFPC.GetContainingArray
Set cDomainNameSet = oIsaArray.RuleElements.DomainNameSets.Item(sDomainNameSetName)

For Each sDomain In cDomainNameSet
cDomainNameSet.Remove(sDomain)
Next

cDomainNameSet.Save

Call CatchAnyErrorsAndQuit("Problems emptying Domain Name Set named " & sDomainNameSetName)
End Sub

Sub CreateNewDomains()
On Error Resume Next
Dim cDomains 'FPCURLSets collection.
Dim oDomain 'FPCDomain object.
Dim cDomainNameSet 'FPCDomainNameSet collection.
Dim cDomainNameSets 'FPCDomainNameSets collection.
Dim sIPaddress, sMask, sDomain, sDomainName

Set cDomainNameSet = oIsaArray.RuleElements.DomainNameSets.Item(sDomainNameSetName)

For Each sDomain In aDomainsArray
If (Left(sDomain, 1) "#") And (Left(sDomain, 1) ";") And (Left(sDomain, 1) "<") And (Len(sDomain) 0) And Not IsIpAddress(sDomain) Then
If Right(sDomain,1) = "." Then sDomain = Left(sDomain, Len(sDomain) - 1) 'Trim off a trailing period, if present.
If Left(sDomain,2) "*." Then sDomain = "*." & sDomain 'Prepend "*." if not already there.
sDomain = Replace(sDomain, "..", ".") 'Correct if first char was already a period.
cDomainNameSet.Add(sDomain)
If Err.Number = -2147024713 Then Err.Clear 'Domain already added, so ignore error.

'Comment out the next three lines if you don't want the plain "domain.com" entries added too (the ones without the leading "*.").
sDomain = Trim(Replace(sDomain, "*.", ""))
cDomainNameSet.Add(sDomain)
If Err.Number = -2147024713 Then Err.Clear 'Domain already added, so ignore error.
End If
Next

cDomainNameSet.Save

Call CatchAnyErrorsAndQuit("Problems creating new domain objects in " & sDomainNameSetName)
On Error Goto 0
End Sub

Sub CatchAnyErrorsAndQuit(sMessage)
Dim oStdErr
If Err.Number 0 Then
Set oStdErr = WScript.StdErr 'Write to standard error stream.
oStdErr.WriteLine vbCrLf
oStdErr.WriteLine ">>>>>> ERROR: " & sMessage
oStdErr.WriteLine "Error Number: " & Err.Number
oStdErr.WriteLine " Description: " & Err.Description
oStdErr.WriteLine "Error Source: " & Err.Source
oStdErr.WriteLine " Script Name: " & WScript.ScriptName
oStdErr.WriteLine vbCrLf
WScript.Quit Err.Number
End If
End Sub

Sub ShowHelpAndQuit()
Dim sUsage : sUsage = vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "ISA_FILL_DOMAIN_NAME_SET.VBS DomainNameSetName FilePath" & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "Creates or updates an ISA Server Domain Name Set (`DomainNameSet`)" & vbCrLf
sUsage = sUsage & "with the domains from a text file (`FilePath`) obtained from" & vbCrLf
sUsage = sUsage & "either an HTTP URL or a local filesystem path." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & " DomainNameSet Name of Domain Name Set to be created or" & vbCrLf
sUsage = sUsage & " updated with domain entries. Will be" & vbCrLf
sUsage = sUsage & " created in the local ISA Server or" & vbCrLf
sUsage = sUsage & " current ISA Server Array." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & " FilePath A full HTTP URL or local filesystem path" & vbCrLf
sUsage = sUsage & " to a text file containing domains. All" & vbCrLf
sUsage = sUsage & " comments must start with # or ;. Examples" & vbCrLf
sUsage = sUsage & " might be `filename.txt`, `c:\filename.txt`," & vbCrLf
sUsage = sUsage & " or `http://www.fqdn.com/filename.asp`." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "Note that all domains defined in the Domain Name Set are deleted" & vbCrLf
sUsage = sUsage & "prior to importing the domains from the text file. If necessary," & vbCrLf
sUsage = sUsage & "the Domain Name Set object will be created. Place double-quotes" & vbCrLf
sUsage = sUsage & "around the DomainNameSet and FilePath arguments if they contain" & vbCrLf
sUsage = sUsage & "any space characters. When providing an HTTP URL, the downloaded" & vbCrLf
sUsage = sUsage & "file will be saved as 'domains-downloaded-from-url.txt` in the " & vbCrLf
sUsage = sUsage & "same folder as the script; it will be overwritten whenever a URL" & vbCrLf
sUsage = sUsage & "path is used again. Script must be run on the ISA Server itself." & vbCrLf
sUsage = sUsage & vbCrLf
sUsage = sUsage & "SCRIPT PROVIDED ""AS IS"" AND WITHOUT WARRANTIES OR GUARANTEES OF ANY KIND." & vbCrLf
sUsage = sUsage & "USE AT YOUR OWN RISK. ( http://www.ISAscripts.org )" & vbCrLf
sUsage = sUsage & vbCrLf

WScript.Echo sUsage
WScript.Quit
End Sub

'*************************************************************************************
' Functions
'*************************************************************************************

Function IsIpAddress(sInput)
'Regular expression would be more accurate, but slower...quick-n-dirty will do since
'having a "*.dottedIPaddress" domain doesn't break anything if an IP address sneaks by...

IsIpAddress = False

Dim sEnd
sInput = LCase(sInput)
sEnd = Right(sInput,1) 'This will catch 98% of cases, so it's faster than RegEx.
If (sEnd = "m") Or (sEnd = "u") Or (sEnd = "l") Or (sEnd = "v") Or (sEnd = "g")_
Or (sEnd = "t") Or (sEnd = "z") Or (sEnd = "o") Or (sEnd = "e") Or (sEnd = "s")_
Or (sEnd = "r") Or (sEnd = "n") Or (sEnd = "c") Or (sEnd = "k") Or (sEnd = "e") Then Exit Function

Dim aArray, x
aArray = Split(sInput,".")
If UBound(aArray) 3 Then Exit Function

If Not (IsNumeric(aArray(0)) And IsNumeric(aArray(1)) And IsNumeric(aArray(2)) And IsNumeric(aArray(3))) Then Exit Function

IsIpAddress = True
End Function

Function HttpGetText(sURL)
On Error Resume Next

If Not IsObject(oHTTP) Then Dim oHTTP : Set oHTTP = WScript.CreateObject("Microsoft.XMLHTTP")

oHTTP.Open "GET", sURL, False 'False = Script waits until the full HTTP response is received.
oHTTP.Send 'Send the HTTP command as defined with the Open method.

If Err.Number = 0 Then
HttpGetText = oHTTP.ResponseText
HttpGetText = Replace(HttpGetText, vbLf, vbCrLf) 'Flip UNIX new lines to DOS, if necessary.
Else
HttpGetText = "GET-Error! Error Number: " & Err.Number
End If
End Function

'*********************************************************************************
' Script Name: Parse_Input_File.vbs
' Version: 1.1
' Author: Jason Fossen
'Last Updated: 29.Mar.2004
' Purpose: Sorts lines of a text file into an array.
' Usage: Function returns true if no problems, false otherwise. Pass global
' variable of an array into second argument of function; this will be
' resized and populated with lines from text file. Blank and empty
' trailing lines from file, if any, are excluded from the array. The
' array global variable must be declared with "ReDim", not just "Dim".
' The file can be passed in with full path or just the file name if
' the file is in the same folder as the script.
' Note: You must declare the global array variable with "ReDim" before
' passing it into the function; make it of size one because it
' will be ReDim-ed without preservation again anyway.
' Legal: Public Domain. Modify and redistribute freely. No rights reserved.
' Use at your own risk. Do not run on networks for which you do not
' have prior written permission to do so. Script provided "AS IS".
'*********************************************************************************

Function ParseInputFile(ByVal sFile, ByRef aArray)
On Error Resume Next
Const ForReading = 1
Const OpenUsingDefault = -2
Dim sCurrentFolder, oFileSystem, oInputFile, i, iCurrentSize
Dim iPreserveCounter, oFile, oTextStream, iLineCount, sLine

'Expand environmental variables, if any.
If InStr(sFile, "%") 0 Then
If Not IsObject(oWshShell) Then Set oWshShell = WScript.CreateObject("WScript.Shell")
sFile = oWshShell.ExpandEnvironmentStrings(sFile)
End If

'Assume input file is in current folder if a full path is not given.
If InStr(sFile, "\") = 0 Then
sCurrentFolder = WScript.ScriptFullName
sCurrentFolder = Left(sCurrentFolder, InstrRev(sCurrentFolder, "\"))
sFile = sCurrentFolder & sFile
End If

'Verify that file exists and is readable, return false if not.
If Not IsObject(oFileSystem) Then Set oFileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set oFile = oFileSystem.GetFile(sFile)
Set oTextStream = oFile.OpenAsTextStream(ForReading, OpenUsingDefault)
If Err.Number 0 Then
'WScript.Echo "Problem opening " & sFile & " (" & Err.Description & ")"
ParseInputFile = False
Exit Function
End If

'Count the number of lines in file, not including an empty line at the very end (if present).
iLineCount = 0
Do While Not oTextStream.AtEndOfStream
oTextStream.SkipLine
iLineCount = iLineCount + 1
Loop

'ReDim the array to be equal to expected size of the input from file.
If iLineCount 0 Then
ReDim aArray(iLineCount - 1)
oTextStream.Close
Set oTextStream = Nothing
Else 'The input file was empty!
ReDim aArray(0)
'aArray(0) = "" 'Assign default here if desired.
oTextStream.Close
Set oTextStream = Nothing
Set oFile = Nothing
Set oFileSystem = Nothing
If Err.Number = 0 Then
ParseInputFile = True
Else
ParseInputFile = False
End If
Exit Function
End If

'Read each line of file into an element of the array, excluding blank lines.
Set oTextStream = oFile.OpenAsTextStream(ForReading, OpenUsingDefault)
i = 0
iPreserveCounter = 0
Do While Not oTextStream.AtEndOfStream
sLine = Trim(oTextStream.ReadLine) 'Note the trimming here.
If Len(sLine) 0 Then
aArray(i) = sLine
i = i + 1
Else
iPreserveCounter = iPreserveCounter + 1 'Keep track of blank lines.
End If
Loop
oTextStream.Close
Set oTextStream = Nothing

'If there were blank lines in the file, trim the array of empty elements.
If iPreserveCounter 0 Then
iCurrentSize = UBound(aArray)
ReDim Preserve aArray(iCurrentSize - iPreserveCounter)
End If

Set oFile = Nothing
Set oFileSystem = Nothing

If Err.Number = 0 Then
ParseInputFile = True
Else
ParseInputFile = False
End If
End Function

'**********************************************************************************
' Script Name: Append_To_File.vbs
' Version: 1.3
' Author: Jason Fossen
'Last Updated: 28.Jul.2004
' Purpose: Function to append line(s) to the end of a text file.
' If the file does not exist, it will be created. If the full
' path to the file is not supplied, it is assumed to be in the
' same folder as the script. Function returns true if no
' errors, false otherwise.
' Notes: Because this function would repeatedly open and close the file,
' this function is not appropriate for writing many lines to a single
' file one line at a time. Many megs of text can be appended in one shot.
' Legal: Public Domain. Modify and redistribute freely. No rights reserved.
'**********************************************************************************

Function AppendToFile(sData, sFile)
On Error Resume Next

Const ForAppending = 8 'Request NTFS appending permission.
Const ForOverWriting = 2 'Request NTFS writing permission.
Const ForReading = 1 'Request NTFS read permission.
Const OpenAsASCII = 0 'ASCII text format.
Const OpenAsUnicode = -1 'Unicode text format.
Const OpenUsingDefault = -2 'ASCII is default for FAT32, Unicode default for NTFS.

Dim sCurrentFolder, oTextStream

'Create FileSystemObject if it doesn't exist yet.
If Not IsObject(oFileSystem) Then Set oFileSystem = WScript.CreateObject("Scripting.FileSystemObject")

'Expand any environmental variables to their full paths.
If InStr(sFile, "%") 0 Then
If Not IsObject(oWshShell) Then Set oWshShell = WScript.CreateObject("WScript.Shell")
sFile = oWshShell.ExpandEnvironmentStrings(sFile)
End If

'Use current folder of script for output file path, if not path is given.
If InStr(sFile, "\") = 0 Then
sCurrentFolder = WScript.ScriptFullName
sCurrentFolder = Left(sCurrentFolder, InstrRev(sCurrentFolder, "\"))
sFile = sCurrentFolder & sFile
End If

'Get output file if it exists, or create one if it doesn't.
If Not oFileSystem.FileExists(sFile) Then
Set oTextStream = oFileSystem.CreateTextFile(sFile)
Else
Set oFile = oFileSystem.GetFile(sFile)
Set oTextStream = oFile.OpenAsTextStream(ForAppending, OpenUsingDefault)
End If

'Must write data to a new line, so check the column number first.
If oTextStream.Column = 1 Then
oTextStream.Write(sData)
Else
oTextStream.WriteBlankLines(1)
oTextStream.Write(sData)
End If

oTextStream.Close

If Err.Number = 0 Then
AppendToFile = True
Else
AppendToFile = False
End If
End Function

'END OF SCRIPT************************************************************************

4 – Baixar a blacklist shallalist.tar.gz e extrai-la em uma pasta temporária. Mover de dentro desse arquivo toda pasta BL para dentro do diretorio C:\Blacklist ficando assim… C:\Blacklist\BL\adv\domains (por exemplo, aonde adv é uma das tantas categorias)

5 – Finalizando

A bat Execute-Import-In-ISA2006.bat vai chamar dois scripts que vão iportar os dados da Blacklist baixada no site da Shalllist
Basta executa-la e aguardar que todas as blacklists sejam importadas.
Apos finalizar abra o ISA Server e crie as regras com as novas Desination URL_Sets e Domain_Name referentes as categorias que voce deseja bloquear ou liberar

Anúncios

Internet Assigned Numbers Authority (IANA) é responsável por manter as atribuições oficiais do port number para usos específicos.

Dica: O Comando NetStat: Exibe estatísticas de protocolo e conexões de rede TCP/IP atuais.

A tabela abaixo indica o status da porta com as seguintes cores e legendas:
  • Oficial se a aplicação e a combinação da porta está  no Iana list
  • Não-oficial se a aplicação e a combinação da porta Não está  no Iana list
  • Conflito se a porta é utilizada usualmente por dois ou mais protocolos.
  • EPI se a porta é utilizada como padrão interno.

Portas 0 a 1023

Porta Descrição status
0/TCP,UDP Reservada; Fora de Serviço
1/TCP,UDP TCPMUX (Serviço de porta TCP multiplexador) Oficial
5/TCP,UDP RJE (Remote Job Entry)(Entrada de trabalho remoto) Oficial
7/TCP,UDP ECHO protocol Oficial
9/TCP,UDP DISCARD protocol Oficial
11/TCP,UDP SYSTAT protocol Oficial
13/TCP,UDP DAYTIME protocol Oficial
17/TCP,UDP QOTD (Quote of the Day) protocol Oficial
18/TCP,UDP Message Send Protocol (Protocolo de envio de mensagem) Oficial
19/TCP,UDP CHARGEN (Character Generator) protocol (protocolo de geração de caracter) Oficial
20/TCP FTP(File Transfer protocol)(Protocolo de transferência de arquivo) – data port Oficial
21/TCP FTP (File Transfer protocol)(Protocolo de transferência de arquivo) – control (command) port Oficial
22/TCP,UDP SSH (Secure Shell) (Shell seguro) – usada para logins seguros, transferência de arquivos e redirecionamento de porta Oficial
23/TCP,UDP Telnet protocol – comunicação de texto sem encriptação Oficial
25/TCP,UDP SMTP (Simple Mail Transfer Protocol) (Protocolo simples de envio de e-mail) – usada para roteamento de e-mail entre servidores Oficial
26/TCP,UDP RSFTP – protocolo similar ao FTP Não-oficial
35/TCP,UDP QMS Magicolor 2 printer Não-oficial
37/TCP,UDP TIME protocol (protocolo de tempo) Oficial
38/TCP,UDP Route Access Protocol (Protocolo de Acesso ao roteador) Oficial
39/TCP,UDP Resource Location Protocol (Protocolo de localização de recursos) Oficial
41/TCP,UDP Graphics (gráficos) Oficial
42/TCP,UDP Host Name Server (Servidor do Nome do Host) Oficial
42/TCP,UDP WINS [1] Não-oficial/Conflito
43/TCP WHOIS (protocolo de consulta de informações de contato e DNSprotocol) Oficial
49/TCP,UDP TACACS Login Host protocol(Protocolo de Login no Host) Oficial
53/TCP,UDP DNS (Sistema de nome de domínio) Oficial
57/TCP MTP, Mail Transfer Protocol (Protocolo de transferência de e-mail)
67/UDP BOOTP (BootStrap Protocol) server; também utilizada por DHCP (Protocolo de configuração dinâmica do Host) Oficial
68/UDP BOOTP client; também utilizada por DHCP Oficial
69/UDP TFTP(Trivial File Transfer Protocol) (Protocolo de transferência de arquivo trivial ) Oficial
70/TCP Gopher (Protocolo para indexar repositórios) protocol Oficial
79/TCP Finger protocol Oficial
80/TCP HTTP (HyperText Transfer Protocol)(Procolo de transferência de HiperTexto) – usada para transferir páginas WWW Oficial
81/TCP HTTP Alternate (HyperText Transfer Protocol) (Protocolo de transferência de HiperTexto) Oficial
81/TCP TorparkOnion routing ORport Não-oficial
82/UDP Torpark – Control Port Não-oficial
88/TCP Kerberos (Protocolo de comunicações individuais seguras e identificadas) – authenticating agent Oficial
101/TCP HOSTNAME
102/TCP ISO-TSAP protocol
107/TCP Remote Telnet Service (Serviço remoto Telnet)
109/TCP POP, (Post Office Protocol) (Protocolo de post oficial), version 2
110/TCP POP3 (Post Office Protocol version 3) (Protocolo de post oficial versão 3) – usada para recebimento de e-mail Oficial
111/TCP,UDP sun protocol (Protocolo da sun) Oficial
113/TCP ident – antigo identificador de servidores, ainda usada em servidores IRC para identificar seus usuários Oficial
115/TCP SFTP, (Simple File Transfer Protocol) (Protocolo de simples transferência de arquivo)
117/TCP UUCP-PATH
118/TCP,UDP SQL Services Oficial
119/TCP NNTP (Network News Transfer Protocol) (Protocolo de transferência de notícias na rede) – usada para recebimento de mensagens de newsgroups Oficial
123/UDP NTP (Network Time Protocol) (Protocolo de tempo na rede) – usada para sincronização de horário Oficial
135/TCP,UDP EPMAP (End Point Mapper) / Microsoft RPC Locator Service (Microsoft RPC Serviço de localização) Oficial
137/TCP,UDP NetBIOS NetBIOS Name Service Oficial
138/TCP,UDP NetBIOS NetBIOS Datagram Service (Serviço de datagrama NetBios) Oficial
139/TCP,UDP NetBIOS NetBIOS Session Service (Serviço de sessão NetBios) Oficial
143/TCP,UDP IMAP4 (Internet Message Access Protocol 4) (Protocolo de Acesso a mensagens na Internet) – usada para recebimento de e-mail Oficial
152/TCP,UDP BFTP, Background File Transfer Program (Protocolo de transferência de arquivo em Background(fundo)
153/TCP,UDP SGMP, Simple Gateway Monitoring Protocol (Protocolo de simples monitoramento do gateway)
156/TCP,UDP SQL Service (Serviço SQL) Oficial
158/TCP,UDP DMSP, Distributed Mail Service Protocol (Protocolo de serviço de e-mail distribuído)
161/TCP,UDP SNMP (Simple Network Management Protocol) (Protocolo simples de gerenciamento de rede) Oficial
162/TCP,UDP SNMPTRAP Oficial
170/TCP Print-srv (Print Server)
179/TCP BGP (Border Gateway Protocol)(Protocolo de limite do gateway) Oficial
194/TCP IRC (Internet Relay Chat) Oficial
201/TCP,UDP AppleTalk Routing Maintenance
209/TCP,UDP The Quick Mail Transfer Protocol (Protocolo de rápida transferência de mail)
213/TCP,UDP IPX (Internetwork Packet Exchange) (Troca de pacote na área de trabalho da internet) Oficial
218/TCP,UDP MPP, Message Posting Protocol (Protocolo de postagem de mensagem)
220/TCP,UDP IMAP, Interactive Mail Access Protocol, version 3 (Protocolo de acesso interativo ao mail)
259/TCP,UDP ESRO, Efficient Short Remote Operations (Operações remotas de curta eficiência)
264/TCP,UDP BGMP, Border Gateway Multicast Protocol
311/TCP Apple Server-Admin-Tool, Workgroup-Manager-Tool, (Ferramenta de gerenciamento de workgroup)
318/TCP,UDP TSP, Time Stamp Protocol
323/TCP,UDP IMMP, Internet Message Mapping Protocol (Protocolo de mapeamento de mensagem da internet)
383/TCP,UDP HP OpenView HTTPs Operations Agent
366/TCP,UDP SMTP, Simple Mail Transfer Protocol (Protocolo de simples transferência de mail). ODMR, On-Demand Mail Relay
369/TCP,UDP Rpc2portmap Oficial
371/TCP,UDP ClearCase albd Oficial
384/TCP,UDP A Remote Network Server System (Sistema servidor de rede remota)
387/TCP,UDP AURP, AppleTalk Update-based Routing Protocol
389/TCP,UDP LDAP (Lightweight Directory Access Protocol)(Protocolo de acesso a diretório lightweight) Oficial
401/TCP,UDP UPS Uninterruptible Power Supply (Suprimento de potência Ininterruptível) Oficial
411/TCP Direct Connect (Rede de conexão direta, Conexão direta) Hub port Não-oficial
412/TCP Direct Connect Client-To-Client port Não-oficial
427/TCP,UDP SLP (Service Location Protocol) (Protocolo de serviço de localização) Não-oficial
443/TCP HTTPSHTTP Protocol over TLS/SSL (transmissão segura)(Cama de transporte seguro) Oficial
444/TCP,UDP SNPP, Simple Network Paging Protocol (Protocolo simples de paging de rede)
445/TCP Microsoft-DS (Active Directory, Windows shares, Sasser (vírus), Agobot, Zobotworm Oficial
445/UDP Microsoft-DS SMB (Sevidor bloqueador de mensagem) file sharing Oficial
464/TCP,UDP Kerberos Change/Set password Oficial
465/TCP SMTP over SSL – Conflito registrado com protocolo Cisco Conflito
500/TCP,UDP ISAKMP, IKE-Internet Key Exchange Oficial
502/TCP,UDP Modbus, Protocol
512/TCP exec, Remote Process Execution (Processo de execução remota)
512/UDP comsat, together with biff: notifica usuários acerca de novos e-mail’s não lidos
513/TCP Login
513/UDP Who
514/TCP rsh protocol(protocolo de shell remoto) – usado para executar linha de comando não interativa em sistema remoto e visualizar a tela de retorno
514/UDP syslog protocol – usado para log do sistema Oficial
515/TCP Line Printer Daemon protocol – usada em servidores de impressão LPD
517/UDP Talk
518/UDP NTalk
520/TCP efs
520/UDP Routing – RIP (Protocolo de informação do roteador) Oficial
513/UDP Router
524/TCP,UDP NetWare Core Protocol (NCP) (Protocolo de core do NetWare) Oicial
525/UDP Timed, Timeserver
530/TCP,UDP RPC (Procedimento de chamada remota) Oficial
531/TCP,UDP AOL Instant Messenger, IRC Mensageiro instantâneo AOL Não-oficial
532/TCP netnews
533/UDP netwall, For Emergency Broadcasts
540/TCP UUCP (Unix-to-Unix Copy Protocol) Oficial
542/TCP,UDP commerce (Commerce Applications) Oficial
543/TCP klogin, Kerberos login
544/TCP kshell, Kerberos Remote shell
546/TCP,UDP DHCPv6 client
547/TCP,UDP DHCPv6 server
548/TCP AFP (Apple Filing Protocol) (Protocolo de arquivamento da Apple)
550/UDP new-rwho, new-who
554/TCP,UDP RTSP (Real Time Streaming Protocol) (Protocolo de streaming em tempo real) Oficial
556/TCP Remotefs, rfs, rfs_server
560/UDP rmonitor, Remote Monitor (Monitor remoto)
561/UDP monitor
563/TCP,UDP NNTP protocol over TLS/SSL (NNTPS) Oficial
587/TCP email message submission (SMTP) (RFC 2476) Oficial
591/TCP FileMaker 6.0 Web Sharing (alternativa ao HTTP) Oficial
593/TCP,UDP HTTP RPC Ep Map Oficial
604/TCP TUNNEL
631/TCP,UDP IPP, (Internet Printing Protocol) (Protocolo de impressão na internet)
636/TCP,UDP LDAP sobre SSL Oficial
639/TCP,UDP MSDP, Multicast Source Discovery Protocol (Protocolo de descoberta de fonte multicast)
646/TCP LDP, Label Distribution Protocol (Protocolo de distribuição de rótulo)
647/TCP DHCP Failover Protocol
648/TCP RRP, Registry Registrar Protocol (Protocolo de registro)
652/TCP DTCP, Dynamic Tunnel Configuration Protocol (Protocolo de configuração dinâmica de
654/TCP AODV, Ad hoc On-Demand Distance Vector
665/TCP sun-dr, Remote Dynamic Reconfiguration (Reconfiguração remota dinâmica) Não-oficial
666/UDP Doom, First online first-person shooter
674/TCP ACAP, Application Configuration Access Protocol (Protocolo de acesso a configuração da aplicação)
691/TCP MS Exchange Routing Oficial
692/TCP Hyperwave-ISP
694/UDP Linux-HA High availability Heartbeat port Não-oficial
695/TCP IEEE-MMS-SSL
698/TCP OLSR, Optimized Link State Routing
699/TCP Access Network
700/TCP EPP, Extensible Provisioning Protocol (Protocolo de provisionamento extensível)
701/TCP LMP, Link Management Protocol (Protoloco de gerenciamento de link)
702/TCP IRIS over BEEP
706/TCP SILC, Secure Internet Live Conferencing (Conferência ao vivo da seguraça da internet)
711/TCP TDP, Tag Distribution Protocol (Protocolo de distribuição de marcadores)
712/TCP TBRPF, Topology Broadcast based on Reverse-Path Forwarding
720/TCP SMQP, Simple Message Queue Protocol (Protocolo de simples mensagem em fila)
749/TCP, UDP kerberos-adm, Kerberos administration
750/UDP Kerberos version IV
782/TCP Conserver serial-console management server
829/TCP CMP (Certificate Management Protocol)
860/TCP iSCSI
873/TCP rsync File synchronisation protocol Oficial
901/TCP Samba Web Administration Tool (SWAT) Não-oficial
902 VMware Server Console[1] Não-oficial
904 VMware Server Alternate (se a porta 902 estiver em uso – ex: SUSE linux) Não-oficial
911/TCP Network Console on Acid (NCA) – local tty redirection over OpenSSH
981/TCP SofaWare Technologies Remote HTTPS management for firewall devices running embedded Checkpoint Firewall-1 software Não-oficial
989/TCP,UDP FTP Protocol (data) over TLS/SSL Oficial
990/TCP,UDP FTP Protocol (control) over TLS/SSL Oficial
991/TCP,UDP NAS (Netnews Admin System)
992/TCP,UDP Telnet protocol over TLS/SSL Oficial
993/TCP IMAP4 sobre SSL (transmissão segura) Oficial
995/TCP POP3 sobre SSL (transmissão segura) Oficial

[editar] Portas 1024 a 49151

Porta Descrição Status
1058/tcp nim AIX Network Installation Manager Oficial
1059/tcp nimreg Oficial
1080/tcp SOCKS proxy Oficial
1099/tcp RMI Registry Oficial
1099/udp RMI Registry Oficial
1109/tcp Kerberos POP
1167/udp phone, conference calling
1176/tcp Perceptive Automation Indigo home control server Oficial
1182/tcp,udp AcceleNet Oficial
1194/udp OpenVPN Oficial
1198/tcp,udp Cajo project. Transparência dinâmica livre de computação em Java Oficial
1200/udp [[2]Steam Friends Applet] Oficial
1214/tcp Kazaa Oficial
1223/tcp,udp TGP: “TrulyGlobal Protocol” aka “The Gur Protocol” Oficial
1241/tcp,udp Nessus Security Scanner Oficial
1248/tcp NSClient/NSClient++/NC_Net (Nagios) Não-oficial
1270/tcp,udp Microsoft Operations Manager 2005 agent (MOM 2005) Oficial
1311/tcp Dell Open Manage Https Port Não-oficial
1313/tcp Xbiim (Canvii server) Port Não-oficial
1337/tcp WASTE Encrypted File Sharing Program Não-oficial
1352/tcp IBM Lotus Notes/Domino RPC Oficial
1387/tcp Computer Aided Design Software Inc LM (cadsi-lm ) Oficial
1387/udp Computer Aided Design Software Inc LM (cadsi-lm ) Oficial
1414/tcp IBM MQSeries Oficial
1431/tcp RGTP Oficial
1433/tcp,udp Microsoft SQL database system Oficial
1434/tcp,udp Microsoft SQL Monitor Oficial
1494/tcp Citrix Presentation Server ICA Client Oficial
1512/tcp,udp WINS
1521/tcp nCube License Manager Oficial
1521/tcp Oracle database default listener, in future releases official port 2483 Não-oficial
1524/tcp ingresslock, ingress
1526/tcp Oracle database common alternative for listener Não-oficial
1533/tcp IBM Sametime IM – Virtual Places Chat Oficial
1547/tcp Laplink Oficial
1547/udp Laplink Oficial
1550 Gadu-Gadu (Direct Client-to-Client) Não-oficial
1581/udp Combat-net radio Oficial
1589/udp Cisco VQP (VLAN Query Protocol) / VMPS Não-oficial
1627 iSketch Não-oficial
1677/tcp Novell GroupWise clients in client/server access mode
1701/udp l2tp, Layer 2 Tunnelling protocol
1716/tcp America’s Army MMORPG Default Game Port Oficial
1723/tcp Microsoft PPTP VPN Oficial
1723/udp Microsoft PPTP VPN Oficial
1725/udp Valve Steam Client Não-oficial
1755/tcp Microsoft Media Services (MMS, ms-streaming) Oficial
1755/udp Microsoft Media Services (MMS, ms-streaming) Oficial
1761/tcp,udp cft-0 Oficial
1761/tcp Novell Zenworks Remote Control utility Não-oficial
1762-1768/tcp,udp cft-1 to cft-7 Oficial
1812/udp RADIUS – protocolo de autenticação
1813/udp radacct, (RADIUS) protocolo de conta
1863/tcp Windows Live Messenger Oficial
1900/udp Microsoft SSDP. Habilita a descoberta de dispositivos UPnP Oficial
1935/tcp Macromedia Flash Communications Server MX Oficial
1970/tcp,udp Danware Data NetOp Remote Control Oficial
1971/tcp,udp Danware Data NetOp School Oficial
1972/tcp,udp InterSystems Caché Oficial
1975-77/udp Cisco TCO (Documentation) Oficial
1984/tcp Big Brother – network monitoring tool Oficial
1985/udp Cisco HSRP Oficial
2000/udp Cisco SCCP (Skinny) Oficial
2000/tcp Cisco SCCP (Skinny) Oficial
2002/tcp Cisco Secure Access Control Server (ACS) for Windows Não-oficial
2030 Oracle Services for Microsoft Transaction Server Não-oficial
2031/tcp mobrien-chat – Mike O’Brien <mike@mobrien.com> November 2004 Official
2031/udp mobrien-chat – Mike O’Brien <mike@mobrien.com> November 2004 Official
2049/udp nfs, NFS Server Official
2049/udp shilp Official
2053/tcp knetd, Kerberos de-multiplexor
2056/udp Civilization 4 multiplayer Unofficial
2074/tcp Vertel VMF SA (i.e. App.. SpeakFreely) Official
2074/udp Vertel VMF SA (i.e. App.. SpeakFreely) Official
2082/tcp Infowave Mobility Server Official
2082/tcp CPanel, default port Unofficial
2083/tcp Secure Radius Service (radsec) Official
2083/tcp CPanel default SSL port Unofficial
2086/tcp GNUnet Official
2086/tcp WebHost Manager default port Unofficial
2087/tcp WebHost Manager default SSL port Unofficial
2095/tcp CPanel default webmail port Unofficial
2096/tcp CPanel default SSL webmail port Unofficial
2161/tcp ?-APC Agent Official
2181/tcp EForward-document transport system Official
2181/udp EForward-document transport system Official
2200/tcp Tuxanci – Game Server (http://www.tuxanci.org) Unofficial
2219/tcp NetIQ NCAP Protocol Official
2219/udp NetIQ NCAP Protocol Official
2220/tcp NetIQ End2End Official
2220/udp NetIQ End2End Official
2222/tcp DirectAdmin‘s default port Unofficial
2222/udp Microsoft Office X antipiracy network monitor [3] Unofficial
2301/tcp HP System Management Redirect to port 2381 Unofficial
2302/udp ArmA multiplayer (default for game) Unofficial
2302/udp Halo: Combat Evolved multiplayer Unofficial
2303/udp ArmA multiplayer (default for server reporting) (default port for game +1) Unofficial
2305/udp ArmA multiplayer (default for VoN) (default port for game +3) Unofficial
2369/tcp Default port for BMC Software CONTROL-M/Server – Configuration Agent port number – though often changed during installation Unofficial
2370/tcp Default port for BMC Software CONTROL-M/Server – Port utilized to allow the CONTROL-M/Enterprise Manager to connect to the CONTROL-M/Server – though often changed during installation Unofficial
2381/tcp HP Insight Manager default port for webserver Unofficial
2404/tcp IEC 60870-5-104 Official
2427/udp Cisco MGCP Official
2447/tcp ovwdb – OpenView Network Node Manager (NNM) daemon Official
2447/udp ovwdb – OpenView Network Node Manager (NNM) daemon Official
2483/tcp,udp Oracle database listening port for unsecure client connections to the listener, replaces port 1521 Official
2484/tcp,udp Oracle database listening port for SSL client connections to the listener Official
2546/tcp,udp Vytal Vault – Data Protection Services Unofficial
2593/tcp,udp RunUO – Ultima Online Server (http://www.runuo.com) Unofficial
2598/tcp new ICA – when Session Reliability is enabled, TCP port 2598 replaces port 1494 Unofficial
2612/tcp,udp QPasa from MQSoftware (http://www.mqsoftware.com) Official
2710/tcp XBT Bittorrent Tracker Unofficial
2710/udp XBT Bittorrent Tracker experimental UDP tracker extension Unofficial
2710/tcp Knuddels.de Unofficial
2735/tcp NetIQ Monitor Console Official
2735/udp NetIQ Monitor Console Official
2809/tcp corbaloc:iiop URL, per the CORBA 3.0.3 specification.Also used by IBM WebSphere Application Server Node Agent Official
2809/udp corbaloc:iiop URL, per the CORBA 3.0.3 specification.
2944/udp Megaco Text H.248 Unofficial
2945/udp Megaco Binary (ASN.1) H.248 Unofficial
2948/tcp WAP-push Multimedia Messaging Service (MMS) Official
2948/udp WAP-push Multimedia Messaging Service (MMS) Official
2949/tcp WAP-pushsecure Multimedia Messaging Service (MMS) Official
2949/udp WAP-pushsecure Multimedia Messaging Service (MMS) Official
2967/tcp Symantec AntiVirus Corporate Edition Unofficial
3000/tcp Miralix License server Unofficial
3000/udp Distributed Interactive Simulation (DIS), modifiable default port Unofficial
3001/tcp Miralix Phone Monitor Unofficial
3002/tcp Miralix CSTA Unofficial
3003/tcp Miralix GreenBox API Unofficial
3004/tcp Miralix InfoLink Unofficial
3006/tcp Miralix SMS Client Connector Unofficial
3007/tcp Miralix OM Server Unofficial
3050/tcp,udp gds_db (Interbase/Firebird) Official
3074/tcp,udp Xbox Live Official
3128/tcp HTTP used by web caches and the default port for the Squid cache Official
3260/tcp iSCSI target Official
3305/tcp,udp ODETTE-FTP Official
3306/tcp,udp MySQL Database system Official
3333/tcp Network Caller ID server Unofficial
3389/tcp Microsoft Terminal Server (RDP) officially registered as Windows Based Terminal (WBT) Official
3396/tcp Novell NDPS Printer Agent Official
3689/tcp DAAP Digital Audio Access Protocol used by Apple’s iTunes Official
3690/tcp Subversion version control system Official
3724/tcp World of Warcraft Online gaming MMORPG Official
3784/tcp Ventrilo VoIP program used by Ventrilo Official
3785/udp Ventrilo VoIP program used by Ventrilo Official
3872/tcp Oracle Management Remote Agent Unofficial
3900/tcp Unidata UDT OS udt_os Official
3945/tcp Emcads server service port, a Giritech product used by G/On Official
4007/tcp PrintBuzzer printer monitoring socket server Unofficial
4089/udp OpenCORE Remote Control Service Official
4089/tcp OpenCORE Remote Control Service Official
4093/udp PxPlus Client server interface ProvideX Official
4093/tcp PxPlus Client server interface ProvideX Official
4100 WatchGuard Authentication Applet – default port Unofficial
4111/tcp,udp Xgrid Official
4111/tcp Microsoft Office SharePoint Portal Server – default administration port Unofficial
4226/tcp,udp Aleph One (computer game) Unofficial
4224/tcp Cisco CDP Cisco discovery Protocol ???
4569/udp Inter-Asterisk eXchange Unofficial
4662/tcp eMule – port often used Unofficial
4662/tcp OrbitNet Message Service Official
4664/tcp Google Desktop Search Unofficial
4672/udp eMule – port often used Unofficial
4894/tcp LysKOM Protocol A Official
4899/tcp Radmin remote administration tool (program sometimes used as a Trojan horse) Official
5000/tcp commplex-main Official
5000/tcp UPnP – Windows network device interoperability Unofficial
5001/tcp Slingbox and Slingplayer Unofficial
5003/tcp FileMaker Filemaker Pro Official
5004/udp RTP Real-time Transport Protocol Official
5005/udp RTP Real-time Transport Protocol Official
5050/tcp Yahoo! Messenger Yahoo! Messenger Official
5051/tcp ita-agent Symantec Intruder Alert Official
5060/tcp Session Initiation Protocol (SIP) Official
5060/udp Session Initiation Protocol (SIP) Official
5061/tcp Session Initiation Protocol (SIP) over Transport Layer Security (TLS) Official
5093/udp SPSS License Administrator (SPSS) Official
5104/tcp IBM NetCOOL / IMPACT HTTP Service Unofficial
5121 Neverwinter Nights and its mods, such as Dungeon Eternal X Unofficial
5190/tcp ICQ, AOL Instant Messenger e MSN Messenger Official
5222/tcp XMPP/Jabber – client connection Official
5223/tcp XMPP/Jabber – default port for SSL Client Connection Unofficial
5269/tcp XMPP/Jabber – server connection Official
5351/tcp,udp NAT Port Mapping Protocol – client-requested configuration for inbound connections through network address translators Official
5353/udp mDNS – multicastDNS
5402/tcp,udp StarBurst AutoCast MFTP Official
5405/tcp,udp NetSupport Manager Official
5432/tcp PostgreSQL database system Official
5445/udp Cisco Vidéo VT Advantage ???
5495/tcp Applix TM1 Admin server Unofficial
5498/tcp Hotline tracker server connection Unofficial
5499/udp Hotline tracker server discovery Unofficial
5500/tcp VNC remote desktop protocol – for incoming listening viewer, Hotline control connection Unofficial
5501/tcp Hotline file transfer connection Unofficial
5517/tcp Setiqueue Proxy server client for SETI@Home project Unofficial
5555/tcp Freeciv multiplay port for versions up to 2.0, Hewlett Packard Data Protector, SAP Unofficial
5556/tcp Freeciv multiplay port Official
5631/tcp Symantec pcAnywhere Official
5666/tcp NRPE (Nagios) Unofficial
5667/tcp NSCA (Nagios) Unofficial
5800/tcp VNC remote desktop protocol – for use over HTTP Unofficial
5814/tcp,udp Hewlett-Packard Support Automation (HP OpenView Self-Healing Services) Official
5900/tcp VNC remote desktop protocol (used by ARD) Official
6000/tcp X11 – used between an X client and server over the network Official
6001/udp X11 – used between an X client and server over the network Official
6005/tcp Default port for BMC Software CONTROL-M/Server – Socket Port number used for communication between CONTROL-M processes – though often changed during installation Unofficial
6050/tcp Brightstor Arcserve Backup Exec Unofficial
6051/tcp Brightstor Arcserve Backup Exec Unofficial
6112/tcp “dtspcd” – a network daemon that accepts requests from clients to execute commands and launch applications remotely Official
6112/tcp Blizzard‘s Battle.net gaming service, ArenaNet gaming service Unofficial
6129/tcp Dameware Remote Control Unofficial
6257/udp WinMX (see also 6699) Unofficial
6346/tcp,udp gnutella-svc (FrostWire, Limewire, Bearshare, etc.) Official
6347/tcp,udp gnutella-rtr Official
6502/tcp,udp Danware Data NetOp Remote Control Unofficial
6522/tcp Gobby (and other libobby-based software) Unofficial
6543/udp Jetnet – default port that the Paradigm Research & Development Jetnet protocol communicates on Unofficial
6566/tcp SANE (Scanner Access Now Easy) – SANE network scanner daemon Unofficial
6619/tcp,udp ODETTE-FTP over TLS/SSL Official
6665-6669/tcp Internet Relay Chat Official
6679/tcp IRC SSL (Secure Internet Relay Chat) – port often used Unofficial
6697/tcp IRC SSL (Secure Internet Relay Chat) – port often used Unofficial
6699/tcp WinMX (see also 6257) Unofficial
6881-6999/tcp,udp BitTorrent full range of ports used most often Unofficial
6891-6900/tcp,udp Windows Live Messenger (File transfer) Official
6901/tcp,udp Windows Live Messenger (Voice) Official
6969/tcp acmsoda Official
6969/tcp BitTorrent tracker port Unofficial
7000/tcp Default port for Azureus‘s built in HTTPS Bittorrent Tracker Unofficial
7001/tcp Default port for BEA WebLogic Server‘s HTTP server – though often changed during installation Unofficial
7002/tcp Default port for BEA WebLogic Server‘s HTTPS server – though often changed during installation Unofficial
7005/tcp,udp Default port for BMC Software CONTROL-M/Server and CONTROL-M/Agent’s – Agent to Server port though often changed during installation Unofficial
7006/tcp,udp Default port for BMC Software CONTROL-M/Server and CONTROL-M/Agent’s – Server to Agent port though often changed during installation Unofficial
7010/tcp Default port for Cisco AON AMC (AON Management Console) [4] Unofficial
7171/tcp Tibia
7312/udp Sibelius License Server port Unofficial
7777/tcp Default port used by Windows backdoor program tini.exe Unofficial
8000/tcp iRDMI – often mistakenly used instead of port 8080 (The Internet Assigned Numbers Authority (iana.org) officially lists this port for iRDMI protocol) Official
8000/tcp Common port used for internet radio streams such as those using SHOUTcast Unofficial
8002/tcp Cisco Systems Unified Call Manager Intercluster Port
8008/tcp HTTP Alternate Official
8008/tcp IBM HTTP Server default administration port Unofficial
8010/tcp XMPP/Jabber File transfers Unofficial
8074/tcp Gadu-Gadu Unofficial
8080/tcp HTTP Alternate (http_alt) – commonly used for web proxy and caching server, or for running a web server as a non-root user Official
8080/tcp Jakarta Tomcat Unofficial
8086/tcp HELM Web Host Automation Windows Control Panel Unofficial
8086/tcp Kaspersky AV Control Center TCP Port Unofficial
8087/tcp Hosting Accelerator Control Panel Unofficial
8087/udp Kaspersky AV Control Center UDP Port Unofficial
8090/tcp Another HTTP Alternate (http_alt_alt) – used as an alternative to port 8080 Unofficial
8118/tcp Privoxy web proxy – advertisements-filtering web proxy Official
8087/tcp SW Soft Plesk Control Panel Unofficial
8200/tcp GoToMyPC Unofficial
8220/tcp Bloomberg Unofficial
8222 VMware Server Management User Interface (insecure web interface)[2]. See also, port 8333 Unofficial
8291/tcp Winbox – Default port on a MikroTik RouterOS for a Windows application used to administer MikroTik RouterOS Unofficial
8294/tcp Bloomberg Unofficial
8333 VMware Server Management User Interface (secure web interface)[3]. See also, port 8222 Unofficial
8400 Commvault Unified Data Management [4]. Official
8443/tcp SW Soft Plesk Control Panel Unofficial
8500/tcp ColdFusion Macromedia/Adobe ColdFusion default Webserver port Unofficial
8767 TeamSpeak – Default UDP Port Unofficial
8880 WebSphere Application Server SOAP Connector port
8888/tcp,udp NewsEDGE server Official
8888/tcp Sun Answerbook dwhttpd server (deprecated by docs.sun.com) Unofficial
8888/tcp GNUmp3d HTTP music streaming and web interface port Unofficial
9000/tcp Buffalo LinkSystem web access Unofficial
9001 cisco-xremote router configuration Unofficial
9001 Tor network default port Unofficial
9009 Pichat Server – P2P chat software de servidor Official
9043/tcp WebSphere Application Server Administration Console secure port
9060/tcp WebSphere Application Server Administration Console
9100/tcp Jetdirect HP Print Services Official
9101 Bacula Director Official
9102 Bacula File Daemon Official
9103 Bacula Storage Daemon Official
9535/tcp man, Remote Man Server
9535 mngsuite – Management Suite Remote Control Official
9800/tcp,udp WebDav Source Port Official
9800 WebCT e-learning portal Unofficial
9999 Hydranode – edonkey2000 telnet control port Unofficial
9999 Urchin Web Analytics Unofficial
10000 Webmin – web based Linux admin tool Unofficial
10000 BackupExec Unofficial
10008 Octopus Multiplexer – CROMP protocol primary port, hoople.org Official
10050/udp Zabbix-Server
10051/udp Zabbix-Agent
10113/tcp NetIQ Endpoint Official
10113/udp NetIQ Endpoint Official
10114/tcp NetIQ Qcheck Official
10114/udp NetIQ Qcheck Official
10115/tcp NetIQ Endpoint Official
10115/udp NetIQ Endpoint Official
10116/tcp NetIQ VoIP Assessor Official
10116/udp NetIQ VoIP Assessor Official
10480 SWAT 4 Dedicated Server Unofficial
11235 Savage:Battle for Newerth Server Hosting Unofficial
11294 Blood Quest Online Server Unofficial
11371 OpenPGP HTTP Keyserver Official
11576 IPStor Server management communication Unofficial
12345 NetBus – remote administration tool (often Trojan horse). Also used by NetBuster. Little Fighter 2 (TCP). Unofficial
12975/tcp LogMeIn Hamachi (VPN tunnel software;also port 32976)
13720/tcp Symantec NetBackup – bprd
13721/tcp Symantec NetBackup]] – bpdbm
13724/tcp Symantec Network Utility – vnet
13782/tcp Symantec NetBackup – bpcd
13783/tcp Symantec VOPIED protocol
14567/udp Battlefield 1942 e mods Não-oficial
15000/tcp Wesnoth
15567/udp Battlefield Vietnam and mods Não-oficial
15345/udp XPilot Official
16384/udp Iron Mountain Digital – online backup Não-oficial
16567/udp Battlefield 2 and mods Unofficial
19226/tcp Panda Software AdminSecure Communication Agent Não-oficial
19813/tcp 4D database Client Server Communication Não-oficial
20000 Usermin – web based user tool Oficial
20720/tcp Symantec i3 Web GUI server Não-oficial
22347/tcp,udp WibuKey – default port for WibuKey Network Server of WIBU-SYSTEMS AG Oficial
22350/tcp,udp CodeMeter – default port for CodeMeter Server of WIBU-SYSTEMS AG Oficial
24800 Synergy: keyboard/mouse sharing software Não-oficial
24842 StepMania: Online: Dance Dance Revolution Simulator Não-oficial
25999/tcp Xfire ?
26000/tcp,udp id Software‘s Quake server, Oficial
26000/tcp CCP‘s EVE Online Online gaming MMORPG, Não-oficial
27000/udp (through 27006) id Software‘s QuakeWorld master server Não-oficial
27010 Half-Life and its mods, such as Counter-Strike Não-oficial
27015 Half-Life and its mods, such as Counter-Strike Não-oficial
27374 Sub7‘s default port. Most script kiddies do not change the default port. Não-oficial
27500/udp (through 27900) id Software‘s QuakeWorld Não-oficial
27888/udp Kaillera server Não-oficial
27900 (through 27901) Nintendo Wi-Fi Connection Não-oficial
27901/udp (through 27910) id Software‘s Quake II master server Não-oficial
27960/udp (through 27969) Activision‘s Enemy Territory and id Software‘s Quake III Arena e Quake III Não-oficial
28910 Nintendo Wi-Fi Connection Não-oficial
28960 Call of Duty 2 Common Call of Duty 2 port – (PC Version) Não-oficial
29900 (through 29901) Nintendo Wi-Fi Connection Não-oficial
29920 Nintendo Wi-Fi Connection Não-oficial
30000 Pokemon Netbattle Não-oficial
30564/tcp Multiplicity: keyboard/mouse/clipboard sharing software Não-oficial
31337/tcp Back Orifice – remote administration tool (often Trojan horse) Não-oficial
31337/tcp xc0r3 – xc0r3 security antivir port Não-oficial
31415 ThoughtSignal – Server Communication Service (often Informational) Não-oficial
31456-31458/tcp TetriNET ports (in order: IRC, game, and spectating) Não-oficial
32245/tcp MMTSG-mutualed over MMT (encrypted transmission) Não-oficial
33434 traceroute Oficial
37777/tcp Digital Video Recorder hardware Não-oficial
36963 Counter Strike 2D porta multiplayer Não-oficial
40000 SafetyNET p Oficial
43594-43595/tcp RuneScape Não-oficial
47808 BACnet Building Automation and Control Networks Oficial

Portas 49152 to 65535

Por definição, não pode haver registro de portas neste intervalo dinâmico. =D [5] tetes 1277

Endereços Multi cast

228.1.1.20/IP BACnet EPI

How can I change a language in windows 7 professional

Devido a um problema com uma aplicação que consulta uma função que chama a string “False”, chegamos a uma alteração ocorrida no Windows 7 em relação ao Windows XP ou versões anteriores: O Windows 7 traduz o código das suas aplicações em vbs forçando por exemplo à aplicação a aceitar a string “Falso” ao invés de “False”.

Com o uso do Windows 7 professional português chegamos a um empasse: por default não conseguiriamos alterar o idioma do nosso sistema operacional por outro lado não temos como mexer no código fonte da aplicação.

Abaixo decrevo a solução utilizada nesse caso: Alterando o idioma do Windows 7 professional de Português para Inglês (ou de Inglês para Português caso desejável)

1 – Baixar o pacote de Idioma para Windows 7 English em c:\package
2 – Executar o prompt de comando do Windows 7 professional como administrador
3 – Executar o comando:
dism.exe /online /add-package /packagepath:c:\package\lp.cab
4 – Executar o comando:
bcdedit /set {current} locale pt-br
5 – Executar o comando:
bcdboot %WinDir% /l pt-br
6 – Editar o registro do sistema (regedit.exe) deletando as chaves correspondentes ao idioma que você não deseja mais ter instalado na sua estação. No nosso caso foi necessário apagar a entrada pt-BR deixando a entrada en-US para que nosso sistema operacional fique em ingles:
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\MUI\UILanguages
obs: pode have mais de uma entrada para a entrada CurrentControlSet, navegar e realizar o procedimento em cada uma
7 – Reiniciar a maquina e aproveitar as novas configurações do windows aplicadas

Email VBS Completo

janeiro 20, 2011

Um exemplo de um script em vbs que enviara um email simples somente texto
Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Example CDO Message”
objMessage.From = “me@my.com
objMessage.To = “test@paulsadowski.com
objMessage.TextBody = “This is some sample message text.”
objMessage.Send
——————————————————————————–
HTML email.

Note the use of the Cc & Bcc properties to send using Blind Carbon Copy (Bcc) and Carbon Copy (Cc).
These properties can be used with either text or HTML email.

Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Example CDO Message”
objMessage.From = “me@my.com
objMessage.To = “test@paulsadowski.com
‘The line below shows how to send using HTML included directly in your script
objMessage.HTMLBody = “<h1>This is some sample message html.</h1>”

‘The line below shows how to send a webpage from a remote site
‘objMessage.CreateMHTMLBody “http://www.paulsadowski.com/wsh/”

‘The

line below shows how to send a webpage from a file on your machine
‘objMessage.CreateMHTMLBody “file://c|/temp/test.htm”

objMessage.Bcc

= “you@your.com
objMessage.Cc = “you2@your.com
objMessage.Send
——————————————————————————–

Enviando um email com anexo.
By repeating the .AddAttachment method you can attach more than one file.
When attaching files keep in mind that your recipient may be limited in their
ability to receive files above a certain size. Many ISPs limit emails to 8 or 10MB each.
You should not send large files to anyone before obtaining their permission.

Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Example CDO Message”
objMessage.From = “me@my.com
objMessage.To = “test@paulsadowski.com
objMessage.TextBody = “This is some sample message text.”
objMessage.AddAttachment “c:\temp\readme.txt”
objMessage.Send
——————————————————————————–

Enviando email formato texto usando um remote server.
Sometimes you need to send email using another server. It may be required by your
company, or your ISP may be blocking the SMTP port, or your dynamic IP may be
blacklisted for being in a dynamic pool.

This code shows you how to use a remotes server rather than the SMTP server
on your own machine.

Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Example CDO Message”
objMessage.From = “me@my.com
objMessage.To = “test@paulsadowski.com
objMessage.TextBody = “This is some sample message text.”

‘==This section provides the configuration information for the remote SMTP server.
‘==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusing“) = 2

‘Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserver“) = “smtp.myserver.com”

‘Server port (typically 25)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserverport“) = 25

objMessage.Configuration.Fields.Update

‘==End remote SMTP server configuration section==

objMessage.Send
——————————————————————————–

Sending a text email using authentication against a remote SMTP server.
More and more administrators are restricting access to their servers to control spam or limit
which users may utilize the server. This example shows you how to use basic authentication,
the most commonly used authentication method, when the SMTP server you are using requires it.

This code is slightly more complex but not very difficult to understand or work with.

Const cdoSendUsingPickup = 1 ‘Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 ‘Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 ‘Do not authenticate
Const cdoBasic = 1 ‘basic (clear-text) authentication
Const cdoNTLM = 2 ‘NTLM

Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Example CDO Message”
objMessage.From = “””Me”” <me@my.com>”
objMessage.To = “test@paulsadowski.com
objMessage.TextBody = “This is some sample message text..” & vbCRLF & “It was sent using SMTP authentication.”

‘==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusing“) = 2

‘Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserver“) = “mail.your.com”

‘Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpauthenticate“) = cdoBasic

‘Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusername“) = “youruserid”

‘Your password on the SMTP server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendpassword“) = “yourpassword”

‘Server port (typically 25)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserverport“) = 25

‘Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpusessl“) = False

‘Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout“) = 60

objMessage.Configuration.Fields.Update

‘==End remote SMTP server configuration section==

objMessage.Send
——————————————————————————–

Send using authentication against a remote server with a file attachment and return receipt and

delivery disposition notification requests. In order to use the Delivery Status Notifications (Return
Receipt and Delivery Disposition requests) we need to create a reference to the CDO Configuration
object in addition to the CDO Message object and set a small number of properties. You must
use cdoSendUsingPort (network connection) and not the SMTP server’s pickup directory
(cdoSendUsingPickup).

Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2 ‘Must use this to use Delivery Notification
Const cdoAnonymous = 0
Const cdoBasic = 1 ‘ clear text
Const cdoNTLM = 2 ‘NTLM
‘Delivery Status Notifications
Const cdoDSNDefault = 0 ‘None
Const cdoDSNNever = 1 ‘None
Const cdoDSNFailure = 2 ‘Failure
Const cdoDSNSuccess = 4 ‘Success
Const cdoDSNDelay = 8 ‘Delay
Const cdoDSNSuccessFailOrDelay = 14 ‘Success, failure or delay

set objMsg = CreateObject(“CDO.Message”)
set objConf = CreateObject(“CDO.Configuration”)

Set objFlds = objConf.Fields
With objFlds
.Item(“http://schemas.microsoft.com/cdo/configuration/sendusing“) = cdoSendUsingPort
.Item(“http://schemas.microsoft.com/cdo/configuration/smtpserver“) = “mail.yourhost.com”
.Item(“http://schemas.microsoft.com/cdo/configuration/smtpauthenticate“) = cdoBasic
.Item(“http://schemas.microsoft.com/cdo/configuration/sendusername“) = “your-username”
.Item(“http://schemas.microsoft.com/cdo/configuration/sendpassword“) = “your-password”
.Update
End With

strBody = “This is a sample message.” & vbCRLF
strBody = strBody & “It was sent using CDO.” & vbCRLF

With objMsg
Set .Configuration = objConf
.To = “test@paulsadowski.com
.From = “me@my.com
.Subject = “This is a CDO test message”
.TextBody = strBody
‘use .HTMLBody to send HTML email.
.Addattachment “c:\temp\Scripty.zip”
.Fields(“urn:schemas:mailheader:disposition-notification-to”) = “me@my.com
.Fields(“urn:schemas:mailheader:return-receipt-to”) = “me@my.com
.DSNOptions = cdoDSNSuccessFailOrDelay
.Fields.update
.Send
End With
——————————————————————————–
In real world usage you’ll most likely want to load the text of the email from a file on your
computer. The sample code below shows you how to do this. The text can be either
plain text or HTML as needed.Our example assumes your text is in the file
C:\Temp\MyEmail.txt. This code loads the entire content of that file into a variable,
here named BodyText which you can then reference in your CDO code. We
assume BodyText is in the scope of your CDO code.

‘These constants are defined to make the code more readable
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject(“Scripting.FileSystemObject”)
‘Open the file for reading
Set f = fso.OpenTextFile(“c:\temp\MyEmail.txt”, ForReading)
‘The ReadAll method reads the entire file into the variable BodyText
BodyText = f.ReadAll
‘Close the file
f.Close
Set f = Nothing
Set fso = Nothing

Once the text is loaded you can use it in your CDO code something like this…

objMessage.TextBody = BodyText
or
objMessage.HTMLBody = BodyText
——————————————————————————–

Load Recipients from a Database
As is the case with most thing in Windows there are many ways to accomplish a task. This is one method of many.

Our database is an Access format database that resides on the local disk. The table in our database that we are     interested in is called Customers and each record consists of 4 fields named “ID”, “Name”, “Email”, and “Customer”, where ID is an autogenerated index, Name is the full name of our customer, Email is the customer’s email address and Customer is their customer identification number.

We are only interested here in two fields, Name and Email.

ID Name Email Customer
1 Bob Jones bjones@test.com 12345
2 Jane Smith jsmith@test.net 12346

Set OBJdbConnection = CreateObject(“ADODB.Connection”)
OBJdbConnection.Open “DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\Acme Inc\Databases\Customers.mdb”
SQLQuery = “SELECT Name, Email FROM Customers”
Set Result = OBJdbConnection.Execute(SQLQuery)
if Not Result.EOF then
Do While Not Result.EOF
SendMail Result(“Name”), Result(“Email”)
Result.MoveNext
Loop
end if
OBJdbConnection.Close

As you can see the code is simple. We create a database connection object then open the database and query it for the Name and Email fields of each customer. Those values are passed for each customer to a subroutine that sends the customer an email.

Sub SendMail(TheName, TheAddress)
Dim objMessage, Rcpt

Rcpt = Chr(34) & TheName & Chr(34) & “<” & TheAddress & “>”
Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “This Month’s Sales”
objMessage.From = “””Acme Sales”” <me@my.com>”
objMessage.To = Rcpt
objMessage.HTMLBody = TextBody
objMessage.Send

End Sub
If you are not accustomed to working with databases then this may have seemed a daunting task but as you can see from the code above, it’s really quite simple.

We’ve already covered sending email so I’ll just mention that this subroutine assumes the HTML body text is a variable called TextBody (see Loading email body text from a file)

Also we format the recipient’s address in the standard format of “Name” <email@address.net> for a more professional look to the recipient..

Remarks
As previously stated there are many ways to do this. I’ve presented one simple method here. Your own use may be with an ODBC connection; it may use mySQL or SQL Server; it may include personalization of the email body text and more. My intent here was to provide you with the basics to get you started.
——————————————————————————–

Load data from an Excel Worksheet

There may be times when you want to generate an email using data from an application such as Excel. This is one simple illustration of how that could be done.
In our example we will be using a Workbook with three columns starting at column A row 1. Each row represents one product in our inventory and the three columns contains the following data about each item: Part Number, Name of Part, Number of Items in Inventory. Graphically our Workbook looks like this:

Part Name Stock
4583586 Fliggalhopper 452
5898547 Looplonger 293

This particular script works by walking down each cell of column 1 till it finds an empty cell which it assumes is the end of the list of entries. If your file may contain empty cells then you can use the Worksheet’s UsedRange.Rows.Count property to find the last row in which an entry is made. Your code would then use a for loop something like this:

rowLast = objSheet.UsedRange.Rows.Count
for x = rowStart to rowLast
‘ do stuff
next

Function GetData()
Dim x, strTemp, objExcel, objWB

Set objExcel = Wscript.CreateObject(“Excel.Application”)
Set objWB = objExcel.Workbooks.Open(“c:\Acme Inc\Workbooks\Test.xls”)
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

‘ Make Excel visible while debugging
objExcel.Visible = True

‘ This is the row of our first cell.
x = 1

do while objExcel.Cells(x, 1).Value <> “”
strTemp = strTemp & objExcel.Cells(x, 1).Value & _
Space(10 – Len(objExcel.Cells(x, 1).Value))
strTemp = strTemp & objExcel.Cells(x, 2).Value & _
Space(50 – Len(objExcel.Cells(x, 2).Value))
strTemp = strTemp & objExcel.Cells(x, 3).Value & vbCRLF
x = x + 1
loop

‘ This will prevent Excel from prompting us to save the workbook.
objExcel.ActiveWorkbook.Saved = True

‘ Close the workbook and exit the application.
objWB.Close
objExcel.Quit

set objWB = Nothing
set objExcel = Nothing

GetData = strTemp
End Function

‘ This is our main function.
Dim strBody

Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Inventory report for ” & Date
objMessage.From = “me@my.com
objMessage.To = “bossman@my.com
strBody = “Part” & Space(6) & “Item” & Space(46) & “Stock” & vbCRLF

‘ Here we call the function GetData to populate the body text.
strBody = strBody & GetData

objMessage.TextBody = strBody
objMessage.Send

The code above will produce an email that looks something like this:
To: bossman@my.com
From: me@my.com
Subject: Inventory report for 3/19/2005

Part      Item                                              Stock
4583586   Fliggalhopper                                     452
5898547   Looplonger                                        293
——————————————————————————–
This sample sends a simple text email via GMail servers.

It’s like any other mail but requires that you set the SMTP Port to 465 and tell CDO to use SSL

Const cdoSendUsingPickup = 1 ‘Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 ‘Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 ‘Do not authenticate
Const cdoBasic = 1 ‘basic (clear-text) authentication
Const cdoNTLM = 2 ‘NTLM

Set objMessage = CreateObject(“CDO.Message”)
objMessage.Subject = “Example CDO Message”
objMessage.From = “””Me”” <test@gmail.com>”
objMessage.To = “me@my.com
objMessage.TextBody = “This is some sample message text..” & vbCRLF & “It was sent using SMTP authentication and SSL.”

‘==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusing“) = 2

‘Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserver“) = “smtp.gmail.com”

‘Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpauthenticate“) = cdoBasic

‘Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendusername“) = “You@gmail.com”

‘Your

password on the SMTP server
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/sendpassword“) = “YourPassword”

‘Server port (typically 25)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpserverport“) = 465

‘Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpusessl“) = True

‘Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
(“http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout“) = 60

objMessage.Configuration.Fields.Update

‘==End remote SMTP server configuration section==

objMessage.Send

Um PDF muito interessante sobre os padrões e princípios de Cabeamento Estruturado.

http://www.dit.gov.bt/guidelines/cablingstandard.pdf

Abaixo, um link, com um pequeno resumo sobre cabeamento estruturado:

Clique aqui

Entendendo bits e bytes

dezembro 27, 2010

Explicando o conceito de bits e bytes:

Segue, abaixo, um link bem interessante sobre o assunto:

Clique aqui