'Для работы требуется файл index.html, находящийся в одной папке с программой.
'На форме также нужно разместить TextBox с Name = "editbox", ListBox с Name = "List1" и CommandButton с Name = "cmd_getattributes"
'Запустите пример, установите курсор на любой элемент HTML в текстовом поле и нажмите на кнопку. В ListBox должны появиться атрибуты выбранного элемента.

'made by Alexander Triantafyllou
'Bsc Information Technology and Telecommunications
'University of Athens Greece

Dim editbox_ba() As Byte
Dim editbox_len As Long

' this holds the attribute names
Public tatname As New Collection
'this holds the attribute values
Public tatval As New Collection
'this holds the position where the attribute name starts
Public tatnamepos As New Collection
'this holds the position where the attribute value starts
Public tatvalpos As New Collection
Public tindex As Long
Public tnamepos As Long

Public htcol As New Collection
Dim kol(93) As String

'apothikeyei ta dedomena poy briskei i get_nodes_by_tname
Public htnodname As New Collection
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

' apothikeyei tis theseis ton images mesa sto document
Public imgsposcol As New Collection
'apothikeyei ta onomata names toy ekastote tag poy eksetazoyme sto
'sygekrimeno editbox
Public curtagnamecol As New Collection



Public Sub getattributes(ByVal spos As Long, Optional ByVal skip_tagnum As Boolean)


'WAS NOT ON ERROR

On Error GoTo errorhandler


Dim htmlword_ba() As Byte
' Put the textbox's string into a byte array '
'this is only needed every time the textbox is being changed


editbox_len = Len(Form1.editbox.Text)
ReDim editbox_ba(editbox_len)
CopyMemory editbox_ba(0), ByVal Form1.editbox.Text, editbox_len

'----------------------------------------------------------

Dim atcol As New Collection
'-----------------------------SBINOYME OLA TA PALIA ----------------------------------------------------

Do While tatname.Count >= 1
  tatname.Remove 1
Loop
Do While tatval.Count >= 1
  tatval.Remove 1
Loop

Do While tatvalpos.Count >= 1
  tatvalpos.Remove 1
Loop
Do While tatnamepos.Count >= 1
  tatnamepos.Remove 1
Loop
'----------------------TELOS SBINOYME PALIA-----------------------------------------------
If spos <> 0 Then

'BRISKOYME TAG ATTRIBUTES KAI TA BAZOYME STIS COLLECTIONS
' we find tag attributes and we put them in the collections

' if it is tag then parse else do not
  If Not skip_tagnum Then tagnum = gettagnum(spos)
  
  If tagnum <> 888 Or skip_tagnum Then

    found = False

' the following code does this instrrev but much more faster using a char byte array
    'startpos = InStrRev(Form1.EditBox.Text, "<", spos)
    startpos = spos - 1
    Do While startpos >= 0
      If editbox_ba(startpos) = 60 Then
        startpos = startpos + 1
        Exit Do
      Else
        startpos = startpos - 1
      End If
    Loop
    
    If startpos = -1 Then startpos = 0
    'startpos2 = InStr(spos + 1, Form1.EditBox.Text, "<") 'Form1.editbox.Find("<", spos + 1) + 1 '
    
    startpos2 = spos
    Dim found_startpos2 As Boolean
    
    Do While startpos2 < editbox_len
      If editbox_ba(startpos2) = 60 Then
        found_startpos2 = True
        startpos2 = startpos2 + 1
        Exit Do
      Else
        startpos2 = startpos2 + 1
      End If
    Loop
    
    If Not found_startpos2 Then startpos2 = 0
    
    'endpos = InStrRev(Form1.editbox.Text, ">", spos)
    
    endpos = spos - 1
    Do While endpos >= 0
      If editbox_ba(endpos) = 62 Then
        endpos = endpos + 1
        Exit Do
      Else
        endpos = endpos - 1
      End If
    Loop
    
    If endpos = -1 Then endpos = 0
       
    'endpos2 = InStr(spos, Form1.editbox.Text, ">") 'Form1.editbox.Find(">", spos) + 1 '
    
    endpos2 = spos - 1
    Dim found_endpos2 As Boolean
    
    Do While endpos2 < editbox_len
      If editbox_ba(endpos2) = 62 Then
        found_endpos2 = True
        endpos2 = endpos2 + 1
        Exit Do
      Else
        endpos2 = endpos2 + 1
      End If
    Loop
    
    If Not found_endpos2 Then endpos2 = 0
    
    epos = endpos2

    If startpos2 <> 0 And endpos2 <> 0 _
    And startpos2 < endpos2 Then
      epos = startpos2
    ElseIf endpos2 = 0 And startpos2 <> 0 Then
      epos = startpos2
    ElseIf endpos2 = 0 And startpos2 = 0 Then
      epos = editbox_len 'Len(Form1.editbox.Text)
    End If

