powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
7 сообщений из 7, страница 1 из 1
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37883098
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Грубо: появился некий файл в формате A, надо проконвертировать его в формат Б и отобразить на форме.
Конвертацию осуществляем внешней proga.exe.

Алгоритм:
1) Запускаем proga.exe через Shell (завершения не ждем, т.к. конвертация требует чуть времени, неохота стопорить основной процесс)
2) Там же запускаем таймер.
Код: vbnet
1.
2.
                Shell "proga.exe <параметры>", vbHide
                Timer1.Enabled = True 'перезапуск таймера ожидания конца конвертации


3) Таймер тупо проверяет запущена ли еще proga.exe
и если НЕТ, то отображает файл, полученный как результат работы proga.exe

Код: vbnet
1.
2.
3.
4.
5.
6.
Private Sub Timer1_Timer()
        If IsProgaRun("proga") = False Then
            <действия>
            Timer1.Enabled = False
        End If
End Sub



Код: vbnet
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.
Function IsProgaRun(proga As String) As Boolean
        TargetName = proga
        TargetHwnd = 0
        ' Examine the window names.
        EnumWindows AddressOf WindowEnumerator, 0
        ' See if we got an hwnd.
        If TargetHwnd = 0 Then
            IsProgaRun = False
        Else
            IsProgaRun = True
        End If
End Function
' Return False to stop the enumeration.
Public Function WindowEnumerator(ByVal app_hwnd As Long, _
    ByVal lParam As Long) As Long
Dim buf As String * 256
Dim Title As String
Dim length As Long

    ' Get the window's title.
    length = GetWindowText(app_hwnd, buf, Len(buf))
    Title = Left$(buf, length)

    ' See if the title contains the target.
    If InStr(Title, TargetName) > 0 Then
        ' Save the hwnd and end the enumeration.
        TargetHwnd = app_hwnd
        WindowEnumerator = False
    Else
        ' Continue the enumeration.
        WindowEnumerator = True
    End If
End Function


В таймере стоял Интервал=100.
И все хорошо и давно это использую, но дернул меня нечистый испытать это на старом слабеньком P-III.
И не сработало, т.е. картинка не отобразилась.

Стал искать причины, вставлять всякие дебаги и т.п..
И кажется мне причина в следующем:
Условие таймера
If IsProgaRun("proga") = False
похоже срабатывает до того
как появился процесс с именем "proga".
Т.е. таймер вышибает еще до того как появился процесс, завершение которого он должен контролировать.
А не после того как он уже завершился .

Может ли такое быть?

И если ДА то как лечить?
В-1)) не делать ничего. P-III это редкость, прога от этого не вылетает и в крайнем случае юзер может перещелкнуть записи в ListView и картинка в итоге отобразится.
В-2)) Если поставить Интервал=200 вместо 100, то проблема на P-III решается, но не слишком ли это много, с учетом того что на быстрых компьютерах конвертер частенько работает быстрее со многими файлами (не уверен, но...)
В-3)) Могу конечно сделать что-то типа
Код: vbnet
1.
2.
3.
4.
5.
6.
                Shell "proga.exe <параметры>", vbHide
                Do
                  DoEvents
                  If IsProgaRun("proga") = true then exit do 'проконтролировать запуск процесса
                Loop
                Timer1.Enabled = True 'перезапуск таймера ожидания конца конвертации

Но это потенциальный глюк (гораздо больший), если вдруг proga.exe вообще не запустилась и т.п.
...
Рейтинг: 0 / 0
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37883120
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Дмитрий77В-3)) Могу конечно сделать что-то типа
Код: vbnet
1.
2.
3.
4.
5.
6.
                Shell "proga.exe <параметры>", vbHide
                Do
                  DoEvents
                  If IsProgaRun("proga") = true then exit do 'проконтролировать запуск процесса
                Loop
                Timer1.Enabled = True 'перезапуск таймера ожидания конца конвертации

Но это потенциальный глюк (гораздо больший), если вдруг proga.exe вообще не запустилась и т.п.

Бог с ним, поставил заглушку так:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
    Dim ltime As Single
...
                Shell "proga.exe ............., vbHide
                ltime = Timer()
                Do
                    DoEvents
                    If (IsProgaRun("proga") = True) Or (Timer - ltime > 1) Or (Timer < ltime) Then
                        Exit Do
                    End If
                Loop
                Timer1.Enabled = True 'перезапуск таймера ожидания конца конвертации


И иди оно лесом.
...
Рейтинг: 0 / 0
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37883459
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Дмитрий77
> Бог с ним, поставил заглушку так:

