CreateProccess не хочет запускать некоторый проги

[kirrun]

Трабла следующая:

CreateProccess, как будто специально, не запускает виндовые проги (e.g. notepad.exe, regedit.exe). се остальные запускаются нормально.

т.е. никакой ошибки он не возвращает, все как-будто нормально, но процесс даже не пытается создаться...

Вот код:

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

    Dim pclass As Long
    Dim sinfo As STARTUPINFO
    'Not used, but needed
    Dim sec1 As SECURITY_ATTRIBUTES
    Dim sec2 As SECURITY_ATTRIBUTES
    'Set the structure size
    sec1.nLength = Len(sec1)
    sec2.nLength = Len(sec2)
    sinfo.cb = Len(sinfo)
    'Set the flags
    sinfo.dwFlags = STARTF_USESHOWWINDOW
    'Set the Window(0)'s startup position
    sinfo.wShowWindow = SW_NORMAL
    'Set the priority class
    pclass = HIGH_PRIORITY_CLASS
   
    'Start the program
    If CreateProcess("C:\Windows\notepad.exe", vbNullString, sec1, sec2, False, pclass, 0&, App.Path, sinfo, pinfo) Then

'Для придирчивых: pinfo объявлена отдельно


[tyomitch]

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

    'Not used, but needed
    Dim sec1 As SECURITY_ATTRIBUTES
    Dim sec2 As SECURITY_ATTRIBUTES


Вовсе даже не needed. Можешь переобъявить эти параметры как ByVal As Long и передавать нули.

Может оказаться, что в этом и была проблема.

[kirrun]

tyomitch, ну тот код писал не я =) Это был Ctrl+C, Ctrl+V из примера.
Но нифига не помогло.. Еще идеи?

[hCORe]

Ээээ... Становится все чудесатее и чудесатее...

В общем, так. Наблюдаются глюки, если мы сразу (не присвоив его переменной) проверяем результат CreateProcess и НЕ обращаемся после этой проверки к мемберам структуры PROCESS_INFORMATION в условной конструкции If.

Работает, но через раз (!):

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

If CreateProcess("C:\Windows\system32\notepad.exe", vbNullString, sec1, sec2, ByVal 0&, pclass, ByVal 0&, vbNullString, sinfo, pinfo) Then
    Debug.Print "Hi!"
End If

Некрасиво, но работает:

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

If CreateProcess("C:\Windows\system32\notepad.exe", vbNullString, sec1, sec2, ByVal 0&, pclass, ByVal 0&, vbNullString, sinfo, pinfo) Then
    Debug.Print "Hi!", pInfo.dwProcessId
End If

Можно и рекомендуется:

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

Dim lRes As Long
lRes = CreateProcess("C:\Windows\system32\notepad.exe", vbNullString, sec1, sec2, ByVal 0&, pclass, ByVal 0&, vbNullString, sinfo, pinfo)
If lRes Then
    Debug.Print "Hi!"
End If

[kirrun]

Ээээ... Становится все чудесатее и чудесатее...

В общем, так. Наблюдаются глюки, если мы сразу (не присвоив его переменной) проверяем результат CreateProcess и НЕ обращаемся после этой проверки к мемберам структуры PROCESS_INFORMATION в условной конструкции If.

Работает, но через раз (!):

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

If CreateProcess("C:\Windows\system32\notepad.exe", vbNullString, sec1, sec2, ByVal 0&, pclass, ByVal 0&, vbNullString, sinfo, pinfo) Then
    Debug.Print "Hi!"
End If

Некрасиво, но работает:

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

If CreateProcess("C:\Windows\system32\notepad.exe", vbNullString, sec1, sec2, ByVal 0&, pclass, ByVal 0&, vbNullString, sinfo, pinfo) Then
    Debug.Print "Hi!", pInfo.dwProcessId
End If

Можно и рекомендуется:

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

Dim lRes As Long
lRes = CreateProcess("C:\Windows\system32\notepad.exe", vbNullString, sec1, sec2, ByVal 0&, pclass, ByVal 0&, vbNullString, sinfo, pinfo)
If lRes Then
    Debug.Print "Hi!"
End If

