Получение атрибутов тэгов - Разное - Интересные решения для программистов - Примеры кода

Разное → Получение атрибутов тэгов → Visual Basic

Довольно интересный пример, позволяющий получить атрибуты любого тэга, хотя конечно, реализация немного кривая, но он работает :)

'Для работы требуется файл 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

attribute, tag, vb, visual basic

KOS_MOS

Алексей

19.10.2008

Меню

Подписка на RSS:

Подпишись на RSS-ленту

Поиск

Облако тегов

	Разное → Получение атрибутов тэгов → Visual Basic Довольно интересный пример, позволяющий получить атрибуты любого тэга, хотя конечно, реализация немного кривая, но он работает :) 'Для работы требуется файл 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 attribute, tag, vb, visual basic KOS_MOS Алексей 19.10.2008 Ваше имя Ваш E-mail (если хотите отслеживать комментарии) Дoкажи, что ты не робот Текст комментария	Меню CodeIgniter Алгоритмы Базы данных Дата и Время Интернет Интерфейс Мультимедиа ОС и Железо Работа с текстом Разное Технологии Файлы Подписка на RSS: Подпишись на RSS-ленту Поиск Облако тегов .net array asp bash browser charset check class clean convert count create css curl database date delete directory download element email equivalent extension file find form format function get height html http ie image javascript jquery load mysql number page perl php random scriplet send shell size sql string text time url utf8 variable vb visual basic width window xml xslt