Кто подскажет быстрое извлечение тега <title> из html?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
kibernetics
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 949
Зарегистрирован: 03.05.2006 (Ср) 13:31
Откуда: Minsk

Кто подскажет быстрое извлечение тега <title> из html?

Сообщение kibernetics » 25.11.2007 (Вс) 4:05

Всем привет!
Нужно переименовать кучу нонейм-файлов(*.htm) из информации в теге <title>...</title>
По сути, перебираю каждый файл, и ищу в нём строку <title>, если есть, ищу </title>, ну и разница между ними, собственно, и есть будущее имя файла. Но скорость! Скорость реально не устраивает. Тормоза в этом коде:
Код: Выделить всё
Function FindInFile(sSearch As String) As Long
    Dim iFile As Integer
    Dim lFileLength As Long
    Dim sChunck As String
    Dim lChunckStart As Long
    Dim lPosition As Long
    Const MaxChunkSize = 20000

    iFile = FreeFile

    FindInFile = -1

    Open sItems(i, 0) For Binary Access Read Shared As iFile
    lFileLength = LOF(iFile)
    lChunckStart = 0

    Do Until lChunckStart = lFileLength
        If lFileLength - lChunckStart > MaxChunkSize Then
            sChunck = Input$(MaxChunkSize, iFile)
            lChunckStart = lChunckStart + MaxChunkSize - Len(sSearch)
        Else
            sChunck = Input$(lFileLength - lChunckStart, iFile)
            lChunckStart = lFileLength
        End If
        lPosition = InStr(sChunck, sSearch)
        If lPosition > 0 Then
            FindInFile = WasFoundAt
            Exit Do
        End If
    Loop

    Close iFile

End Function

может читать в байтовый массив и в нём поиск наводить? Да, явно есть что-то быстрее...
У кого есть какие-нибудь соображения по ускорению алгоритма?

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16489
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Сообщение Хакер » 25.11.2007 (Вс) 10:27

Читай в строку и используй регулярные выражения.

Хотя, в твоём случае, наверное, пойдёт даже твой способ, только излеченный от кривоты.
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Antonariy
Повелитель Internet Explorer
Повелитель Internet Explorer
Аватара пользователя
 
Сообщения: 4824
Зарегистрирован: 28.04.2005 (Чт) 14:33
Откуда: Мимо проходил

Сообщение Antonariy » 25.11.2007 (Вс) 10:32

А еще лучше просто считай весь файл в память, юзай InStr и пиши обратно.
Лучший способ понять что-то самому — объяснить это другому.

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2056
Зарегистрирован: 25.11.2002 (Пн) 20:03

Сообщение ALX_2002 » 25.11.2007 (Вс) 13:16

День добрый. Может не совсем умный вариант, но работает довольно быстро. Код универсален - как для VBS-ка, так и для VB. Может чем поможет :roll:

Здесь уже сразу перебор файлов в каталоге и их переименование в соответствии с текстом в теге TITLE. Принцип прост. Перебираем все файлы с раширением HTM, HTML грузим их тело HTMLDocument и берём из тега TITLE текст.

Код: Выделить всё

Dim FileSystemObject
'/// Создание объекта для работы с файловой системой
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

Dim FolderPath, Folder
'/// Получение пути каталога из которого произошёл запуск макроса
FolderPath = FileSystemObject.GetParentFolderName(Wscript.ScriptFullName)

'/// Получаем каталог
Set Folder = FileSystemObject.GetFolder(FolderPath)

Dim HTMLDocument,TextStream

'/// Создаём объект HTMLDocument.
Set HTMLDocument = CreateObject("HTMLFile")

For Each File in Folder.Files

   ExtensionName = FileSystemObject.GetExtensionName(File.Name)

   Select Case UCase(ExtensionName)
   Case "HTML","HTM"
'/// Открываем документ и пишем в него тело файла
      HTMLDocument.Open
      HTMLDocument.write FileSystemObject.OpenTextFile(File.Path,1,False).ReadAll
      HTMLDocument.Close

'/// Получаем текст из тега TITLE и переименовываем документ

      If HTMLDocument.title <> "" Then
         File.Name = HTMLDocument.title & "." & ExtensionName
      End if
   End Select
Next

kibernetics
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 949
Зарегистрирован: 03.05.2006 (Ср) 13:31
Откуда: Minsk

Сообщение kibernetics » 25.11.2007 (Вс) 14:41

ALX_2002
спасибо дружище, но я пишу как бы универсальный вариант. т.е. он не заточен только для html-файлов. Предполагается, что приложение будет исследовать различные типы файлов. Поэтому и нужно проходить по файлу с разными трафаретами для поиска искомого значения. Наверное, вариант с html не совсем удачный я привёл...

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2056
Зарегистрирован: 25.11.2002 (Пн) 20:03

Сообщение ALX_2002 » 25.11.2007 (Вс) 15:04

Ааа. :) Ну не вопрос. Тогда через XMLDocument наверное можно попробывать :)

Crio
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 84
Зарегистрирован: 21.05.2007 (Пн) 12:01
Откуда: Питер