Дак проблема в том, что блокнот ВАЩЕ не запускается. Я твой код скопипастил - нифига. Или это тока у меня?

[hCORe]

Странно... Вообще, глюки дикие. Такого не должно быть

[kirrun]

блин. А у мя терь ваще ниче не запускается =)))

Гопода, как еще можно запустить ехешник чтобы получить hProcess (я так понимаю хендлер процесса) и dwThreadId

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

[Wild VB Code for Food]

kirrun
Мммм...зачем мучатся? Shell тебе в помощь.....он возвращяет pid

[Andrey Fedorov]

Странно... Вообще, глюки дикие. Такого не должно быть

Только не говори что не работает...

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

Public 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

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" _
        (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
        (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 String, _
        lpStartupInfo As STARTUPINFO, _
        lpProcessInformation As PROCESS_INFORMATION) As Long

' Запускает файл, возвращает True, если процесс создан успешено
' Параметры:    strCommandLine - командная строка
'               lngError       - номер ошибки
'               [varDebug]     - Если True, то создавать окно консоли
' Неконсольные программы запускаются только с varDebug = True
Public Function StartFile(ByRef strCommandLine As String, _
        Optional ByRef bDebug As Boolean = False, _
        Optional ByRef strCurrentDirectory As Variant, _
        Optional ByRef hStdInput As Variant, _
        Optional ByRef hStdOutput As Variant, _
        Optional ByRef hStdError As Variant) As Long
    Const WAIT_FAILED = -1, INFINITE = -1, WAIT_TIMEOUT& = &H102&
    Const CREATE_NEW_CONSOLE = &H10, DETACHED_PROCESS = &H8
   
    Dim s As String, lngDebug As Long, lngError As Long, iWait As Long
    Dim lngStdInput As Long, lngStdOutput As Long, lngStdError As Long
    Dim usrPI As PROCESS_INFORMATION, usrSI As STARTUPINFO
   
    lngDebug = IIf(bDebug, CREATE_NEW_CONSOLE, DETACHED_PROCESS)
    usrSI.cb = Len(usrSI)
    If Not IsMissing(hStdInput) Then If hStdInput > 0 Then usrSI.hStdInput = hStdInput: usrSI.dwFlags = &H100
    If Not IsMissing(hStdOutput) Then If hStdOutput > 0 Then usrSI.hStdOutput = hStdOutput: usrSI.dwFlags = &H100
    If Not IsMissing(hStdError) Then If hStdError > 0 Then usrSI.hStdError = hStdError: usrSI.dwFlags = &H100
   
    If IsMissing(strCurrentDirectory) Then
        s = GetTempPath
    Else
        If Len(strCurrentDirectory) = 0 Then
            s = GetTempPath
        Else
            s = strCurrentDirectory
        End If
    End If
    If 1 = CreateProcess(0, strCommandLine, 0, 0, 1, _
            lngDebug, 0, s, usrSI, usrPI) Then
       
        iWait = WAIT_TIMEOUT
        Do
            iWait = WaitForSingleObject(usrPI.hProcess, 20)
            DoEvents
        Loop Until iWait <> WAIT_TIMEOUT
        If iWait = WAIT_FAILED Then
            CloseHandle usrPI.hProcess
            StartFile = -1
        Else
            GetExitCodeProcess usrPI.hProcess, lngError
            CloseHandle usrPI.hProcess
            If lngError <> 0 Then StartFile = lngError
        End If
    Else
        StartFile = -1
    End If
End Function


[kirrun]

Только не говори что не работает...

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

Private Sub Form_Load()
    StartFile "C:\Windows\notepad.exe", True
End Sub


не работает.

Аддед: да вообще ничего не запускает...
Мне уже кажется, что это только у меня...

[Andrey Fedorov]

не работает.

Аддед: да вообще ничего не запускает...
Мне уже кажется, что это только у меня...

Я даже, кажется, знаю почему...

Нижеприведенный код запустит у тебя блокнотик:

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

Public 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

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Declare Function GetSystemDirectoryA Lib "kernel32" (ByVal lpBuffer As String, ByVal nSize As Long) As Integer
Private Declare Function GetTempPathA Lib "kernel32" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" _
        (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
        (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 String, _
        lpStartupInfo As STARTUPINFO, _
        lpProcessInformation As PROCESS_INFORMATION) As Long

Public Sub Main()
    Dim s As String
   
    s = GetSystemDirectory & "notepad.exe"
   
    Debug.Print StartFile(s)
End Sub

' Запускает файл, возвращает True, если процесс создан успешено
' Параметры:    strCommandLine - командная строка
'               lngError       - номер ошибки
'               [varDebug]     - Если True, то создавать окно консоли
' Неконсольные программы запускаются только с varDebug = True Sad
Public Function StartFile(ByRef strCommandLine As String, _
        Optional ByRef bDebug As Boolean = False, _
        Optional ByRef strCurrentDirectory As Variant, _
        Optional ByRef hStdInput As Variant, _
        Optional ByRef hStdOutput As Variant, _
        Optional ByRef hStdError As Variant) As Long
    Const WAIT_FAILED = -1, INFINITE = -1, WAIT_TIMEOUT& = &H102&
    Const CREATE_NEW_CONSOLE = &H10, DETACHED_PROCESS = &H8
   
    Dim s As String, lngDebug As Long, lngError As Long, iWait As Long
    Dim lngStdInput As Long, lngStdOutput As Long, lngStdError As Long
    Dim usrPI As PROCESS_INFORMATION, usrSI As STARTUPINFO
   
    lngDebug = IIf(bDebug, CREATE_NEW_CONSOLE, DETACHED_PROCESS)
    usrSI.cb = Len(usrSI)
    If Not IsMissing(hStdInput) Then If hStdInput > 0 Then usrSI.hStdInput = hStdInput: usrSI.dwFlags = &H100
    If Not IsMissing(hStdOutput) Then If hStdOutput > 0 Then usrSI.hStdOutput = hStdOutput: usrSI.dwFlags = &H100
    If Not IsMissing(hStdError) Then If hStdError > 0 Then usrSI.hStdError = hStdError: usrSI.dwFlags = &H100
   
    If IsMissing(strCurrentDirectory) Then
        s = GetTempPath
    Else
        If Len(strCurrentDirectory) = 0 Then
            s = GetTempPath
        Else
            s = strCurrentDirectory
        End If
    End If
    If 1 = CreateProcess(0, strCommandLine, 0, 0, 1, _
            lngDebug, 0, s, usrSI, usrPI) Then
       
        iWait = WAIT_TIMEOUT
        Do
            iWait = WaitForSingleObject(usrPI.hProcess, 20)
            DoEvents
        Loop Until iWait <> WAIT_TIMEOUT
        If iWait = WAIT_FAILED Then
            CloseHandle usrPI.hProcess
            StartFile = -1
        Else
            GetExitCodeProcess usrPI.hProcess, lngError
            CloseHandle usrPI.hProcess
            If lngError <> 0 Then StartFile = lngError
        End If
    Else
        StartFile = -1
    End If
End Function

Public Function GetTempPath() As String
    Dim s As String, i As Integer
    s = Space(100)
    i = GetTempPathA(100, s)
    GetTempPath = Left$(s, i)
End Function

Public Function GetSystemDirectory() As String
    Dim s As String, i As Long
   
    s = Space(100)
    i = GetSystemDirectoryA(s, Len(s))
    s = Left$(s, i)
    If Right$(s, 1) <> "" Then s = s & ""
    GetSystemDirectory = s
End Function


[Smert]

Во вы мучаетесь!!!

Shell "C:\Windows\notepad.exe"

И попробуйте сказать что не работует!!!

Ну или ЕСЛИ НЕ ПАШЕТ, то юзать WinExec()

[Роман-вб]

Smert
А ShellExecute не подойдёт в таком случае?

[Smert]

У меня и блокнот, и регедит запускает, вот только плохо запускает Half-Life.exe, NFSU2.exe т.е. запускает, но не загружает толком все нужные файлы как если бы я кликал по этим екзешкам

[Kovu]

Smert
А ты попробуй задавать директорию перед запуском(если Shellom) или в самой функции (если апишками)