Fast Forward Technologies/getwebpage

From RoyalWeb
Revision as of 07:13, 12 October 2008 by Wjhonson (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search
Sub Main
	' writen by Will Johnson, copyright Fast Forward Technologies 1999
	' this script take the URL that you pasted To the Clipboard, goes To this page, saves it To a temp
	' file And Then reads And sends the contects of that tempfile into the ActiveSession.  This script Is
	' designed to work with the WS shell's webcrawler, upgrade, and editpermission routines.
	myDir = MacroDir$
	b = Clipboard$() ' get the URL from the clipboard
	ActiveSession.WriteText "launch " & b & Chr(13) ' tell pick what im doing
	Debug.Print "Launch URL " & b 'accuterm window what im doing
	Clipboard "" ' clear the clipboard now
	Dim myIE As Object ' set up a place for my explorer object
	Set myIE = CreateObject("InternetExplorer.application") ' create my explorer object
	myIE.Visible = True ' make it visible
	myIE.navigate(b) ' now go to the web page i specified
	notbusycounter = 0 ' count consecutive "notbusy" flags otherwise redirection of browser causes problems
	loopcounter = 0 ' just for informational purposes and to let user know somethings happening
	Do
		loopcounter = loopcounter + 1
		If myIE.busy Then notbusycounter = 0 Else notbusycounter = notbusycounter + 1
		'tell pick what im doing
		ActiveSession.WriteText "Navigating " & loopcounter & " notbusy " & notbusycounter & Chr(13)
		Wait 1 ' wait 1 second between looks at the notbusy flag, allows redirection to reset it
	Loop Until notbusycounter > 11
	'save web page in a temp windows file
	ActiveSession.WriteText "activate IE " & myIE.locationname & " and save" & Chr(13)
	'make browser the active window again, if you cant find it try HTTP 404 Not Found
	On Error GoTo badpage
	AppActivate Left(myIE.locationname,40) 'really long names cause problems
	PageNotFound = False
	GoTo testpage
	badpage: PageNotFound = True
	AppActivate "HTTP 404"
	testpage:
	If PageNotFound Then
		myIE.Quit ' quit the browser
		Set myIE = Nothing 'throw away the browser object space
		'let pick know what im doing
		ActiveSession.WriteText "Error: Page cannot be found, exiting" & Chr(13)
		ActiveSession.WriteText "gotdata" & Chr(13)
		ActiveSession.WriteText "done" & Chr(13)
		ChDir mydir
		Exit Sub
	End If
	
	On Error GoTo 0
	'save page in a temp file
	SendKeys "%FA",1
	SendKeys "c:\wscrawler.htm~Y",1
	notbusycounter = 0 	' count consecutive "notbusy" flags otherwise save may not finish before we move on
	loopcounter = 0 ' just for informational purposes and to let user know somethings happening
	Do
		loopcounter = loopcounter + 1
		If loopcounter > 15 Then 'give them 15 seconds to save it then die
			SendKeys "~"
			'let pick know what im doing
			ActiveSession.WriteText "activate IE " & myIE.locationname & " and quit" & Chr(13)
			AppActivate Left(myIE.locationname,40) 'really long names cause problems
			myIE.QUIT ' quit the browser
			Set myIE= Nothing 'throw away the browser object space
			'let pick know what im doing
			ActiveSession.WriteText "Error: Save was unable to finish, exiting" & Chr(13)
			ActiveSession.WriteText "gotdata" & Chr(13)
			ActiveSession.WriteText "done" & Chr(13)
			ChDir mydir
			Exit Sub
		End If
		If myIE.busy Then notbusycounter = 0 Else notbusycounter = notbusycounter + 1
		'tell pick what im doing
		ActiveSession.WriteText "Saving "& loopcounter & " notbusy " & notbusycounter & Chr(13)
		Wait 1 ' wait 1 second between looks at the notbusy flag
	Loop Until notbusycounter > 3
	'let pick know what im doing
	ActiveSession.WriteText "activate IE " & myIE.locationname & " and quit" & Chr(13)
	AppActivate Left(myIE.locationname,40) 'really long names cause problems
	myIE.QUIT ' quit the browser
	Set myIE= Nothing 'throw away the browser object space
	' let pick know what im doing
	ActiveSession.WriteText "I will now open the resulting information" & Chr(13)
	'open that temp file we saved the web page to
	
	'Now for a little twist, Save As can save whole web systems not just the HTML of one page
	'It does this by building a Folder using the name you gave it, and redirecting the file you THINK
	'you saved to a file called index.htm in this Folder so now lets pull it out if its there.  Now we dont
	'have a way to tell if a directory exists without causing an error, so lets pull a trick.  First rename
	'the potential hidden file, and then check if it ended up in the directory we wanted to put it to.  If it
	'did then that directory must exist, if it didnt then we use the simple case.
	
	'first, if there is already a file called wsrecrawler, then kill it so we can name our embedded file that
	f$ = Dir$("wsrecr*.*")
	If f$ <> "" Then
		Debug.Print "killing redundant wsrecrawler file"
		Kill "c:\wsrecrawler.htm"
		Debug.Print "done"
	End If
	'now if there is not a directory called wscrawler then make one and scan it for an index page
	'turn off error handling for this one line because it will stop if we try to overwrite an existing directory
	On Error Resume Next
	MkDir "c:\wscraw~1"
	On Error GoTo 0
	ChDir "c:\wscraw~1"
	Debug.Print "setting directory to " & CurDir$()
	If CurDir$() = "c:\wscraw~1" Then
		f$ = Dir$("index.htm")
		If f$ <> "" Then
			Debug.Print "renaming wscraw\index to wsrecrawler file"
			Name "c:\wscraw~1\index.htm" As "c:\wsrecrawler.htm"
			Debug.Print "done"
		End If
	End If
	
	'now if the last set of commands did something, we need to rename again from
	'recrawler this time to crawler so our open is consistent
	Debug.Print "setting directory to c:\ and looking for recrawler file"
	ChDir "c:\"
	f$ = Dir$("wsrecr*.*")
	Debug.Print "done"
	If f$ <> "" Then
		Debug.Print "killing old wscrawler and renaming wsrecrawler to wscrawler file"
		Kill "c:\wscrawler.htm"
		Name "c:\wsrecrawler.htm" As "c:\wscrawler.htm"
		Debug.Print "done"
	End If
	Debug.Print "opening wscrawler for input"
	Open "c:\wscrawler.htm" For Input As #1
	Debug.Print "done"
	
	'let pick know what im doing
	ActiveSession.WriteText "len of file is " & FileLen("c:\wscrawler.htm") & Chr(13)
	'send special command to pick to start recording web data
	ActiveSession.WriteText "gotdata" & Chr(13)
	While Not EOF(1)
		Line Input #1,SS$ 'read one line from the temp file
		ActiveSession.WriteText ss$ & Chr(13) ' write one line to pick (activesession)
	Wend
    ActiveSession.WriteText "done" & Chr(13) ' send special command to pick that im done sending the page
    ChDir mydir
    End Sub
Personal tools
MOOCOW
Google AdSense