'Symantec AntiVirus updater script.

Const WEB_PAGE = "http://securityresponse.symantec.com/avcenter/download/pages/US-N95.html"
Const LINK_TEXT = "-i32.exe</"

Main

Sub Main()
Dim fs, ws, strWebPage, strUrl
	 'Create objects
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")

	 'Download the web page that has the link to this week's file
	Status "Getting web page:"
	Status WEB_PAGE
	strWebPage = GetData(WEB_PAGE)
	
	'Extract the URL from the web page
	strUrl = GetHrefBeforeMarker(strWebPage, LINK_TEXT)
	If strUrl = "" Then
		ws.Popup "The web page no longer has text identifying the location of the intelligent updater file. This script needs to be updated!", 15, "Error"
		Exit Sub
	End If
	strUrl = MakeAbsolute(strUrl, WEB_PAGE)
	
	'Download the intelligent updater
	Status "Downloading intelligent updater:"
	Status strUrl
	If Not SaveWebBinary(strUrl, WScript.ScriptFullName & ".exe") Then
		ws.Popup "Unable to download the file """ & strUrl & """.", 15, "Error"
		Exit Sub
	End If
		
	'Run the intelligent updater
	Status "Running intelligent updater..."
	ws.Run """" & WScript.ScriptFullName & ".exe" & """ /Q", 1, True
	
	'Delete the intelligent updater
	fs.DeleteFile WScript.ScriptFullName & ".exe", True
End Sub

Function GetData(strUrl)
Dim web
Const WinHttpRequestOption_EnableRedirects = 6
	Set web = Nothing
	On Error Resume Next
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	web.Option(WinHttpRequestOption_EnableRedirects) = True
	web.Open "GET", strURL, False
	web.SetRequestHeader "REFERER", strUrl
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.Send
	If web.Status = "200" Then
		GetData = web.ResponseText
	Else
		GetData = ""
	End If
End Function

Function SaveWebBinary(strUrl, strFile) 'As Boolean
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const ForWriting = 2
Dim web, varByteArray, strData, strBuffer, lngCounter, ado
	On Error Resume Next
	'Download the file with any available object
	Err.Clear
	Set web = Nothing
	Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
	If web Is Nothing Then Set web = CreateObject("WinHttp.WinHttpRequest")
	If web Is Nothing Then Set web = CreateObject("MSXML2.ServerXMLHTTP")
	If web Is Nothing Then Set web = CreateObject("Microsoft.XMLHTTP")
	web.Open "GET", strURL, False
	web.SetRequestHeader "REFERER", strUrl
 	web.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
 	web.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
 	web.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
 	web.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
	web.Send
	If Err.Number <> 0 Then
		SaveWebBinary = False
		Set web = Nothing
		Exit Function
	End If
	If web.Status <> "200" Then
		SaveWebBinary = False
		Set web = Nothing
		Exit Function
	End If
	varByteArray = web.ResponseBody
	Set web = Nothing
	'Now save the file with any available method
	On Error Resume Next
	Set ado = Nothing
	Set ado = CreateObject("ADODB.Stream")
	If ado Is Nothing Then
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set ts = fs.OpenTextFile(strFile, ForWriting, True)
		strData = ""
		strBuffer = ""
		For lngCounter = 0 to UBound(varByteArray)
			ts.Write Chr(255 And Ascb(Midb(varByteArray,lngCounter + 1, 1)))
		Next
		ts.Close
	Else
		ado.Type = adTypeBinary
		ado.Open
		ado.Write varByteArray
		ado.SaveToFile strFile, adSaveCreateOverWrite
		ado.Close
	End If
	SaveWebBinary = True
End Function

Function MakeAbsolute(strHref, strCurrentPage)
'Converts strHref from root or relative link to absolute link.
'strCurrentPage MUST be an absolute URL. 
Dim strMakeAbsolute, strRoot
	'Set up working variables
	strMakeAbsolute = strHref
	strRoot = strCurrentPage
	'Is it already absolute?
	If Left(strMakeAbsolute, 7) = "http://" Then
		MakeAbsolute = strMakeAbsolute
		Exit Function
	End If
	'Figure out what the root page is
	If InStr(8, strRoot, "/") <> 0 Then
		'Make the root so it DOES NOT have a trailing slash
		strRoot = Left(strRoot, InStr(8, strRoot, "/") - 1)
	End If
	'Is a root reference used?
	If Left(strMakeAbsolute, 1) = "/" Then
		MakeAbsolute = strRoot & strMakeAbsolute
		Exit Function
	End If
	'A relative link is used (it must be at this point!)
	MakeAbsolute = Left(strCurrentPage, InStrRev(strCurrentPage, "/")) & strMakeAbsolute
End Function

Function GetHrefBeforeMarker(strPage, strMarker)
Dim strUrl
Dim lngMarker
Dim strPeekText
	lngMarker = InStr(strPage, strMarker)
	'Make sure the marker exists
	If lngMarker = 0 Then
		GetHrefBeforeMarker = ""
		Exit Function
	End If
	'Trim everything after the marker
	strPeekText = Left(strPage, lngMarker)
	'See if an "a" tag exists
	If InStrRev(strPeekText, "<a", Len(strPeekText), vbTextCompare) = 0 Then
		GetHrefBeforeMarker = ""
		Exit Function
	End If
	'Trim everything before the "a" tag
	strPeekText = Mid(strPeekText, InStrRev(strPeekText, "<a", Len(strPeekText), vbTextCompare))
	If InStr(strPeekText, ">") = 0 Then
		'The marker is INSIDE the URL we are looking for. Push it to the end of the tag.
		lngMarker = InStr(lngMarker, strPage, ">")
	End If
	'Now we have a marker at or after the end of an "a" tag
	'Trim everything past the marker
	strUrl = Left(strPage, lngMarker)
	'Trim everything before the href tag
	strUrl = Mid(strUrl, InStrRev(strUrl, "href=", Len(strUrl), vbTextCompare) + 5)
	'If we have quotes, use them
	If Left(strUrl, 1) = Chr(34) Then strUrl = Mid(strUrl, 2)
	If InStr(strUrl, Chr(34)) <> 0 Then strUrl = Left(strUrl, InStr(strUrl, Chr(34)) - 1)
	'If we have apostrophes, use them instead of quotes
	If Left(strUrl, 1) = "'" Then strUrl = Mid(strUrl, 2)
	If InStr(strUrl, "'") <> 0 Then strUrl = Left(strUrl, InStr(strUrl, "'") - 1)
	'We might have a leading space. Not sure how, but trim to be safe.
	strUrl = Trim(strUrl)
	'Trim everything past the first tag end
	If InStr(strUrl, ">") <> 0 Then strUrl = Left(strUrl, InStr(strUrl, ">") - 1)
	'Trim everything past the first space
	If InStr(strUrl, " ") <> 0 Then strUrl = Left(strUrl, InStr(strUrl, " "))
	'Trim everything past the first tab
	If InStr(strUrl, vbTab) <> 0 Then strUrl = Left(strUrl, InStr(strUrl, vbTab))
	'That should be all!
	GetHrefBeforeMarker = strUrl
End Function

Sub Status(strMessage)
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
		Wscript.Echo strMessage
	End If
End Sub