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

[kibernetics]

Всем привет!
Нужно переименовать кучу нонейм-файлов(*.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

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

[Хакер]

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

Хотя, в твоём случае, наверное, пойдёт даже твой способ, только излеченный от кривоты.

[Antonariy]

А еще лучше просто считай весь файл в память, юзай InStr и пиши обратно.

[ALX_2002]

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

Здесь уже сразу перебор файлов в каталоге и их переименование в соответствии с текстом в теге 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]

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

[ALX_2002]

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

[Crio]

Так пойдёт?

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

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]

Crio
спасибо чел , нет возможности сейчас затестить, проджект дома. я ещё вспомнил, как мне когда-то 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]

Так ведь VB сам по себе язык не очень шустрый... А желание пусть прилипнет обратно, ведь кто знает, сколько на свете подобных программ... Так ведь можно вообще ничего не писать, мол, такая прога уже есть... Напиши для себя и оставь, в худшем случае, как пример.

[Viper]

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

[kibernetics]

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

[Arcady_XQST]

нешустрость VB это вопрос весьма спорный.

В данной теме, по-моему, не спорный. Не будем спорить