mr_unreliable
Thu May 11 12:04:14 CDT 2006
This is a multi-part message in MIME format.
--------------010502000504010601040709
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
hi Dave,
I have attached a sample script, which will get online and
download the daily "Dilbert" cartoon from the Dilbert website.
Your script to retrieve some other stuff from some other site
would probably look similar to this example.
cheers, jw
____________________________________________________________
You got questions? WE GOT ANSWERS!!! ..(but,
no guarantee the answers will be applicable to the questions)
--------------010502000504010601040709
Content-Type: text/plain;
name="wshDilbertRipper_09June03.vbs.txt"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="wshDilbertRipper_09June03.vbs.txt"
' wshDilbertRipper, jw 08June03
'
' --- description block --------------------------
'
' Title: "Dilbert Ripper" (get daily "Dilbert" cartoon)...
'
' Description: this script will get online, and download the
' daily cartoon, as published on the "Official Dilbert"
' website...
'
' Author: mr_unreliable
' Website: none at present
'
' Usage: Use at you own risk, tested on win98se...
'
' --------------------------------------------------------
' Full Disclosure: this script is a DOUBLE plagerization.
' --------------------------------------------------------
' The notion of "ripping" the Dilbert cartoon was
' provided by "Mr. Brownstone", as found on his
' "Virtual Conspiracy" website, (www.virtualconspiracy.com).
' But, Mr. Brownstone's script was written in Perl (ugh!).
' This script (vbScript) was adapted from a demo script
' written by Michael Harris (with subsequent modifications
' by Paul Randall), and found on the vbScript newsgroup...
'
' --- revision history ---------------------------
' 08June03: original attempt...
' 09June03: uh-oh. It (now) appears that the weekday dilbert is
' a gif, but the Sunday dilbert is a jpg (maybe to include color?).
' Anyway, that requires some "adjustments"...
' 09June03: uh-oh. It (now) appears that the filename for the graphic
' is NOT a consistent number of characters, (maybe to throw off
' rippers?). Anyway, a different strategy is used to find the end
' of the file name...
' 06Jan04: save to DESKTOP (instead of wintemp), for easier access...
' --- end of description block -------------------
Option Explicit
' instantiate ActX components here...
Dim xmlHTTP : Set xmlHTTP = CreateObject("Microsoft.XMLHTTP")
Dim adoStream : Set adoStream = CreateObject("adodb.stream")
Dim wshShell : Set wshShell = CreateObject("WScript.Shell")
Dim wshSysEnv : Set wshSysEnv = wshShell.Environment("PROCESS")
' --- end of instantiations ----------------------
'
' --- Module Level Variables and Constants -------
Const sSource = "
http://www.dilbert.com"
Dim sImgTag : sImgTag = "<IMG SRC=""/comics/dilbert/archive/images/dilbert"
' save the dilbert graphic here (was win/temp, now win/desktop)...
' Dim sSavePath : sSavePath = wshSysEnv("TEMP") & "\"
Dim sSavePath : sSavePath = wshShell.SpecialFolders("Desktop") & "\"
Dim iDayOfWeek : iDayOfWeek = Weekday(Date)
Dim sGraphicType : sGraphicType = ".gif" ' weekdays a gif?
if (iDayOfWeek = vbSunday) then sGraphicType = ".jpg"
Dim sSaveName : sSaveName = "TodaysDilbert_" & DateAs_ddMMMyy(Date) & sGraphicType
'
Dim sHTMLPage ' as string (dilbert page as text)
Dim iImgTag ' as long (location of image tag within page)
Dim iImgExt ' as long (location of the file extension)
Dim iSrcStart, iSrcLength ' as long(s), temp vars for extracting imgtag
Dim sImageSource ' as string (location of the graphic)
'
Const bGetAsAsync = False ' wait for response
'
Const adTypeBinary = 1 ' ado typelib constants
Const adModeReadWrite = 3
Const adSaveCreateOverwrite = 2
'
Dim nAns ' as integer
' --- end of declarations and constants ----------
' ================================================
' === MAIN LINE SCRIPT LOGIC HERE ================
' ================================================
' MsgBox("Source URL: " & sSource & vbNewLine _
' & "Save File Dest: " & sSavePath & sSaveName)
' --- discussion -------------------------------
' Getting the Dilbert-of-the-day comic strip, is a "two-step"
' process. First we are downloading the dilbert website
' opening page. Then we search through the page to get the
' image tag for the strip. Then we download the strip.
' Note: the page is retrieved as TEXT, the graphics are
' retrieved as BINARY data...
' --- end of discussion ------------------------
' formulate a request to get the Dilbert website...
xmlHTTP.Open "GET", sSource, bGetAsAsync
xmlHTTP.Send ' send it (to the web, wait for result)
sHTMLPage = xmlHTTP.responseText ' (note: as TEXT)
' --- grumble, grumble, grumble ----------------
' The dilbert page does not seem to be set up for the convenience
' of graphics rippers, i.e., there is no handy "id" for locating
' the url for the graphics. And so, we are using a "brute force"
' method -- searching through the html text for something that
' resembles what we want...
' --- end of grumbling -------------------------
' locate the strip graphic image tag...
iImgTag = Instr(sHTMLPage, sImgTag)
' MsgBox("found imgtag string at: " & CStr(iImgTag))
' get the location of the image source file...
iSrcStart = iImgTag + 10
' uh-oh. Apparently the number of characters in the image name
' is VARIABLE (ugh!), perhaps in order to "throw off" rippers(?).
' So here, make an attempt to find the end of the string,
' by using the (expected) filetype...
iImgExt = Instr(iImgTag, sHTMLPage, sGraphicType)
' MsgBox("found ext at: " & CStr(iImgExt))
iSrcLength = iImgExt - iSrcStart + 4 ' 13 = date field, 4 = ".jpg/.gif"
' extract the location of the image source file...
sImageSource = Mid(sHTMLPage, iSrcStart, iSrcLength)
' addin the "base" url, to form graphics url...
sImageSource = sSource & sImageSource
' MsgBox(sImageSource)
' ----------------------------------------------
' xmlHTTP.onreadystatechange = GetRef("xmlHTTP_ReadyStateChange")
' formulate a request to get the image (i.e., the cartoon strip)...
xmlHTTP.Open "GET", sImageSource, bGetAsAsync
xmlHTTP.Send ' send it (to the web, wait for result)
' MsgBox("Got It!")
With adoStream ' setup and write the graphics file to local disk...
.Type = adTypeBinary ' as BINARY
.Mode = adModeReadWrite
.Open ' the stream
.Write xmlHTTP.responseBody ' write the data (as binary)...
.SaveToFile sSavePath & sSaveName, adSaveCreateOverwrite
.Close ' the stream
End With
' tell user the file was saved...
nAns = MsgBox("Today's Dilbert Strip saved as: " & sSavePath & sSaveName _
& vbCrLf & vbCrLf & " would you like to view it now???", _
vbInformation Or vbYesNo, " < wsh Dilbert Ripper Script > ")
' show the current dilbert cartoon strip now (if desired),
' note: "running" the file will hopefully open it in its
' default opener app, as described in the ms scripting doc: (quote)
' "If a file type has been properly registered to a particular program,
' calling run on a file of that type executes the program. For example,
' if Word is installed on your computer system, calling Run on a *.doc
' file starts Word and loads the document".
' (At least on my system, InternetExplorer is the opener for a "jpg" file).
if (nAns = vbYes) then wshShell.Run sSavePath & sSaveName
Set wshSysEnv = nothing ' clean up
Set wshShell = nothing
set xmlHTTP = nothing
set adoStream = nothing
WScript.Quit
' ================================================
' === SUBROUTINES FOLLOW =========================
' ================================================
Sub xmlHTTP_ReadyStateChange() ' event handler
MsgBox("readystate: " & CStr(xmlHTTP.ReadyState))
End Sub
Function DateAs_ddMMMyy(vDate) ' returns a date in "Military Format"...
Dim sDD, sMMM, sYY ' as string(s)
' get the day (as two digits)
sDD = Right("0" & CStr(Day(vDate)), 2)
sMMM = MonthName(Month(vDate), True) ' abbreviated month
sYY = Right(CStr(Year(vDate)), 2)
DateAs_ddMMMyy = sDD & sMMM & sYY ' set result, return
End Function
' --- A Place to stash old code, not quite ready for bit-bucket ---
Sub Old_Code()
End Sub
--------------010502000504010601040709--