У моих пользователей была проблема: в ексельных файлах были ссылки на другие файлы и в какой-то момент эти ссылки из-за
чего-то изменились и перестали работать. Т.к. версия офиса уже была 2007-я то я сделал небольшой макрос, который
указаный файл или файлы из указаной папки распаковывал во временную папку, находил XML в котором хранились пути внешних
ссылок, исправлял там все как правильно и запаковывал обратно в файл ексела. Т.к. распаковка\запаковка выполняла
сторонняя программа, то возникла необходимость ожидать окончание процесса. Что я и сделал. Макрос работал на
терминальном сервере win2008 x64 и при одновременном использовании разными пользователями ошибок не было

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
' Функция "собирает" xlsx-файл по пути переданным параметром из временной папки
Private Sub BuildData(ByVal sPathFolderData As String)
' Сборка файла - 7z.exe -tzip a c:\test.xlsx c:\22\*.* -r
Dim ProcessID As Long
Dim ProcessHandle As Long

On Error GoTo labErr
' Если в пути пробелы - окавычиваем путь
If InStr(1, sPathFolderData, " ", vbTextCompare) <> 0 Then
    sPathFolderData = """" & sPathFolderData & """"
End If
ProcessID = Shell("7z -tzip a " & sPathFolderData & " " & sPathTempFolder & "\*.* -r", vbHide)
ProcessHandle = OpenProcess(SYNCHRONIZE, True, ProcessID)
WaitForSingleObject ProcessHandle, -1&
CloseHandle ProcessHandle
DoEvents
Exit Sub
labErr:
ErrorOutput "Ошибка при сборке " & sPathFolderData & " " & Err.Description

End Sub



Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37883467
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Игорь Горбонос

Забыл декларации :(
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
' Декларации, для слежением за процессом распаковки
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal _
         dwAccess As Long, ByVal fInherit As Integer, ByVal hObject _
         As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
       hHandle As Long, ByVal dwMilliseconds As Long) As Long

Const SYNCHRONIZE = &H100000
Const NORMAL_PRIORITY_CLASS = &H20&
Const INFINITE = -1&
' Конец деклараций, для слежения за процессом распаковки



Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37883624
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь Горбонос,

Это все понятно.
У меня для ожидания завершения процесса есть ф-ция
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Sub ShellAndContinue(ByVal AppToRun As String, mode As VbAppWinStyle)
   ' On Error GoTo ErrorRoutineErr
    
    Dim hProcess As Long
    Dim retVal As Long
    Dim Msg, Style, Title, Response 'msgbox variables
    
    'The next line launches AppToRun,
    'captures process ID
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, _
    Shell(AppToRun, mode))
    Do
        'Get the status of the process
        GetExitCodeProcess hProcess, retVal
        DoEvents
    'Loop while the process is active
    Loop While retVal = STILL_ACTIVE
    
ErrorRoutineResume:
    Exit Sub
'ErrorRoutineErr:
'    MsgBox Error.Description
End Sub


Но она (как чувствую и в вашем случае) "берет всю прогу на себя", т.е. если время работы внешней проги ощутимо для зрения/слуха и т.п., то это будет "заметно".
Поэтому я здесь это не использую а передаю "ждать" на таймер, что не грузит основную прогу.
А "затычка" хотя и "грузит", но это 1/5сек для слабенького P-III (что незаметно), время то самой конвертации особенно для P-III поболе будет.
...
Рейтинг: 0 / 0
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37883985
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Дмитрий77
> Но она (как чувствую и в вашем случае) "берет всю прогу на себя",

Понял, а ты поставь в цикл вызов WaitForSingleObject, вместо вызова GetExitCodeProcess, но последний параметр укажи не
INFINITE, а поставь конкреное значение милисекунд. Тогда это значение милисекунд будет висеть не загружая процессор, а
потом DoEvents обработает скопившиеся оконные сообщения, и снова уснет на заданное значение милисекунд. У меня это был
макрос в Екселе, поэтому мне не критично что интерфейс не откликается - пока не исправятся сслыки работать все равно
нельзя

Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
    #37884157
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь Горбонос,

спасибо. Много я мудрил со всем этим неоднократно. Можно сделать поиск по моим темам но неохота. И многое мне с этими синхронностями/асинхронностями не нравится. То все одно виснет, то какие-то часики (иконка мышки) вирусоподобные появляются - как раз помнится при тех словах что Вы употребляете.

Таймер в данном случае думаю самое то. Просто не предполагал что первый тик таймера может случиться раньше чем Shell запустит proga.exe.
Ну, короткий цикл для страховки перед запуском таймера.
Ну, страховка страховки:
Код: vbnet
1.
Or (Timer - ltime > 1)


чтоб если глюк то вышла через секунду
Ну пере-перестраховка
Код: vbnet
1.
Or (Timer < ltime)


-это если жареный петух клюнет ровно в полночь. Смешно, но у меня в практике была ситуация, когда цикл (причем шаг был около 3-х минут) встал ровно в полночь из-за отсутствия этого условия.

Короче заклеили скотчем и авось не прорвет.
...
Рейтинг: 0 / 0
7 сообщений из 7, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Запуск внешней программы, контроль работает ли еще она через таймер. Не могу понять глюк.
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]