' --------------------------------------------- '
' -----  Jakob H. Heidelberg @ 17-01-2008 ----- '
' -----  http://heidelbergit.blogspot.com ----- '
' ----- - - - - - - - - - - - - - - - - - ----- '
' -----           Version: 1.03           ----- '
' -----    Last rev. date: 17-01-2008     ----- '
' --------------------------------------------- '
' NOTES:
'-------
' * For protection against anonymous users (The Onion Ring = Tor)
' * Needs "AddComputersToComputerSet.vbs" script from: 
'   -> http://www.microsoft.com/technet/isa/2006/development/computerset.mspx
' * Script for downloading the latest Tor server list
'   and importing IPs into Computer Set on ISA servers
'   can be scheduled to run automatically.

Option Explicit
Dim strTorWeb : strTorWeb = "http://proxy.org/tor_blacklist.txt"
Dim strTorLst : strTorLst = "TorList.txt"
Dim strISALst : strISALst = "ISAList.txt"
Dim strISASet : strISASet = "TOR-SERVERS"
Dim strISAAdd : strISAAdd = "AddComputersToComputerSet.vbs"
Dim strReturn : strReturn = DownloadList(strTorWeb)

DeleteFile strTorLst             'Delete old Tor List
DeleteFile strISALst             'Delete old ISA List
WriteTList strReturn , strTorLst 'Writes new Tor List
WriteIList strTorLst , strISALst 'Writes new ISA List
PutIntoISA strISAAdd, strISALst, strISASet

MsgBox "done"

Function DownloadList(LINK)
' Author: Jakob H. Heidelberg
' Sub   : DownloadList / v1.0
' Usage : DownloadList("HTTP://www.xxx.com/file.yyy")
 'Note  : This function gets the list from the web (HTTP)
  With CreateObject("MSXML2.XMLHTTP")
  .open "GET", LINK, False
  .send
  DownloadList = .responseText
  End With
End Function

Sub WriteTList(TEXT,PATH)
' Author: Jakob H. Heidelberg
' Sub   : WriteTList / v1.0
' Usage : WriteTList("TEXT STRING","FILE PATH")
' Note  : This function creates and writes the list
 Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
 If Not objFSO.FileExists(PATH) Then objFSO.CreateTextFile(PATH)
 Dim LogFileEdit : Set LogFileEdit = objFSO.OpenTextFile(PATH, 8, True) '8 = Append
 LogFileEdit.Write(TEXT)
 LogFileEdit.Close
 Set LogFileEdit = Nothing
 Set objFSO = Nothing
End Sub

Sub WriteIList(TORPATH,ISAPATH)
' Author: Jakob H. Heidelberg
' Sub   : WriteIList / v1.0
' Purpose: Go through all lines in TORPATH file, and write stuff to ISAPATH
   Const ForReading = 1
   Dim objFSO, MyFile, sIP, bLineFeed
   bLineFeed = False 'controls linefeed (first line written should not get one)
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set MyFile = objFSO.OpenTextFile(TORPATH, ForReading)
       Do While MyFile.AtEndOfStream <> True
         sIP = GetOnlyIP(MyFile.ReadLine)
         If bLineFeed = True Then
             If Len(sIP) >= 7 Then WriteTList vbNewLine & Replace(sIP,".","-") & vbTab & sIP , ISAPATH
         Else
             If Len(sIP) >= 7 Then
               WriteTList Replace(sIP,".","-") & vbTab & sIP , ISAPATH
               bLineFeed = True
             End If
         End If
       Loop
   Set MyFile = Nothing
   Set objFSO = Nothing
End Sub

Function GetOnlyIP(TEXTSTRING)
' Author: Jakob H. Heidelberg
' Sub   : GetOnlyIP / v1.0
' Purpose: Find the IP address in the TEXTSTRING
  Dim iChars, iChar, sChar, sIP
  iChars = Len(TEXTSTRING)
  For iChar = 1 To iChars
    sChar = Mid(TEXTSTRING,iChar,1)
    If IsNumeric(sChar) Or sChar = "." Then
     sIP = sIP & sChar
    End If
  Next
  GetOnlyIP = sIP
End Function

Sub DeleteFile(FILE)
' Author: Jakob H. Heidelberg
' Sub   : DeleteFile / v1.0
' Usage : DeleteFile("file_path") - Note: Force is on
 Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
  If objFSO.FileExists(FILE) Then objFSO.DeleteFile FILE,True 'Force = True or False
 Set objFSO = Nothing
End Sub

Function PutIntoISA(VBSPATH,LISTPATH,COMPSETNAME)
  Dim objShell : Set objShell = CreateObject("Wscript.Shell")
  PutIntoISA = objShell.Run("CSCRIPT.EXE " & VBSPATH & " " & LISTPATH  & " " & COMPSETNAME,,1)
  Set objShell = Nothing
End Function