if you want to take a screenshot of a website which is divided into frames and some frames are so big that scrollbars are shown, the SAVEAS TYPE=BMP command does not save those bits of the page which are not shown - as it does when the page is not divided into frames.
This VBScript parses through the frameset of the page and visits all source of the frames seperately to take a screenshot of them. If you use this program, please let me know if it works and, more importantly, if it doesn't.
Here is a short explanation
You have to do the following. Copy the text at the end of these explanations into an empty file (using, e.g., notepad) and save it as yourfilename.vbs on your hard drive. The file name is not important, the file ending .vbs, however, is.
Once you have done that you should be able to double click the file, which will then open the iMacros Browser and go to a framed website and save screenshots of the full frames in you InternetMacros/downloads directory.
To adjust this file to your needs, you need to edit it a little. Under "place your macro code here" you need to place your macro code, which brings you to the site you want to take a screenshot of. Place your macro code between two " and end each line with
& VbCRLF & _
except the last line. Leave the
"SET !EXTRACTADD {{!URLCURRENT}}"
as the last line - you must not remove that line, otherwise the script will not work!
If you need further code after the screenshots have been taken (e.g. for logout), add the code after "place your other macro code here (if needed)".
Regards
---
Lasse Clausen, iOpus Support
03.03.2006: Minor changes
Code: Select all
Option Explicit
Dim iim1, iret, data, origURL, macroCommands, tmp
' create instance of iMacros
Set iim1 = CreateObject ("InternetMacros.iim")
iret = iim1.iimInit ()
'============================
' place your macro code here
'============================
macroCommands = "VERSION BUILD=5050227" & VbCRLF & _
"TAB T=1" & VbCRLF & _
"TAB CLOSEALLOTHERS" & VbCRLF & _
"URL GOTO=http://www.iopus.com/imacros/demo/v5/frames/index.htm" & VbCRLF & _
"SIZE X=801 Y=602" & VbCRLF & _
"SET !EXTRACTADD {{!URLCURRENT}}"
' "URL GOTO=http://ats.nist.gov/cgi-bin/cgi.tcl/frame.cgi" & VbCRLF & _
'============================
'============================
iret = iim1.iimPlay ("CODE:" & macroCommands)
If iret < 0 Then
MsgBox (iim1.iimGetLastError ())
Else
tmp = Split (iim1.iimGetLastExtract(), "[EXTRACT]")
' if other extracts have been made in the macro above, only get the last entry
origURL = tmp(UBound(tmp) - 1)
' do the screenshots
iret = doScreenshotsOfFrames(iim1, origURL)
'============================
'place your other macro code here (if needed)
'============================
macroCommands = ""
'============================
'============================
iret = iim1.iimPlay ("CODE:" & macroCommands)
If iret < 0 Then
MsgBox (iim1.iimGetLastError ())
End If
End If
iret = iim1.iimExit()
WScript.Quit(0)
Function doScreenshotsOfFrames(iimInstance, origURL)
Dim retVal, iplay, data, baseURL, domainURL, _
sniplets, framedata, retFind, iimCodeString, i, regEx
retVal = 1
' do some cosmetics
Set regEx = New RegExp
regEx.Pattern = "&"
regEx.Global = True
regEx.IgnoreCase = True
origURL = regEx.Replace (origURL, "&")
' get base URL and domain
baseURL = stripURL (origURL)
domainURL = stripDomainURL (baseURL)
' play extraction macro
iplay = iimInstance.iimPlay ("CODE:EXTRACT POS=1 TYPE=HTM ATTR=<FRAMESET*")
If iplay < 0 Then
retVal = iplay
Else
' get extract value
data = iimInstance.iimGetLastExtract()
' if site contains frames, loop through them and make screenshots
If Instr (data, "#EANF#") = 0 Then
sniplets = Split (data, "[EXTRACT]")
framedata = sniplets(0)
' do some more cosmetics
framedata = regEx.Replace (framedata, "&")
' find URLs of the frame sources
retFind = findURLs(framedata, domainURL, baseURL)
' loop through frames, open them seperately in a window and make
' a screenshot
For i = 1 to UBound(retFind)
iimCodeString = "CODE:URL GOTO=" & retFind(i) & VbCRLF & _
"SAVEAS TYPE=BMP FOLDER=* FILE=frame" & cstr(i) & ".bmp"
iplay = iimInstance.iimPlay(iimCodeString)
' an error occured during making a screenshot, exit
If iplay < 0 Then
retVal = iplay
Exit For
End If
Next
' go back to original URL
iplay = iimInstance.iimPlay("CODE:URL GOTO=" & origURL)
If iplay < 0 Then
retVal = iplay
End If
' if site does not contain frames, make a screenshot
Else
iimCodeString = "CODE:SAVEAS TYPE=BMP FOLDER=* FILE=frame0.bmp"
iplay = iimInstance.iimPlay(iimCodeString)
If iplay < 0 Then
retVal = iplay
End If
End If
End If
doScreenshotsOfFrames = retVal
End Function
' strip base URL from original URL
' so it can be added to relative URLs in the frame source
Function stripURL(strng)
Dim regEx, match, matches, retStr, fileNameChars, fNC, cIS
'fileNameChars
fNC = "[^/\\:*?""<>\|]"
'charsInSearchstring
cIS = "[^:*?""<>\|&=]"
Set regEx = New RegExp
regEx.Pattern = "/$"
regEx.IgnoreCase = True
regEx.Global = True
Set matches = regEx.Execute(strng)
If matches.Count = 0 Then
regEx.Pattern = _
"/("&fNC&"+(\."&fNC&"+)*)?(\?"&cIS&"+="&cIS&"+(&"&cIS&"+="&ciS&"+)*)?(#"&fNC&"+)?$"
' \----------+-----------/\---------------------+-------------------/\----+-----/
' | | |
' 0 or 1 filename 0 or 1 searchstring 0 or 1
' with 0 or n key value pairs jump tag
retStr = regEx.Replace(strng, "/")
End If
stripURL = retStr
End Function
' strip base domain from base URL
' so it can be added to relative URLs in the frame source
Function stripDomainURL(strng)
Dim regEx, match, matches, retStr
Set regEx = New RegExp
regEx.Pattern = "^https?://(\w+\.)+\w{2,3}/"
regEx.IgnoreCase = True
regEx.Global = True
Set matches = regEx.Execute(strng)
If matches.Count <> 0 Then
For Each match in matches
stripDomainURL = match.Value
Next
Else
stripDomainURL = "nononononono"
End If
End Function
' extract URLs from the src= attribute of the frame tag
' and add base URL if path is relative
Function findURLs(strng, domainURL, baseURL)
Dim regEx, FrameMatch, FrameMatches, URLMatches, URLMatch, retArr(), _
counter, tmp, frameSrc, relativeSrc
Set regEx = New RegExp
' find frame tags
regEx.Pattern = "<\s*frame\s+.+?>"
regEx.IgnoreCase = True
regEx.Global = True
Set FrameMatches = regEx.Execute(strng)
ReDim retArr(FrameMatches.Count)
counter = 1
For Each FrameMatch in FrameMatches
' find src= attribute in frame tag
regEx.Pattern = "src=.+?(\s|>)"
Set URLMatches = regEx.execute(FrameMatch.value)
For Each URLMatch in URLMatches
regEx.Pattern = "^(src=)|""|>"
frameSrc = Trim (regEx.Replace (Trim(URLMatch.Value), " "))
' if frame source is relative, it starts with a ., a /
' or doesn't contain a / at all
regEx.Pattern = "/"
Set relativeSrc = regEx.Execute(frameSrc)
If relativeSrc.Count = 0 Then
frameSrc = baseURL & frameSrc
Else
' if src starts with . it can be attached to the base url
regEx.Pattern = "^\."
Set relativeSrc = regEx.Execute(frameSrc)
If relativeSrc.Count <> 0 Then
frameSrc = baseURL & frameSrc
Else
' if source starts with / it needs to be attached to the domain name
regEx.Pattern = "^/"
Set relativeSrc = regEx.Execute(frameSrc)
If relativeSrc.Count <> 0 Then
frameSrc = domainURL & frameSrc
End If
End If
End If
retArr(counter) = frameSrc
Next
counter = counter + 1
Next
findURLs = retArr
End Function
' end