VB icon

3 HTML Formatting Functions

Email
Submitted on: 1/2/2015 1:38:00 AM
By: John Stalcup (from psc cd)  
Level: Not Given
User Rating: By 3 Users
Compatibility: VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0
Views: 1226
 
     This code provides 3 convenient ways of formatting html strings.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: 3 HTML Formatting Functions
' Description:This code provides 3 convenient ways of formatting html strings.
' By: John Stalcup (from psc cd)
'
' Inputs:A string of html.
'
' Returns:A formatted string of html
'**************************************

Option Explicit
Type tag
text As String
start As Double
length As Double
End Type
'*********************************************************************
Public Function SimpleFormat(target As String) As String
SimpleFormat = ReplaceSubString(CompactFormat(target), "><", ">" & vbCrLf & "<")
End Function
'*********************************************************************
Public Function CompactFormat(target As String) As String
Dim a As String
a = ReplaceSubString(target, vbCrLf, "")
a = ReplaceSubString(a, Chr(9), " ")
a = ReplaceSubString(a, " ", " ")
a = ReplaceSubString(a, "", " ")
a = ReplaceSubString(a, "", " ")
a = ReplaceSubString(a, " ", " ")
a = Clean(a)
CompactFormat = a
End Function
'*********************************************************************
Public Function HierarchalFormat(target As String) As String
target = ReplaceSubString(target, vbCrLf, "")
target = ReplaceSubString(target, vbTab, "")
target = Eformat(target)
HierarchalFormat = Clean(target)
End Function
'*********************************************************************
'this lines denotes separation from public access and inner workings
'*********************************************************************
Private Function Clean(targ As String) As String
targ = ReplaceSubString(targ, " >", ">")
targ = ReplaceSubString(targ, "< ", "<")
targ = ReplaceSubString(targ, "> <", "><")
Clean = targ
End Function
Public Function ReplaceSubString(str As String, ByVal substr As String, ByVal newsubstr As String)
Dim pos As Double
Dim startPos As Double
Dim new_str As String
startPos = 1
pos = InStr(str, substr)
Do While pos > 0
new_str = new_str & Mid$(str, startPos, pos - startPos) & newsubstr
startPos = pos + Len(substr)
pos = InStr(startPos, str, substr)
Loop
new_str = new_str & Mid$(str, startPos)
ReplaceSubString = new_str
End Function
Private Function Eformat(str As String) As String
On Error Resume Next
Dim startPos As Double
Dim endPos As Double
Dim indentationLevel As Double
Dim new_str As String
indentationLevel = 0
startPos = 0
endPos = 0
If (Mid$(str, 1, 1) <> "<") Then
Dim tempEnd As Double
tempEnd = InStr(1, str, "<")
If tempEnd = 0 Then
tempEnd = Len(str)
End If
new_str = Mid$(str, 1, tempEnd)
End If
Do
DoEvents
If InStr(startPos + 1, str, "</") <> 0 And InStr(startPos + 1, str, "</") <= InStr(startPos + 1, str, "<") Then
startPos = InStr(startPos + 1, str, "</")
endPos = InStr(startPos + 1, str, "<")
If endPos = 0 Then
endPos = Len(str) + 1
End If
indentationLevel = indentationLevel - 1
new_str = new_str & vbCrLf & String(indentationLevel, vbTab) & Mid$(str, startPos, endPos - startPos)
Else
startPos = InStr(startPos + 1, str, "<")
endPos = InStr(startPos + 1, str, "<")
If endPos = 0 Then
endPos = Len(str) + 1
End If
new_str = new_str & vbCrLf & String(indentationLevel, vbTab) & Mid$(str, startPos, endPos - startPos)
Dim tagName As String
tagName = LCase(returnNameOfTag(returnNextTag(str, startPos)))
If tagName <> "br" And tagName <> "hr" And tagName <> "img" And tagName <> "meta" And tagName <> "applet" And tagName <> "p" And tagName <> "!--" And tagName <> "input" And tagName <> "!doctype" And tagName <> "area" Then
indentationLevel = indentationLevel + 1
End If
End If
Loop While startPos > 0
Eformat = new_str
End Function
Public Function returnNextTag(ByRef str As String, ByVal start As Double) As tag
On Error Resume Next
Dim endPos As Double
start = InStr(start + 1, str, "<")
endPos = InStr(start + 1, str, ">")
returnNextTag.text = Mid$(str, start, endPos - start + 1)
returnNextTag.start = start
returnNextTag.length = endPos - start
End Function
Public Function returnNameOfTag(ByRef str As tag) As String
On Error Resume Next
Dim endPos As Double
Dim start As Double
start = 2
endPos = InStr(1, str.text, " ")
If Mid$(str.text, 2, 3) = "!--" Then
endPos = 5
ElseIf endPos = 0 Then
endPos = InStr(1, str.text, ">")
End If
returnNameOfTag = Mid$(str.text, start, endPos - start)
End Function


Other 2 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.