Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Visual Basic (VB).

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

Открыть новую тему     Написать ответ в эту тему

NEOMATRIX



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору


Данный топик предназначен только для обсуждения типовых задач на Visual Basic.
Обсуждение задач на VBA (а именно, Excel, Word, Access) строго запрещено!
Пишите в соответствующих топиках.

 
Родственные топики:
  • Excel VBA - часть 1, часть 2 - все вопросы по Excel VBA туда
  • Word VBA все вопросы по Word VBA туда
  • Access все вопросы по программированию в Access туда
  • VBScript - программирование "удобняшек" на VBScript
  • QBasic - типовые задачи на QBasic
     
  • Date Time Functions In Visual Basic
  • VB6's Trig, Math, Financial, Boolean, and Random functions
  • Visual Basic 6 String Functions
  • VB6 Number System Functions (Hex, Oct, Etc)
  • VB6's DateAdd function
     
  • Functions (Visual Basic)
  • Keywords and Members by Task
  • Visual Basic Reference
     
  • Visual Basic String Manipulation Tutorials
     
  • Top 10 Visual Basic Sins

     
    Учебники:
    Visual Basic для студентов и школьников. Культин Н. (2010)
    Занимательное программирование на Visual Basic.NET. Климов А. (2005)
    Visual Basic в задачах и примерах. Сафронов (2009)
    Visual Basic 2012 на примерах. Зиборов В. (2012)

  • Всего записей: 202 | Зарегистр. 29-12-2004 | Отправлено: 19:30 16-11-2005 | Исправлено: XPerformer, 10:07 28-10-2014
    ptr73

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Devils_0411
    Нужно вешать обработчик события на каждый чекбокс, чтобы при изменении его значения сразу отрабатывала процедура проверки и изменения значения соседнего чекбокса.

    Всего записей: 253 | Зарегистр. 03-07-2007 | Отправлено: 08:22 22-04-2015
    Swede1975

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Подробнее...

    Всего записей: 2 | Зарегистр. 03-11-2015 | Отправлено: 12:39 03-11-2015
    Student1



    Екатеринбуржец
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Есть некая таблица в виде веб страницы, нужно искать периодически определенное значение в коде и если оно найдено отправлять оповещение. Как-то это можно на VB или как-то иначе?

    ----------
    Student

    Всего записей: 1211 | Зарегистр. 13-02-2003 | Отправлено: 10:18 22-05-2017
    tarrac



    Full Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

    Цитата:
    Есть некая таблица в виде веб страницы, нужно искать периодически определенное значение в коде и если оно найдено отправлять оповещение.

     
    Тем же перлом забираете страницу, парсите и если нашли - шлете мылом на почту )  

    Всего записей: 414 | Зарегистр. 29-09-2003 | Отправлено: 15:33 08-06-2017
    landy



    Full Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    из VB можно вызвать HttpWebRequest

    Всего записей: 576 | Зарегистр. 17-01-2003 | Отправлено: 11:00 22-06-2017
    thejustsoul



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Подскажите как сделать лаунчер (запускает другую программу с нужными параметрами) так, чтобы его вывод был в консоль, а не как отдельное окно, есть примерно такой код:

    Код:
     
    Private Sub Main()
        If Len(Command) Then
            Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe" & " " & Command, vbNormalFocus
        Else
            Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe", vbNormalFocus
        End If
    End Sub
     

     
    Запускает следующее:

    Код:
    "D:\tmp\app\python\python.exe" "D:\tmp\app\app-script.py" --param-one "D:\tmp\app\ext\ext1.exe" --param-two "D:\tmp\app\ext\ext2.exe"

     
    Если его изменить через:

    Код:
    LINK.EXE /EDIT /SUBSYSTEM:CONSOLE Project1.exe

    То, приложение становится консольным, но вывод его в консоли как бы "без новой строчки" печатается, т.е.:
     
    Должно вывести версию:

    Код:
    D:\tmp>Project1.exe -V

    Вывод получается такой:

    Код:
    D:\tmp>app-script.py 1.0

    Вместо:

    Код:
    D:\tmp>
    app-script.py 1.0

     
    Т.е. как добавить пустые строки после (а может и до) запуска программы в консоли?
     
    З.Ы. VB6.

    Всего записей: 1789 | Зарегистр. 30-03-2014 | Отправлено: 15:13 15-11-2017 | Исправлено: thejustsoul, 15:28 15-11-2017
    MihailM



    BANNED
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    thejustsoul , а этот код что не работает "vbcrlf"=переход на новую строчку .
    А кстати а не проще , через батник всё сделать ?
     

    Всего записей: 2498 | Зарегистр. 19-10-2003 | Отправлено: 16:31 15-11-2017 | Исправлено: MihailM, 16:31 15-11-2017
    thejustsoul



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    MihailM

    Цитата:
    А кстати а не проще , через батник всё сделать ?  

    Проще, но захотелось на VB6, а про vbcrlf я где-то видел, но как это применить? Код выше, куда это прописать?

    Всего записей: 1789 | Зарегистр. 30-03-2014 | Отправлено: 17:09 15-11-2017
    MihailM



    BANNED
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    thejustsoul

    Цитата:
    Проще, но захотелось на VB6, а про vbcrlf я где-то видел, но как это применить? Код выше, куда это прописать?
    ну где ты хочешь чтобы был переход новой строчки туда и пиши , по аналогии как и с текстом или командами.
     

    Всего записей: 2498 | Зарегистр. 19-10-2003 | Отправлено: 17:27 15-11-2017 | Исправлено: MihailM, 17:28 15-11-2017
    thejustsoul



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    MihailM
    Попросил же в коде показать куда дописать, мне это ни о чем не говорит "ну где ты хочешь чтобы был переход новой строчки туда и пиши , по аналогии как и с текстом или командами.". Если не знаете, лучше промолчать, чем ничем не помочь. Я не шарю в vb, по-этому и спросил.

    Код:
    Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe" & vbcrlf, vbNormalFocus  
    Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe", vbNormalFocus & vbcrlf

    Так как и куда?

    Всего записей: 1789 | Зарегистр. 30-03-2014 | Отправлено: 17:52 15-11-2017
    MihailM



    BANNED
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    thejustsoul, слышь , тебе вроде помочь , решили а ты еще и недоволен ..
    Я что знаю куда тебе надо прописать то , ты что сам написал то :  

    Цитата:
    Т.е. как добавить пустые строки после (а может и до) запуска программы в консоли?  

    Определились бы сначала , а потом уже возмущаётесь. Если тебе в конец нужно, значит пишите в конец ,если в начало значит в начало , значит после "Shell ... .

    Код:
    Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe" & vbcrlf, vbNormalFocus  
    Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe"& vbcrlf, vbNormalFocus  
     
    вот так , во второй строчке ошибся чуток . , так же как и в первой , перед ", vbNormalFocus"
    А так ,если тебе надо  "до"  значит пиши до , если "после" значит пиши после. Что означает команда я тебе написал , всё.  Потом если не правильно , ты же можешь всегда проверить в работе правильно или нет ..
    p.s. если в VB дуб-дубом , написали бы ..

    Всего записей: 2498 | Зарегистр. 19-10-2003 | Отправлено: 18:14 15-11-2017 | Исправлено: MihailM, 18:26 15-11-2017
    thejustsoul



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    MihailM
    На личности не переходи и не тыкай мне, "слышь", не на улице. Еще раз внимательно перечитай вопрос, там же написал, что хочу получить в итоге. И не надо из себя строить тут. Я не знаю куда надо добавлять перенос строки, но если ты знаешь как правильно, приведи правильный код. Логично если печатается результат запуска на той же строке где и приглашение командной строки, значит надо сделать перенос вначале. И в конце, т.к. после завершения программы приходится нажимать Enter.
     

    Код:
    Shell """" & App.Path & "\app\python\python.exe" & """ """ & App.Path & "\app\app-script.py" & """ " & "--param-one" & " """ & App.Path & "\app\ext\ext1.exe" & """ " & "--param--two" & " """ & App.Path & "\app\ext\ext2.exe" & vbcrlf, vbNormalFocus
    не решило проблему. Я не знаю как это на VB, если бы это была проблема с батником, я бы допустим написал бы вначале и после команды "echo.", а на VB я не знал, что есть такая проблема и что надо стать шаманом и в бубен постучать, чтобы это решить.
     
    з.ы. Если не хочешь помогать, не помогай, подожду более компетентного и дружелюбного товарища.

    Всего записей: 1789 | Зарегистр. 30-03-2014 | Отправлено: 18:40 15-11-2017 | Исправлено: thejustsoul, 18:40 15-11-2017
    MihailM



    BANNED
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    thejustsoul, по поводу перехода на личности ничего такого , просто попытался помочь , а ты еще и недоволен ..
    По поводу вопроса ты сам не понятно написал до или после тебе надо ..если ты в ВБ не ахти тоже написал бы , а то код как бы не маленький ..
    а так по той же аналогии добавь тогда , только в начале "& App.Path". ну или куда тебе надо .
    shell команда в "", добавка как вызывать..
    thejustsoul
    Цитата:
    запуск программы в зависимости от того, передали ли ей какие-то параметры или нет,

    Параметры запуска можно узнать вот этой командой "Command$"
    ушел, если что позже попробую помочь ..

    Всего записей: 2498 | Зарегистр. 19-10-2003 | Отправлено: 18:47 15-11-2017 | Исправлено: MihailM, 11:08 16-11-2017
    thejustsoul



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    MihailM
    Так я попробовал перед Shell, после Shell, после и перед кавычками (вначале, после каждой попробовал), но не дает запустить код.. То файл не найден, то еще какая-то ошибка.
    А код простейший, запуск программы в зависимости от того, передали ли ей какие-то параметры или нет, если нет - запускается без параметров (внешних), если передали то с ними.
    Если только в конец добавить перед последней запятой, то все равно приходится нажимать Enter, т.е. не печатается перенос в консоль..
     
    Если что, можно такой батник в качестве цели попробовать (вместо python, что в коде выше):

    Код:
    @setlocal
    @if [%1]==[] goto NO_ARGUMENT else goto SHOW_PARAM
    :SHOW_PARAM
    @echo %*
    @endlocal
    @goto :EOF
    :NO_ARGUMENT
    @echo No Parameter
    @endlocal
    @goto :EOF

     
    И запускать программу в открытой консоли, типа "Project1.exe -V".

    Всего записей: 1789 | Зарегистр. 30-03-2014 | Отправлено: 19:09 15-11-2017 | Исправлено: thejustsoul, 19:23 15-11-2017
    thejustsoul



    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Неужели нет больше экспертов в VB6?

    Всего записей: 1789 | Зарегистр. 30-03-2014 | Отправлено: 19:29 18-11-2017
    Vlad AG

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Задача: написать программу на VB которая в заданном  файле WORD подсчитывает количество закладок и выводит список их имен.
    Кто может подсказать?

    Всего записей: 2 | Зарегистр. 04-01-2018 | Отправлено: 08:35 05-01-2018
    serov001

    BANNED
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ищу видеокурсы для обучения с нуля

    Всего записей: 24 | Зарегистр. 01-02-2018 | Отправлено: 18:25 04-02-2018
    DenSyo

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    разбор строки по тэгам с учетом экранирующих символов. с большим текстом работает не быстро, у себя использую главным образом для разбора уже выделенных фрагментов кода. в данной версии не учтено экранирование экранирующего внутри кавычек символа.  
     

    Код:
    ' структура тэгов: countTags - количество найденных тэгов,  
    ' openTags() - массив найденных позиций в разбираемой строке открывающих тэгов, closeTags() - массив позиций в строке закрывающих тэгов
    Public Type TagString
        sourceStr As String
        openTag As String
        closeTag As String
        parseFlag As Byte
        escapeChar As String
        countTags As Long
        openTags() As Long
        closeTags() As Long
    End Type
     
    ' Txt - разбираемая строка, openTag - открывающий тэг, closeTag - закрывающий тэг
    ' pFlag - младший бит: двойная кавычка экранирует тэги, второй бит: одинарная кавычка экранирует тэги,
    ' третий бит: символ escChr (по умолчанию \ ) экранирует кавычки в кавычках
    Function TagStr(ByVal Txt As String, ByVal openTag As String, ByVal closeTag As String, Optional ByVal pFlag As Byte = 0, Optional ByVal escChr As String = "\") As TagString
        Dim i As Long, k As Long, j As Long, ko As Long, kc As Long, ke As Long, opTags() As Long, clTags() As Long
        Dim pState As Integer
        Dim c As String
         
        ko = Len(openTag)
        kc = Len(closeTag)
        ke = Len(escChr)
        TagStr.sourceStr = Txt
        TagStr.openTag = openTag
        TagStr.closeTag = closeTag
        TagStr.parseFlag = pFlag
        TagStr.escapeChar = escChr
        TagStr.countTags = 0
        If Len(Txt) > 0 And ko > 0 And kc > 0 And Not ((pFlag And 4) And ke = 0) Then
            pState = 1
            i = 1
            k = 0
            Do While i <= Len(Txt)
                Select Case pState
                Case 1, 11:
                    If Mid(Txt, i, ko) = openTag Then
                        k = k + 1
                        ReDim Preserve opTags(0 To k)
                        opTags(k) = i
                        ReDim Preserve clTags(0 To k)
                        clTags(k) = 0
                        pState = 11
                        i = i + ko - 1
                    Else
                        If (Mid(Txt, i, 1) = """" And (pFlag And 1)) Or (Mid(Txt, i, 1) = "'" And (pFlag And 2)) Then
                            c = Mid(Txt, i, 1)
                            pState = pState + 1
                        Else
                            If Mid(Txt, i, kc) = closeTag And pState = 11 Then
                                For j = k To 1 Step -1
                                    If clTags(j) = 0 Then
                                        clTags(j) = i
                                        If j = 1 Then pState = 1
                                        Exit For
                                    End If
                                Next j
                                i = i + kc - 1
                            End If
                        End If
                    End If
                Case 2, 12:
                    If Mid(Txt, i, ke + Len(c)) = escChr & c And (pFlag And 4) Then i = i + ke + Len(c) - 1 Else If Mid(Txt, i, Len(c)) = c Then pState = pState - 1
                End Select
                i = i + 1
            Loop
            i = 0
            For j = 1 To k
                If clTags(j) > 0 Then
                    i = i + 1
                    ReDim Preserve TagStr.openTags(0 To i)
                    TagStr.openTags(i) = opTags(j)
                    ReDim Preserve TagStr.closeTags(0 To i)
                    TagStr.closeTags(i) = clTags(j)
                End If
            Next j
            TagStr.countTags = i
        End If
     
    End Function
     
    ' возвращает содержимое между тэгами разобранной строки по номеру тэга n
    Function SubTagStr(Txt As TagString, n As Long) As String
        SubTagStr = ""
        If Abs(n) <= Txt.countTags And n <> 0 Then
            On Error Resume Next
            SubTagStr = Mid(Txt.sourceStr, Txt.openTags(n) + Len(Txt.openTag), Txt.closeTags(n) - Txt.openTags(n) - Len(Txt.openTag))
        End If
    End Function
     
    ' удаление из разбираемой строки найденных тэгов с содержимым  
    Function DelTagStr(Txt As TagString, Optional delChr As String = "") As String
        Dim i As Long
        Dim s As String
         
        If delChr = "" Then delChr = Chr(127) Else delChr = Left(delChr, 1)
        DelTagStr = Txt.sourceStr
        For i = 1 To Txt.countTags
            Mid(DelTagStr, Txt.openTags(i), Txt.closeTags(i) - Txt.openTags(i) + Len(Txt.closeTag)) = String(Txt.closeTags(i) - Txt.openTags(i) + Len(Txt.closeTag), delChr)
        Next i
        DelTagStr = Replace(DelTagStr, delChr, "")
    End Function

     
    пример:

    Код:
    Sub tagTest1()
        Dim st As TagString
        Dim s As String
     
        s = "fwdjfwdnkf3348934t34i<doc>wefiwefwe</doc>fewfwef dfsdf rfwerfweef <doc>wefw wefwefwe fwe</doc>fwewef"
        st = TagStr(s, "<doc>", "</doc>")
        s = DelTagStr(st)
    End Sub
     
    Sub tagTest2()
        Dim st As TagString
        Dim s As String
     
        s = " ( ( '( \' ) )' (  ) )"
        st = TagStr(s, "(", ")", 7)
        s = SubTagStr(st, 1)
    End Sub

     
    Добавлено:
    Vlad AG
    гоу в профильную тему!
    http://forum.ru-board.com/topic.cgi?forum=33&topic=5312&start=760#lt

    Всего записей: 218 | Зарегистр. 19-01-2008 | Отправлено: 04:01 05-02-2018
    5peciali5t



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Всех приветствую!
    Нужна помощь по выделению свойств msp файла в переменную
    Обсуждение тут http://forum.ru-board.com/topic.cgi?forum=33&topic=11963&start=920#13
    Буду признателен за советы

    ----------
    Intel Ci7-2600K 3.4@4.5 Ghz/GeForce GTX 550 Ti 1024Mb/240Gb SSD+9Tb HDD's/RAM 16 Gb DDR3 1600/23" ACER T231Hbmid Multi-Touch Sensor Display

    Всего записей: 1472 | Зарегистр. 17-07-2009 | Отправлено: 09:29 02-04-2018
    DenSyo

    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    5peciali5t
    тестовое решение в лоб на VBA

    Код:
    Function CaseFirstNonzero(ParamArray params() As Variant) As Long
        Dim i As Integer, k As Integer
         
        CaseFirstNonzero = -1
        k = UBound(params(), 1)
        For i = 0 To k
            If CLng(params(i)) > 0 Then If CaseFirstNonzero = -1 Then CaseFirstNonzero = CLng(params(i)) Else If CaseFirstNonzero > CLng(params(i)) Then CaseFirstNonzero = CLng(params(i))
        Next i
    End Function
     
    Function CaseMax(ParamArray params() As Variant) As Long
        Dim i As Integer, k As Integer
         
        CaseMax = -1
        k = UBound(params(), 1)
        For i = 0 To k
            If CaseMax = -1 Then CaseMax = CLng(params(i)) Else If CaseMax < CLng(params(i)) Then CaseMax = CLng(params(i))
        Next i
    End Function
     
    Function mspVersion(fileMask As String, Optional ByVal strDelim As String = "") As String
        Dim fso As Object, fileObj As Object
        Dim fileName As String, filePath As String, fileBuff As String, s As String
        Dim k As Long, kk As Long, n1 As Long, n2 As Long, n3 As Long, n4 As Long
         
        mspVersion = ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        If strDelim = "" Then strDelim = Chr(13) & Chr(10)
        k = InStrRev(fileMask, "\")
        If k > 0 Then filePath = Left(fileMask, k) Else filePath = ""
        fileName = Dir(fileMask)
        Do While fileName <> ""
            mspVersion = mspVersion & "file: " & fileName & Chr(13) & Chr(10)
            Set fileObj = fso.OpenTextFile(filePath & fileName, 1, True, 0)
            On Error Resume Next
            fileBuff = fileObj.ReadAll
            fileObj.Close
            k = InStr(1, fileBuff, ".PatchCodePATCHNEWPACKAGECODEPATCHNEWSUMMARYSUBJECT")
            If k > 0 Then
                k = k + Len(".PatchCodePATCHNEWPACKAGECODEPATCHNEWSUMMARYSUBJECT")
                kk = InStr(k, fileBuff, "PATCHNEWSUMMARYCOMMENTS")
                If kk = 0 Then
                    n1 = InStr(k, fileBuff, Chr(0))
                    n2 = InStr(k, fileBuff, Chr(1))
                    n3 = InStr(k, fileBuff, "_")
                    n4 = InStr(k, fileBuff, "#")
                    kk = CaseFirstNonzero(n1, n2, n3, n4)
                    If kk > 0 Then mspVersion = mspVersion & "patch: " & Mid(fileBuff, k, kk - k) & Chr(13) & Chr(10)
                Else
                    mspVersion = mspVersion & "patch: " & Mid(fileBuff, k, kk - k) & Chr(13) & Chr(10)
                    k = kk + Len("PATCHNEWSUMMARYCOMMENTS")
                    n1 = InStr(k, fileBuff, Chr(0))
                    n2 = InStr(k, fileBuff, Chr(1))
                    n3 = InStr(k, fileBuff, "_")
                    n4 = InStr(k, fileBuff, "#")
                    kk = CaseFirstNonzero(n1, n2, n3, n4)
                    If kk > 0 Then mspVersion = mspVersion & "comments: " & Mid(fileBuff, k, kk - k) & Chr(13) & Chr(10)
                End If
            Else
                k = InStrRev(fileBuff, "Classification")
                kk = InStrRev(fileBuff, "DisplayName")
                If k > 0 And kk > 0 Then
                    If kk > k Then
                        k = k + Len("Classification")
                        s = Mid(fileBuff, k, kk - k)
                        n1 = InStr(1, s, Chr(0))
                        n2 = InStr(1, s, Chr(1))
                        n3 = InStr(1, s, "@")
                        n4 = InStr(1, s, "#")
                        k = CaseFirstNonzero(n1, n2, n3, n4)
                        If k > 0 Then s = Left(s, k - 1)
                        mspVersion = mspVersion & "patch: " & s & Chr(13) & Chr(10)
                        k = kk + Len("DisplayName")
                        kk = InStr(k, fileBuff, "Description")
                        If kk - k > 0 Then mspVersion = mspVersion & "description: " & Mid(fileBuff, k, kk - k) & Chr(13) & Chr(10)
                    Else
                        kk = kk + Len("DisplayName")
                        s = Mid(fileBuff, kk, k - kk)
                        n1 = InStrRev(s, Chr(0))
                        n2 = InStrRev(s, Chr(1))
                        n3 = InStrRev(s, "@")
                        n4 = InStrRev(s, "#")
                        k = CaseMax(n1, n2, n3, n4)
                        If k > 0 Then s = Right(s, Len(s) - k)
                        mspVersion = mspVersion & "patch: " & s & Chr(13) & Chr(10)
                        kk = kk - Len("DisplayName")
                        k = InStrRev(fileBuff, "Description", kk)
                        If k > 0 Then
                            k = k + Len("Description")
                            If kk - k > 0 Then mspVersion = mspVersion & "description: " & Mid(fileBuff, k, kk - k) & Chr(13) & Chr(10)
                        End If
                    End If
                Else
                     
                End If
            End If
            fileName = Dir()
            If fileName <> "" Then mspVersion = mspVersion & strDelim
        Loop
         
    End Function

    парсинг уже отрабатывает нормально большую часть патчей, по мере тестов допилится. слабое место - чтение файлов. файл читается целиком в переменную, что очень медленно на больших файлах. надо искать решение быстрого поиска вхождения строки в файле и читать небольшой фрагмент.  
    для тестирования создайте документ эксель, запустите VBA, создайте модуль и вставьте в него приведенный код. в любой ячейке вставьте функцию:
    =mspVersion("c:\Windows\Installer\*.msp")
    только для начала укажите один любой файл вместо маски *, иначе это надолго)
    по умолчанию разделитель списка chr(13) & chr(10), для разбития строки в массив используйте другой разделитель который бы не встречался в возвращаемом тексте, например: chr(8) & chr(8) или любая абракадабра.  
     
    ps заменил стандартное чтение файлов на метод FileSystemObject, это дает приемлемую скорость чтения. теперь идея с парсингом вполне жизнеспособна, тем более что система не всегда показывает в свойствах полную информацию.

    Всего записей: 218 | Зарегистр. 19-01-2008 | Отправлено: 10:18 03-04-2018 | Исправлено: DenSyo, 14:22 03-04-2018
    Открыть новую тему     Написать ответ в эту тему

    Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Visual Basic (VB).


    Реклама на форуме Ru.Board.

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.B0ard
    © Ru.B0ard 2000-2024

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru