запуск ярлыка (*.lnk)

[XPAHuTEJIb]

Добрый день!
Мне надо запустить программу, с ожиданием завершения, что я нашёл здесь: http://bbs.vbstreets.ru/viewtopic.php?t=26254 в посте Глюкмена.
Но...дело в том, что у программы рабочая папка отличается от той, в которой она находится, и запуск осуществляется посредством ярлыка, в котором прописаны параметры запуска и рабочая папка. А когда запускаю программу из ее каталога с параметрами, она запускается, но не видит "окружения".
Вопрос: Возможен ли запуск через ярлык, описанным выше(по ссылке) способом?

[Andrey Fedorov]

Ищи по CreateProcess - там сожно задать каталог...

[XPAHuTEJIb]

Спасибо, разобрался..
делаю так:

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

CHDIR <каталог с формами оракла>
SystemExecute "C:\orant\BIN\ifrun60.EXE module=stub.fmx.....", SW_NORMAL

[XPAHuTEJIb]

не получилось....в дизайне работает, а когда в .ехе делаю - не пашет.
а как в createprocess вставить каталог, онже там задается как long?

[Andrey Fedorov]

а как в createprocess вставить каталог, онже там задается как 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


' Запускает файл, возвращает 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

[XPAHuTEJIb]

спасибо, попробую, у меня была функция задана так:

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

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

[alibek]

Видимо ты с сишной декларации портировал.
В данном случае ByVal String гораздо удобнее.