WinBatch Tech Support Home

Database Search

If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.

TechHome

WinBatch
OLE COM ADO CDO ADSI LDAP
OLE with MSIE
plus
User Samples

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Analyze HTML Sample Code

AddExtender ( "wwctl34i.dll" )
;-----------------------------------------------------------------------------
; WinBatch array constants
;-----------------------------------------------------------------------------
#DefineFunction @arr ( name )
Select @TRUE
	Case name == "Ok"
		Return -1
	Case @TRUE
End Select

msg = `Undefined WinBatch ArrInfo constant "`
die ( StrCat ( msg, name, `" specified.`) )

 #EndFunction ; @arr
 
;-----------------------------------------------------------------------------
; @str
;-----------------------------------------------------------------------------
#DefineFunction @str( name )
Select @TRUE
	Case name == "FromEnd"
		Return 0
	Case name == "End"
		Return -1
	Case @TRUE
End Select

msg  = `Bad WinBatch string function argument enumeration name "%name%"`
Message("Error", msg)
Exit
#EndFunction ; @str

;-----------------------------------------------------------------------------
; @lst - WinBatch list function argument constant enumerations.
;-----------------------------------------------------------------------------
#DefineFunction @lst ( name )
Select @TRUE
	Case name == "CsvRemoveSpaces"
		Return 0
	Case name == "CsvIncludeSpaces"
		Return 1
End Select
Message("Error", "Bad WinBatch string list argument enumeration name")
Exit
#EndFunction ; @lst

;-----------------------------------------------------------------------------
; @rtf - RTF string array subscript enumerations.
;-----------------------------------------------------------------------------
#DefineFunction @rtf ( name )
Select @TRUE
	Case name == "Orig"
		Return 0
	Case name == "Rtf"
		Return 1
	Case @TRUE
End Select
Message ( "Error", "Bad RTF string array subscript enumeration: %name%" )
Exit

#EndFunction ; @rtf