Сообщение Crio » 25.11.2007 (Вс) 17:03

Так пойдёт?

Код: Выделить всё
Function fncSnitcher(strPath As String, strStart As String, strEnd As String) As String

Dim strStringPlace As String
Dim lngStartPos As Long
Dim lngEndPos As Long

Dim intMyFile As Integer
Dim lngFileLenght As Long

  intMyFile = FreeFile

  fncSnitcher = ""

  Open strPath For Binary Access Read Shared As intMyFile
  lngFileLenght = LOF(intMyFile)

  strStringPlace = Input$(lngFileLenght, intMyFile)
  lngStartPos = InStr(1, strStringPlace, strStart, vbBinaryCompare)

  If lngStartPos > 0 Then
    lngEndPos = InStr(lngStartPos, strStringPlace, strEnd, vbBinaryCompare)

    If lngStartPos > 0 Then
      lngStartPos = lngStartPos + Len(strStart)
      fncSnitcher = Mid(strStringPlace, lngStartPos, lngEndPos - lngStartPos)

    End If

  End If

  Close intMyFile

End Function

kibernetics
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 949
Зарегистрирован: 03.05.2006 (Ср) 13:31
Откуда: Minsk

Сообщение kibernetics » 27.11.2007 (Вт) 16:13

Crio
спасибо чел :thumright:, нет возможности сейчас затестить, проджект дома. я ещё вспомнил, как мне когда-то Amed подсказывал вот такой код, немного не по теме, но как вариант:
Amed писал(а):
Код: Выделить всё
Option Explicit
Private Declare Function GetTickCount& Lib "kernel32" ()

Private Sub Form_Load()
Dim tmparr() As Byte
Dim flen As Long
Const N As Integer = 10 'число частей
Dim part As Long, rest As Long 'байт в каждой части + остаток
Const CutStart As Long = 270336 '42000h
Dim i As Long
Dim time1 As Long, time2 As Long

time1 = GetTickCount

'Вырезаем из нового файла из каждого куска по 528 байт 512 байт
flen = FileLen("C:\test.iso") - CutStart
ReDim tmparr(512)
Open "C:\test.iso" For Binary As #1
    Open "C:\result.iso" For Binary As #2
        For i = 1 To flen \ 528
            Get #1, CutStart + 528 * (i - 1) + 1, tmparr
            Put #2, 512 * (i - 1) + 1, tmparr
            DoEvents
        Next i
    Close #2
Close #1
time2 = GetTickCount&

MsgBox "Процесс занял " & (time2 - time1) / 1000 & " секунд."
End Sub



П.С. я глянул прогу одну, File Investigator, так вот она определяет файлы без расширений в папке почти мгновенно, причём с вычитыванием тега <title>. Как она это делает незнаю, но что быстрее,чем на Бейсике это точно. Может файл-маппинг там применяется. может ещё чё...
Но после всего увиденного желание отпадает что-то делать из-за скорости.

Arcady_XQST
Обычный пользователь
Обычный пользователь
 
Сообщения: 85
Зарегистрирован: 17.09.2007 (Пн) 1:27
Откуда: Russia, Bryansk

Сообщение Arcady_XQST » 30.11.2007 (Пт) 16:30

Так ведь VB сам по себе язык не очень шустрый... А желание пусть прилипнет обратно, ведь кто знает, сколько на свете подобных программ... Так ведь можно вообще ничего не писать, мол, такая прога уже есть... Напиши для себя и оставь, в худшем случае, как пример.
// тили-тили, трали-вали
if (jsLoaded) {
// это дело мне по силе, откажусь теперь едва ли
} else {
// это мы не проходили, это нам не задавали
}

Viper
Артефакт VBStreets
Артефакт VBStreets
Аватара пользователя
 
Сообщения: 4394
Зарегистрирован: 12.04.2005 (Вт) 17:50
Откуда: Н.Новгород

Сообщение Viper » 30.11.2007 (Пт) 16:56

Arcady_XQST, нешустрость VB это вопрос весьма спорный.
kibernetics, а ничто не мешают юзать файл-мэппинг на VB, в кирпичах модуль иесть.
Весь мир матрица, а мы в нем потоки байтов!

kibernetics
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 949
Зарегистрирован: 03.05.2006 (Ср) 13:31
Откуда: Minsk

Сообщение kibernetics » 30.11.2007 (Пт) 17:08

я просто уже сомневаюсь.
а понадобится ли он кому-то...
идея есть, а вот рентабельность под вопросом

Arcady_XQST
Обычный пользователь
Обычный пользователь
 
Сообщения: 85
Зарегистрирован: 17.09.2007 (Пн) 1:27
Откуда: Russia, Bryansk

Сообщение Arcady_XQST » 30.11.2007 (Пт) 23:57

Viper писал(а):нешустрость VB это вопрос весьма спорный.
В данной теме, по-моему, не спорный. Не будем спорить :)
// тили-тили, трали-вали
if (jsLoaded) {
// это дело мне по силе, откажусь теперь едва ли
} else {
// это мы не проходили, это нам не задавали
}


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: SemrushBot и гости: 11

    TopList