Вызов с ожиданием завершения

Проблема не раз обсуждалась и имеет решения на разных форумах
Однако столкнулся с проблемой
Суть вопроса: нужно вызвать программу с параметрами и дождаться ее завершения (rmdir, mkdir, xcopy, 7z, т.е. консольные приложения)
Вызывал разными методами. На моем компьютере вроде все методы работают
Пробовал на виртуалке - урезанная ХП - не работает, и на ПК брата - то же не работает, винда там такая же как и у меня (вин7,х64)
ссылка на программу (исходники) - http://rghost.ru/45349307
В пути присутствуют пробелы
Для разных вызовов использовал разные решения:
функция MakeSpaceInQuotes ставит пробелы в кавычки
так же брал полные пути в кавычки, например "C:\Program Files (x86)\my program", так же работает
Однако программа либо не работает, либо крошится на других ПК
Алгоритмы вызова с ожиданием лежат в модулях bModule, MainModule
ShellFile ( моя любимая функция )
ExecuteAndWait2
ExecuteAndWait3
CommandExt





Т.е. устанавливает анимации из архива в app.path & "\anim\"
использует временную папку app.path & "\temp\"

А какой вопрос-то?

Вопрос в том, как реализовать вызов с ожиданием программы (консоли) с передачей ей параметров, что бы корректо функционировало на XP/7

Цитата fireday @ 17.04.13, 11:11

Вызывал разными методами. На моем компьютере вроде все методы работают

Можешь привести все эти методы? (что б не разбирать код по ссылке)

функция CommandExt

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
 
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
 
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
 
Private Const INFINITE = -1&
Private Const NORMAL_PRIORITY_CLASS = &H20&
 
Dim FileName As String
 
Private Sub RunFile(FileName)
On Error GoTo Error_mark
 
Dim Process As PROCESS_INFORMATION
Dim Prog As STARTUPINFO
Prog.cb = Len(Prog)
CreateProcessA 0&, FileName, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, Prog, Process
WaitForSingleObject Process.hProcess, INFINITE
 
CloseHandle Process.hProcess
 
Exit_mark:
Exit Sub
Error_mark:
'ReportError "RunFile()"
Resume Next
End Sub
 
Public Sub CommandExt(strCommand)
On Error GoTo Error_mark
 
RunFile strCommand
 
Exit_mark:
Exit Sub
 
Error_mark:
'ReportError "CommandExt"
Resume Next
End Sub

функции ExecuteAndWait2 и ExecuteAndWait3

Public Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public PathToFolder
'=====
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As Any, ByRef lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
'=====
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
 
Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessID As Long
  dwThreadID As Long
End Type
Private Type STARTUPINFO
  cb As Long
  lpReserved As Long
  lpDesktop As Long
  lpTitle As Long
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Byte
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type
 
 
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const SW_NORMAL As Long = 1
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
Private Const INFINITE As Long = &HFFFFFFFF
 
Public Sub ExecuteAndWait2(CmdLine As String)
  Dim si As STARTUPINFO, pi As PROCESS_INFORMATION
  
  si.cb = Len(si)
  si.dwFlags = STARTF_USESHOWWINDOW
  si.wShowWindow = SW_NORMAL
  
  'CreateProcess vbNullString, "notepad.exe", ByVal 0&, ByVal 0&, 0, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, si, pi
  CreateProcess vbNullString, CmdLine, ByVal 0&, ByVal 0&, 0, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, si, pi
  
  CloseHandle pi.hThread
  
  WaitForSingleObject pi.hProcess, INFINITE
  
  'MsgBox "123!", vbInformation
  
  CloseHandle pi.hProcess
End Sub
 
 
Public Sub ExecuteAndWait3(CmdLine$)
Dim proc As PROCESS_INFORMATION
Dim START As STARTUPINFO
Dim ret As Long
 
' Initialize the STARTUPINFO structure:
START.cb = Len(START)
 
' Start the shelled application:
ret = CreateProcessA(0&, CmdLine$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, START, proc)
If ret Then
' Wait for the shelled application to finish:
ret = WaitForSingleObject(proc.hProcess, INFINITE)
 
