home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / encryp1r / functs-h.bas < prev    next >
Encoding:
BASIC Source File  |  1999-08-24  |  6.2 KB  |  160 lines
  1. Attribute VB_Name = "Functions_HTML"
  2. Option Explicit
  3.  
  4. Public Type HTMLTag
  5.     Full As String
  6.     Name As String
  7.     Value As String
  8. End Type
  9.  
  10. Public Sub HTMLParse(ByVal urlText As String, ByVal baseURL As String, tagArray() As HTMLTag)
  11.  
  12. Dim i As Integer ' Keeps track of the size of our array
  13.  
  14. Dim openTag As Integer ' Holds the position of "<"
  15. Dim closeTag As Integer ' Holds the position of ">"
  16.  
  17. Dim curTag As HTMLTag ' Holds the values of the current Tag being looked at
  18.  
  19. Dim endName As Integer ' Holds the position of the end of the tag name
  20.  
  21. Dim startValue As Integer ' Holds the postion of the beginning of the tag value
  22. Dim endValue As Integer ' Holds the position of the end of the tag value
  23.  
  24. ' Make sure that baseURL ends with a forward slash.
  25. ' If not, append it.
  26. If Right(baseURL, 1) <> "/" Then baseURL = baseURL & "/"
  27.  
  28. ' Get the postion of the first open bracket
  29. openTag = InStr(1, urlText, "<")
  30.  
  31. ' Resize our array
  32. ReDim Preserve tagArray(i)
  33.  
  34. ' We need to loop through the string until
  35. ' there are no more tags left (i.e. no more
  36. ' opening brackets are found)
  37. Do
  38. DoEvents
  39.  
  40.     ' Only look for the closing bracket if the
  41.     ' opening bracket was found.  Otherwise
  42.     ' we will get an error when trying to get
  43.     ' use mid to get the tag
  44.     If openTag <> 0 Then
  45.         closeTag = InStr(openTag + 1, urlText, ">")
  46.     Else
  47.         Exit Do
  48.     End If
  49.     
  50.     ' If there is no closing bracket (">") for the current tag
  51.     ' then there was an HTML coding error and we will
  52.     ' get stuck in an endless loop, so we set the closing
  53.     ' tag to opentag + 1 and jump to the next iteration
  54.     ' of the loop
  55.     If closeTag = 0 Then closeTag = openTag + 1: GoTo NextIteration
  56.     
  57.     ' .Full is everything between the opening and closing brackets,
  58.     ' including the brackets themselves
  59.     curTag.Full = LCase(Mid(urlText, openTag, closeTag - openTag + 1))
  60.     
  61.     ' Get the tag name and assign it to .Name.
  62.     ' This is done by getting everything after the opening
  63.     ' brack until the first space or the closing bracket.
  64.     endName = InStr(2, curTag.Full, " ") - 2
  65.     If endName = -2 Then endName = InStr(2, curTag.Full, ">") - 2
  66.     curTag.Name = TrimNull(Mid(curTag.Full, 2, endName))
  67.     
  68.     ' Depending on what type of tag we have,
  69.     ' get and assign the value of that tag.
  70.     ' Examples for <A> and <IMG> are given
  71.     ' here. Any other values you need can be
  72.     ' added as necessary using this example.
  73.     Select Case (curTag.Name)
  74.     
  75.         ' If the current tag is an <A> tag then get the
  76.         ' file in href="xxx" and assign it to .value
  77.         Case "a"
  78.     
  79.             ' Position of "href=" in the tag
  80.             startValue = InStr(LCase(curTag.Full), "href=")
  81.             
  82.             ' If its there (not all anchor tags are links, so we
  83.             ' have to be careful), then proceed. Otherwise,
  84.             ' set .Value to null.
  85.             If (startValue <> 0) Then
  86.             
  87.                 ' Again, find the end of the value by getting the
  88.                 ' location of the next space or a closing bracket.
  89.                 endValue = InStr(startValue + 5, curTag.Full, " ") - 1
  90.                 If endValue = -1 Then endValue = InStr(startValue + 5, curTag.Full, ">") - 1
  91.                 
  92.                 ' Only if both these values are not zero, procced
  93.                 If ((startValue <> 0) And (endValue <> 0)) Then
  94.                     
  95.                     ' Strip away quotation marks, and null characters, and set .Value
  96.                     curTag.Value = StripQuotes(TrimNull(Mid(curTag.Full, startValue + 5, endValue - startValue - 4)))
  97.                     
  98.                     ' Do some last minute check here. Some URL's are not
  99.                     ' complete URL's in that they only contain the logical
  100.                     ' path to the next URL from the current one. If that is the case
  101.                     ' we have to append the base URL to the start of the URL.
  102.                     If (Left(LCase(curTag.Value), 7) <> "http://") Then
  103.                         If (Left(curTag.Value, 1) = "/") Then
  104.                             curTag.Value = baseURL & Mid(curTag.Value, 2)
  105.                         Else
  106.                             curTag.Value = baseURL & curTag.Value
  107.                         End If ' (Left(curTag.Value, 1) = "/")
  108.                     End If ' (Left(LCase(curTag.Value), 7) <> "http://")
  109.                 End If ' ((startValue <> 0) And (endValue <> 0))
  110.                 
  111.             Else
  112.                 curTag.Value = ""
  113.                 
  114.            End If ' (startValue <> 0)
  115.            
  116.         ' If the current tag is an <IMG> tag then get the
  117.         ' file in src="xxx" and assign it to .value
  118.         Case "img"
  119.         
  120.             ' Refer to the above case for commentary
  121.             ' on what is going on below
  122.             startValue = InStr(LCase(curTag.Full), "src=")
  123.             endValue = InStr(startValue + 5, curTag.Full, " ") - 1
  124.             If endValue = -1 Then endValue = InStr(startValue + 5, curTag.Full, ">") - 1
  125.             If startValue <> 0 And endValue <> 0 Then
  126.                 curTag.Value = StripQuotes(TrimNull(Mid(curTag.Full, startValue + 5, endValue - startValue - 4)))
  127.                 If Left(LCase(curTag.Value), 7) <> "http://" Then
  128.                     If Left(curTag.Value, 1) = "/" Then
  129.                         curTag.Value = baseURL & Mid(curTag.Value, 2)
  130.                     Else
  131.                         curTag.Value = baseURL & curTag.Value
  132.                     End If
  133.                 End If
  134.             End If
  135.             
  136.         ' If we are looking at a tag that doesn't have a
  137.         ' value associated with it, or we are not interested
  138.         ' in its value, so set the value to null
  139.         Case Else
  140.             curTag.Value = ""
  141.             
  142.     End Select ' (curTag.Name)
  143.     
  144.     ' Set the current item of the tagArray to curTag
  145.     tagArray(i) = curTag
  146.     
  147.     ' Increment our tag counter
  148.     ' and change the size of the tagArray
  149.     i = i + 1
  150.     ReDim Preserve tagArray(i)
  151.     
  152. NextIteration:
  153.     ' Find the position of the next opening bracket in the code
  154.     openTag = InStr(closeTag, urlText, "<")
  155. Loop Until openTag = 0
  156.  
  157. End Sub
  158.  
  159.  
  160.