'startpos shows the position of <
'epos shows the end of tag

' to startpos deixnei sti thesi toy <
' to epos deixnei sto telos toy tag

'code to get the attributes that have been already been set and put them in the collections



' kodikas gia na briskei ta properties poy exoyme
' idi orisei kai na ta bazei katallila
' sto collection
    
    htmlwordlen = epos - startpos + 1
    htmlword$ = Space$(htmlwordlen)
    CopyMemory ByVal htmlword$, editbox_ba(startpos - 1), htmlwordlen
  
    
    'htmlword = Mid$(Form1.editbox.Text, startpos, epos - startpos + 1)
    'htmlwordlen = Len(htmlword)


    
    ReDim htmlword_ba(htmlwordlen)
    CopyMemory htmlword_ba(0), ByVal htmlword, htmlwordlen
    
    'eqpos = InStr(1, htmlword, "=") 'Form1.editbox.Find("=", 1) + 1 '

    eqpos = 0
    
    Dim found_eqpos As Boolean
    
    Do While eqpos < htmlwordlen
      If htmlword_ba(eqpos) = 61 Then
        found_eqpos = True
        eqpos = eqpos + 1
        Exit Do
      Else
        eqpos = eqpos + 1
      End If
    Loop
    
    If Not found_eqpos Then eqpos = 0
        
    Do While eqpos <> 0
    'ARXI BRISKOYME TO ATTRIBUTE NAME----------------------------------------------------------------
  'Start:We find the attribute name
  
  'we found a = now we skip the spaces before the = sign
  
    'BRIKAME TO = TORA KANOYME SKIP TA KENA PRIN TO =
    'psaxnoyme gia kena prin to = kai ta agnooyme
      k = 1
    'testch = Mid$(htmlword, eqpos - k, 1)
      Do While htmlword_ba(eqpos - k - 1) = 32 And eqpos - k > 0 'testch = " " And eqpos - k > 0
        k = k + 1
      'testch = Mid$(htmlword, eqpos - k, 1)
      Loop
  
    atendpos = eqpos - k

    L = 1
    
    
    
    'testch = Mid$(htmlword, atendpos - 1, 1)
      Do While htmlword_ba(atendpos - L - 1) <> 32 And atendpos - L > 0 'testch <> " " And atendpos - L > 0
        L = L + 1
        'testch = Mid$(htmlword, atendpos - L, 1)
      Loop

    atstpos = atendpos - L + 1

    'attribname = Mid$(htmlword, atstpos, atendpos - atstpos + 1)
    attribname$ = Space$(atendpos - atstpos + 1)
    
    
    CopyMemory ByVal attribname$, htmlword_ba(atstpos - 1), (atendpos - atstpos + 1)
    
    'TELOS BRISKOYME ATTRIBUTE NAME --------------------------------------------------------
    'End of finding attribute name
    
    
    'Start of :Finding attribute value
    
    'ARXI BRISKOYME ATTRIBUTE VALUE -----------------------------------------------------------------
    ' brikame to attribute name tora prospathoyme na
    ' broyme tin timi toy attribute
    
    ' We skip spaces after =
    
    ' AGNOOYME TA KENA META TO =
    k = 1
    'testch = Mid$(htmlword, eqpos + k, 1)
    Do While htmlword_ba(eqpos + k - 1) = 32 And eqpos + k <= htmlwordlen 'testch = " " And eqpos + k <= htmlwordlen
      k = k + 1
      'testch = Mid$(htmlword, eqpos + k, 1)
    Loop

    valspos = eqpos + k
    
  
    L = 1
    testch = htmlword_ba(valspos + L - 1) 'Chr$(htmlword_ba(valspos + L - 1)) ''Mid$(htmlword, valspos + L, 1)
    testch2 = htmlword_ba(valspos - 1) 'Chr$(htmlword_ba(valspos - 1)) 'Mid$(htmlword, valspos, 1)

    ' ean brikame eisagogika tote i timi tha einai
    'mexri ekei poy teleionoyn ta eisagogika
    Dim found_valendpos As Boolean
    If testch2 = 34 Then ' """"
    '   valendpos = InStr(valspos + 1, htmlword, """") 'Form1.editbox.Find("""", valspos + 1) + 1 '
      
      valendpos = valspos
      
      Do While valendpos < htmlwordlen
        If htmlword_ba(valendpos) = 34 Then
           valendpos = valendpos + 1
           found_valendpos = True
          Exit Do
        Else
          valendpos = valendpos + 1
        End If
      Loop
        
      If Not found_valendpos Then valendpos = 0
      
      valspos = valspos + 1
      valendpos = valendpos - 1
      If valendpos = -1 Then
        valendpos = htmlwordlen
      End If
    ElseIf testch2 = 39 Then ' "'"
    '   valendpos = InStr(valspos + 1, htmlword, "'") 'Form1.editbox.Find("'", valspos + 1) + 1 '
      valendpos = valspos
      
      Do While valendpos < htmlwordlen
        If htmlword_ba(valendpos) = 39 Then
           valendpos = valendpos + 1
           found_valendpos = True
          Exit Do
        Else
          valendpos = valendpos + 1
        End If
      Loop
        
      If Not found_valendpos Then valendpos = 0
            
      valspos = valspos + 1
      valendpos = valendpos - 1
      If valendpos = -1 Then
        valendpos = htmlwordlen
      End If

    Else

      Do While htmlword_ba(valspos + L - 1) <> 32 And htmlword_ba(valspos + L - 1) <> 60 And htmlword_ba(valspos + L - 1) <> 62 And valspos + L <= htmlwordlen
        L = L + 1
      'testch <> " " And testch <> ">" And testch <> "<" And valspos + L <= htmlwordlen
      '  L = L + 1
        'testch = Mid$(htmlword, valspos + L, 1)
      Loop

      valendpos = valspos + L - 1
    End If ' testch2=" or '
    'BRIKAME TI THESI TOY TELOYS TO ATTRIBUTE VALUE
    
    'attribval = Mid$(htmlword, valspos, valendpos - valspos + 1)
    attribval$ = Space$(valendpos - valspos + 1)
    CopyMemory ByVal attribval$, htmlword_ba(valspos - 1), (valendpos - valspos + 1)
    
    tatname.Add attribname
    tatval.Add attribval
    tatnamepos.Add startpos + atstpos - 2
    tatvalpos.Add startpos + valspos - 2


    'eqpos = InStr(eqpos + 1, htmlword, "=") 'Form1.editbox.Find("=", eqpos + 1) + 1 '
    
    found_eqpos = False
    
    eqpos = valendpos
    Do While eqpos < htmlwordlen
      If htmlword_ba(eqpos) = 61 Then
        found_eqpos = True
        Exit Do
      Else
        eqpos = eqpos + 1
      End If
    Loop
    
    If Not found_eqpos Then
      eqpos = 0
    Else
      eqpos = eqpos + 1
    End If
        
  Loop



  End If
End If





Exit Sub

errorhandler:


End Sub


Public Function gettagnum(ByVal startpos As Long) As Integer
Dim spos As Long
Dim epos As Long
Dim k As Long

On Error GoTo errorhandler


Dim tagval As String
'spos = InStrRev(Form1.editbox.Text, "<", startpos)
spos = startpos - 1
Do While spos >= 0
  If editbox_ba(spos) = 60 Then
    Exit Do
  Else
    spos = spos - 1
  End If
Loop
spos = spos + 1
epos = startpos - 1
'epos = InStrRev(Form1.editbox.Text, ">", startpos)
Do While epos >= 0
  If editbox_ba(epos) = 62 Then
    Exit Do
  Else
    epos = epos - 1
  End If
Loop
epos = epos + 1


If (spos = 0) Or (epos <> 0 And spos <> 0 And spos < epos) Then
  gettagnum = 888
  Exit Function
End If


  
  
  spos = spos + 1

  
  k = 1 ' 61="=" 13=vbcr 62=">" 10=vblf 32=" "
  Do While editbox_ba(spos - 1 + k) <> 61 And editbox_ba(spos - 1 + k) <> 13 _
  And editbox_ba(spos - 1 + k) <> 62 And editbox_ba(spos - 1 + k) <> 10 And editbox_ba(spos - 1 + k) <> 32
  k = k + 1
  Loop
  
    
  tagval$ = Space$(k)
  CopyMemory ByVal tagval$, editbox_ba(spos - 1), k
  
  
  
  

  tagnum = findtag(tagval)

  gettagnum = tagnum

Exit Function

Exit Function
errorhandler:
tindex = 888
tnamepos = -1
gettagnum = 888
End Function


Private Sub cmd_getattributes_Click()
getattributes editbox.SelStart, False

List1.Clear

For k = 1 To tatval.Count
  List1.AddItem CStr(tatname(k)) + " (Position : " + CStr(tatnamepos(k)) + " ) with value =" + CStr(tatval(k)) + " (Position: " + CStr(tatvalpos(k)) + " )"
Next k

End Sub

Private Sub Form_Load()
kol(0) = "a"
kol(1) = "abbr"
kol(2) = "acronym"
kol(3) = "address"
kol(4) = "applet"
kol(5) = "area"
kol(6) = "b"
kol(7) = "base"
kol(8) = "basefont"
kol(9) = "bdo"
kol(10) = "big"
kol(11) = "blockquote"
kol(12) = "body"
kol(13) = "br"
kol(14) = "button"
kol(15) = "caption"
kol(16) = "center"
kol(17) = "cite"
kol(18) = "code"
kol(19) = "col"
kol(20) = "colgroup"
kol(21) = "dd"
kol(22) = "del"
kol(23) = "dfn"
kol(24) = "dir"
kol(25) = "div"
kol(26) = "dl"
kol(27) = "dt"
kol(28) = "em"
kol(29) = "fieldset"
kol(30) = "font"
kol(31) = "form"
kol(32) = "frame"
kol(33) = "frameset"
kol(34) = "h1"
kol(35) = "h2"
kol(36) = "h3"
kol(37) = "h4"
kol(38) = "h5"
kol(39) = "h6"
kol(40) = "head"
kol(41) = "hr"
kol(42) = "html"
kol(43) = "i"
kol(44) = "iframe"
kol(45) = "ilayer"
kol(46) = "img"
kol(47) = "input"
kol(48) = "ins"
kol(49) = "isindex"
kol(50) = "kbd"
kol(51) = "label"
kol(52) = "legend"
kol(53) = "li"
kol(54) = "link"
kol(55) = "map"
kol(56) = "menu"
kol(57) = "meta"
kol(58) = "noframes"
kol(59) = "noscript"
kol(60) = "object"
kol(61) = "ol"
kol(62) = "optgroup"
kol(63) = "option"
kol(64) = "p"
kol(65) = "param"
kol(66) = "plaintext"
kol(67) = "pre"
kol(68) = "q"
kol(69) = "s"
kol(70) = "samp"
kol(71) = "script"
kol(72) = "select"
kol(73) = "small"
kol(74) = "span"
kol(75) = "strike"
kol(76) = "strong"
kol(77) = "style"
kol(78) = "sub"
kol(79) = "sup"
kol(80) = "table"
kol(81) = "tbody"
kol(82) = "td"
kol(83) = "textarea"
kol(84) = "tfoot"
kol(85) = "th"
kol(86) = "thead"
kol(87) = "title"
kol(88) = "tr"
kol(89) = "tt"
kol(90) = "u"
kol(91) = "ul"
kol(92) = "var"
kol(93) = "!--"

Dim intf As Integer
intf = FreeFile
Open App.Path + "\index.html" For Input As #intf
Do While Not EOF(intf)
  Line Input #intf, kokostr
  editbox.Text = editbox.Text + kokostr + vbNewLine
Loop

Close #intf


End Sub
Public Function findtag(ByVal seektag As String) As Integer
L = 0

Do While found = False And L < UBound(kol)
If StrComp(seektag, kol(L), vbTextCompare) = 0 Then
findtag = L
Exit Function
Else
L = L + 1
End If
Loop

'if we did not find the tag we return the number 888
If found = False Or seektag = "" Then
findtag = 888
End If

End Function