End If
CloseHandle (proc.hProcess)
End Sub

И моя любимая функция

Public Function ShellFile(fPathe As String, Optional Arguments As String = "", Optional TypeOfWindow As Long = 1, Optional WaitEnd As Boolean = True)
Dim WshShell As Object
'On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
If Arguments <> "" Then fPathe = fPathe & " " & Arguments
WshShell.Run fPathe, TypeOfWindow, WaitEnd
Set WshShell = Nothing
End Function

Повторюсь - на моем ПК работает, на других - нет. В чем может быть причина?
Вызовы функций:
1) Удаление временной папки (temp). Создание временной папки. Извлечение архива в временную папку с помощью 7z.exe

CommandExt "cmd /x /c rmdir /s /q " & Chr(34) & App.Path & "\temp" & Chr(34)
CommandExt "cmd /x /c mkdir " & Chr(34) & App.Path & "\temp" & Chr(34)
CommandExt Chr(34) & App.Path & "\7z.exe" & Chr(34) & " x -y " & Chr(34) & Trim(PathToArchive) & Chr(34) & " " & Chr(34) & "-o" & App.Path & "\temp" & Chr(34)

Важно заметить, что до 2 пунка программа не выполняется на других ПК. Так как это отдельный вызов (кнопкой копировать), работает только в случае, если папка Temp не пустая. А она почему то становится пустой (думаю, что 7z не может извлечь, т.к. программа не дождалась создания этой папки) В принципе главное что бы выполнялся 1 пункт, тогда со вторым я разберусь
2) Лист1 - список путей на папку содержащую анимацию (см. скриншот. например такой путь "D:\animeradio\installation animations\temp\robot")
Тут вызов создания директории и копирование в нее содержимого

CopyWay = App.Path & "\anim\" & Right(List1.List(i - 1), Len(List1.List(i - 1)) - InStrRev(List1.List(i - 1), "\"))
CommandExt "cmd /x /c mkdir " & Chr(34) & CopyWay & Chr(34)
CommandExt "cmd /x /c xcopy /e /c /y " & Chr(34) & List1.List(i - 1) & "\*.*" & Chr(34) & " " & Chr(34) & CopyWay & "\*.*" & Chr(34)

Добавлено 17.04.13, 13:55
Если вызываю так:

ShellFile "cmd /c rmdir /s /q " & Chr(34) & App.Path & "\temp" & Chr(34)
ShellFile "cmd /c mkdir " & Chr(34) & App.Path & "\temp" & Chr(34)
ShellFile Chr(34) & App.Path & "\7z.exe" & Chr(34) & " x -y " & Chr(34) & Trim(PathToArchive) & Chr(34) & " " & Chr(34) & "-o" & App.Path & "\temp" & Chr(34)

Public Function ShellFile(fPathe As String, Optional Arguments As String = "", Optional TypeOfWindow As Long = 1, Optional WaitEnd As Boolean = True)
CreateObject("wscript.shell").Run fPathe, , WaitEnd 'TypeOfWindow, WaitEnd
Set WshShell = Nothing
End Function

То крошится на виртуалке с такой ошибкой:

Добавлено 17.04.13, 14:01
Если вызываю ExecuteAndWait2 / ExecuteAndWait3 / CommandExt
То ошибок не вылетает, но извлечение архива не происходит (такое ощущение, что программа не ждет завершения вызванных программ)
Может быть это из-за урезанной винды? Сейчас проверю наличие необходимых библиотек (dll)

Все библиотеки есть

Добавлено 17.04.13, 14:09

Цитата

функции ExecuteAndWait2 и ExecuteAndWait3

Случайно лишний код выложил
Это лишнее:

Public Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public PathToFolder
 
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Возможно проблема решилась - в установщике не хватало библиотек архиватора 7z
На компе брата заработало, на виртуалке крошится (возможно из-за того что она урезанная)

На некоторых компах вылетает с такой ошибкой:

Добавлено 24.04.13, 18:35
ошибку решил