;-----------------------------------------------------------------------------
; protectFromRtf - Returns its string parameter altered to protect substrings
;          which would otherwise be misinterpreted as RTF commands.
;-----------------------------------------------------------------------------
#DefineFunction protectFromRtf( s )
Return StrReplace ( s, "\", "\\" )
#EndFunction

;-----------------------------------------------------------------------------
; makeRtf - Returns a 2-element array of strings.  The first element is the
;      unaltered string argument to this function.  The second element
;      is the string altered to protect substrings which would otherwise
;      be misinterpreted as RTF commands.
;-----------------------------------------------------------------------------
#DefineFunction makeRtf ( s )
@_rtf = ArrDimension ( 2 )
@_rtf[ @rtf ( "Orig" ) ] = s
@_rtf[ @rtf ( "Rtf"  ) ] = protectFromRtf ( s )
Return @_rtf
#EndFunction ; makeRtf

;-----------------------------------------------------------------------------
; catRtf - Returns a 2-element RTF string array containing the concatenation
;      of the arguments passed to catRtf.  Assumes array arguments are
;      also RTF string arrays and uses the appropriate elements.  For
;      fewer than 6 arguments, pass a null string ("") for the unused
;      arguments
;-----------------------------------------------------------------------------
#DefineFunction catRtf ( p1, p2, p3, p4, p5, p6 )
@_  = ArrDimension ( 2 )
ArrInitialize ( @_, "" )
For i = 1 To 6
	If ArrInfo ( p%i%, @arr ( "Ok" ) )
		@_[@rtf("Orig")] = StrCat ( @_[@rtf("Orig")], p%i%[@rtf("Orig") ] )
		@_[@rtf("Rtf" )] = StrCat ( @_[@rtf("Rtf" )], p%i%[@rtf("Rtf" ) ] )
	Else
		@_[@rtf("Orig")] = StrCat ( @_[@rtf("Orig")], p%i%         )
		@_[@rtf("Rtf" )] = StrCat ( @_[@rtf("Rtf" )], protectFromRtf(p%i%) )
	End If
Next
Return @_
#EndFunction ; catRtf

;-----------------------------------------------------------------------------
; colorizeRtf - Encloses the RTF-encoded element of the RTF string array in
;        RTF commands to give the text the specified color.
;-----------------------------------------------------------------------------
#DefineFunction colorizeRtf ( @_rtf, iColor )
@_[@rtf("Rtf")] = StrCat( "\cf", iColor, " ", @_[@rtf("Rtf")], "\cf0 " )
#EndFunction ; colorizeRtf

;-----------------------------------------------------------------------------
; boldRtf -  Encloses the RTF-encoded element of the RTF string array in
;       RTF commands to make the text bold.
;-----------------------------------------------------------------------------
#DefineFunction boldRtf( @_rtf )
@_[@rtf("Rtf")] = StrCat( "\b ", @_[@rtf("Rtf")], "\b " )
#EndFunction ; boldRtf
 
;-----------------------------------------------------------------------------
; truncateRtf - Limits an RTF string array to the specified number of
;        printable characters by truncating it on the left if
;        necessary.
;-----------------------------------------------------------------------------
#DefineFunction truncateRtf ( @_, nMax )

n    = StrLen ( @_[ @rtf("Orig") ] )
If n <= nMax Then Return
nExtra = n - nMax
iEnd  = StrLen ( @_[ @rtf("Rtf") ] )
While @TRUE
	iLast       = iEnd
	While @TRUE
		; Scan back from iLast looking for a backslash
		iSlash     = StrIndex( @_[ @rtf("Rtf") ], "\", iLast, @FWDSCAN )
		If iSlash < 2                      Then Break
		If StrSub ( @_[ @rtf("Rtf") ], iSlash - 1, 1 ) != "\" Then Break
		; Skip over pseudo-RTF stuff and try again (doubled backslash found)
		iLast      = iSlash - 2
	End While
	If iSlash
		; Found a single backslash; scan forward to next space
		iSpace     = StrIndex(@_[@rtf("Rtf")], " ",iSlash + 1, @FWDSCAN )
		If ! iSpace Then iSpace = iEnd
		; If not found, ???
	Else
		; No single backslashes back to beginning of string
		iSpace     = 0
	End If
	; See if enough characters can be removed
	nAvailable    = iEnd - iSpace
	If nAvailable >= nExtra Then Break
	; Remove all possible characters after current RTF stuff
	part1       = StrSub( @_[ @rtf("Rtf") ], 1,    iSpace   )
	part2       = StrSub( @_[ @rtf("Rtf") ], iEnd + 1, @str("End") )
	@_[ @rtf("Rtf") ] = StrCat ( part1, part2 )
	; Continue backwards from before current RTF stuff
	nExtra = nExtra - nAvailable
	iEnd = iSlash - 1
	; If iEnd < 1 Then ???
End While

nBeg = iEnd - nExtra
; Remove as many characters as necessary
part1        = StrSub( @_[ @rtf("Rtf") ], 1,    nBeg    )
part2        = StrSub( @_[ @rtf("Rtf") ], iEnd + 1, @str("End") )
@_[ @rtf("Rtf") ]  = StrCat ( part1, part2 )
; Truncate non-rtf element
@_[ @rtf("Orig") ] = StrSub(@_[ @rtf("Orig") ], 1, nMax )
#EndFunction ; truncateRtf
;-----------------------------------------------------------------------------

#DefineFunction composeLine ( ole )
errorModeOrig = ErrorMode(@OFF)
tag = ole.tagName
type = ole.TYPE
id  = ole.id
name = ole.name
nodeName = ole.nodeName
nodeType = ole.nodeType
nodeValue = ole.nodeValue
val = ole.value
href = ole.href
rel = ole.rel
src = ole.src
face = ole.face
oleChildren = ole.children
nChildren = oleChildren.length
ObjectClose(oleChildren)
If ! nChildren Then text = ole.innerText
Else text = ""
ErrorMode(errorModeOrig)

@_ = ArrDimension ( 2 )

@_[ @rtf("Orig") ] = getTagDescription ( tag )
@_[ @rtf("Rtf")  ] = colorizeTag(protectFromRtf( @_[ @rtf("Orig") ] ), tag)

Select @TRUE
	Case tag == "TD"
	Case tag == "DIV"
		If id != 0 && id != "" Then @_ = catRtf(@_,` id="%id%"`,"","","","")
		Continue
	Case tag == "TD"
	Case tag == "DIV"
	Case tag == "SCRIPT"
	Case tag == "INPUT"
	Case tag == "LINK"
		If type != 0 && type != ""
			@_ = catRtf(@_,` type="%type%"`,"","","","")
		End If
		Continue
	Case tag == "TD"
	Case tag == "FORM"
	Case tag == "A"
	Case tag == "INPUT"
		If name != 0 && name != ""
			_ = catRtf(@_,` name="%name%"`,"","","","")
		End If
		Continue
	Case tag == "FONT"
		@_ = catRtf(@_, ` (face="`, face, `"`, "", "")
		Continue
	Case tag == "IMG"
	Case tag == "SCRIPT"
		If src != 0 && src != "" Then @_ = catRtf(@_, `: src="`, src, `"`, "", "")
		Continue
	Case tag == "SELECT"
		If nodeName != 0 && nodeName != ""
			@_ = catRtf(@_, ` nodeName="`, nodeName, `"`, "", "")
		End If
	Continue
	Case tag == "SELECT"
	Case tag == "OPTION"
		If val != 0 && val != "" Then @_ = catRtf(@_, ` val="`, val, `"`, "", "")
		Continue
	Case tag == "LINK"
		If rel != 0 && rel != "" Then @_ = catRtf(@_, ` rel="`, rel, `"`, "", "")
		Continue
	Case tag == "A"
	Case tag == "LINK"
		If href != "" Then @_ = catRtf(@_, ` href="`, href, `"`, "", "")
		Continue
	Case @TRUE
End Select
If text != "" Then @_ = catRtf(@_, ` innerText="`, text, `"`, "", "")
Return @_
#EndFunction ; composeLine

#DefineFunction getTagDescription ( tag )
Select @TRUE
	Case tag == "TR"
		Return "row"
	Case tag == "TD"
		Return "cell"
	Case tag == "B"
		Return "BOLD:"
	Case tag == "A"
		Return "ANCHOR:"
	Case tag == "DIV"
		Return "CONTAINER"
	Case tag == "!"
		Return "COMMENT: "
	Case @TRUE
		Return tag
End Select
#EndFunction ; getTagDescription

#DefineFunction colorizeTag(s, tag)
Select @TRUE
	Case tag == "FORM"
		c = 3
		Break
	Case tag == "TD"
		c = 6
		Break
	Case tag == "LEGEND"
		c = 4
		Break
	Case tag == "INPUT"
		c = 7
		Break
	Case tag == "OPTION"
		c = 8
		Break
	Case @TRUE
		Return s
End Select
Return color(s, c)
#EndFunction

#DefineFunction color(s, i)
 Return StrCat("\cf", i, " ", s, "\cf0 ")
#EndFunction

#DefineFunction write(level, hfil, s)
Select level
	Case 3
	Case 15
		c = 9
		Break
	Case 7
	Case 19
		c = 5
		Break
	Case 11
	Case 23
		c = 2
	Break
	Case level
		FileWrite ( hfil, StrCat ( s, "\par" ) )
		Return
End Select
s = StrReplace ( s, "\cf0", "\cf%c%" )
FileWrite ( hfil, StrCat ( "\cf", c, " ", s, "\cf0 ", "\par" ) )
#EndFunction

#DefineSubroutine analyzeHtml ()
If ! oleCollection%level%.length Then Return
col%level% = ObjectCollectionOpen(oleCollection%level%)
While @TRUE
	ole = ObjectCollectionNext(col%level%)
	If ! ole Then Break
	@_ = catRtf( StrFill( " ", level ), composeLine(ole), "", "", "", "" )
	If StrLen ( @_[ @rtf("Orig") ] ) > 80
		truncateRtf  ( @_, 79 )
		@_ = catRtf ( @_, "+", "", "", "", "" )
	End If
	write ( level, hfil, @_[ @rtf("Rtf") ] )
	level = level + 1
	oleCollection%level% = ole.children
	ObjectClose(ole)
	analyzeHtml ()
	ObjectClose(oleCollection%level%)
	level = level - 1
End While
ObjectCollectionClose(col%level%)
#EndFunction ; analyzeHtml

#DefineFunction writeRtfHeader ( hfil )
 s = `{\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 Courier New;}}`
 FileWrite(hfil, s)
 s = `{\colortbl ;\red255\green255\blue0;\red128\green0\blue128;`
 s = StrCat(s, `\red255\green0\blue255;\red0\green255\blue255;`)
 s = StrCat(s, `\red255\green0\blue0;\red0\green0\blue255;`)
 s = StrCat(s, `\red0\green255\blue0;\red128\green0\blue0;`)
 s = StrCat(s, `\red0\green0\blue128;}`)
 FileWrite(hfil, s)
 s = `\viewkind4\uc1\pard\lang1033\f0\fs20 `
 FileWrite(hfil, s)
#EndFunction ; rtfHeader

#DefineFunction analyze ( htmlFilespec )
 oleIe      = ObjectOpen("InternetExplorer.Application")
 oleIe.visible  = 1
 WinZoom(cWinIdConvert(oleIe.HWND))

 rootFilespec  = FileRoot(htmlFilespec)
 rtfFilespec   = StrCat(rootFilespec, '.RTF')
 hfil      = FileOpen(rtfFilespec,"WRITE")
 writeRtfHeader(hfil)

 TimeDelay(.5)
 oleIe.navigate(htmlFilespec)
 TimeDelay(2)

 level      = 0

 oleDoc     = oleIe.document
 oleCollection0 = oleDoc.childNodes

 analyzeHtml()

 FileWrite(hfil, "}")

 ObjectClose(oleCollection0)
 ObjectClose(oleDoc)

 FileClose(hfil)

 hwndIe     = oleIe.HWND
 widIe      = cWinIdConvert(hwndIe)

 If WinExist(widIe) Then WinClose(widIe)
#EndFunction ; analyze

;----------------------------------------------------------------


filename = "EftpsLoginChild[1].html"
filespec = StrCat(DirGet(), filename)
analyze(filespec)

 
Exit

Article ID:   W16629

File Created: 2005:02:18:12:21:40
Last Updated: 2005:02:18:12:21:40