Op deze website gebruiken we cookies om content en advertenties te personaliseren, om functies voor social media te bieden en om ons websiteverkeer te analyseren. Ook delen we informatie over uw gebruik van onze site met onze partners voor social media, adverteren en analyse. Deze partners kunnen deze gegevens combineren met andere informatie die u aan ze heeft verstrekt of die ze hebben verzameld op basis van uw gebruik van hun services. Meer informatie.

Akkoord

Vraag & Antwoord

Programmeren

Delphi 6, actie tijdens WaitForSingleObject

Niek Breur
2 antwoorden
  • Met onderstaande procedure laat ik het programma wachten op het verwerken van externe opdrachten.
    Als het wachten lang gaat duren wil ik toch een voortgangsbalkje op het scherm weergeven, als er maar iets beweegt zodat de gebruiker niet denkt dat het programma hangt. Hoe kan ik met deze procedure zoiets doen of is hiervoor een andere oplossing?

    [code:1:4aa43f2d8b]
    procedure ExecAndWait (Filename : TFilename; Params : String; Const wait : Boolean);
    var ExecInfo : TshellExecuteinfo;
    Begin
    {variabelen toekennen}
    FillChar(ExecInfo, SizeOf(ExecInfo), #0);
    ExecInfo.cbSize := SizeOf (TshellexecuteInfo);
    ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
    ExecInfo.Wnd := HWnd_Desktop;
    ExecInfo.lpFile := Pchar (filename);
    ExecInfo.lpDirectory := Pchar (filename);
    ExecInfo.lpParameters := Pchar (Params);
    ExecInfo.nShow := SW_SHOWNORMAL;
    {openen van het document of start programma}
    if ShellExecuteEx(@ExecInfo) then begin
    if wait then begin
    WaitForSingleObject (ExecInfo.hProcess, INFINITE);
    CloseHandle (ExecInfo.hProcess);
    end;
    end;
    end;
    [/code:1:4aa43f2d8b]
  • [quote:8f43164a07="Niek Breur"]Met onderstaande procedure laat ik het programma wachten op het verwerken van externe opdrachten.
    Als het wachten lang gaat duren wil ik toch een voortgangsbalkje op het scherm weergeven, als er maar iets beweegt zodat de gebruiker niet denkt dat het programma hangt. Hoe kan ik met deze procedure zoiets doen of is hiervoor een andere oplossing?[/quote:8f43164a07]
    [code:1:8f43164a07]
    {– WinExecAndWait32V2 ————————————————}
    {: Executes a program and waits for it to terminate
    @Param FileName contains executable + any parameters
    @Param Visibility is one of the ShowWindow options, e.g. SW_SHOWNORMAL
    @Returns -1 in case of error, otherwise the programs exit code
    @Desc In case of error SysErrorMessage( GetlastError ) will return an
    error message. The routine will process paint messages and messages
    send from other threads while it waits.
    }{ Created 27.10.2000 by P. Below
    ———————————————————————–}
    Function WinExecAndWait32V2( FileName: String; Visibility: integer ):
    DWORD;
    Procedure WaitFor( processHandle: THandle );
    Var
    msg: TMsg;
    ret: DWORD;
    Begin
    Repeat
    ret := MsgWaitForMultipleObjects(
    1, { 1 handle to wait on }
    processHandle, { the handle }
    False, { wake on any event }
    INFINITE, { wait without timeout }
    QS_PAINT or { wake on paint messages }
    QS_SENDMESSAGE { or messages from other threads }
    );
    If ret = WAIT_FAILED Then Exit; { can do little here }
    If ret = (WAIT_OBJECT_0 + 1) Then Begin
    { Woke on a message, process paint messages only. Calling
    PeekMessage gets messages send from other threads processed.
    }
    While PeekMessage( msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE ) Do
    DispatchMessage( msg );
    End;
    Until ret = WAIT_OBJECT_0;
    End; { Waitfor }
    Var { V1 by Pat Ritchey, V2 by P.Below }
    zAppName:array[0..512] of char;
    StartupInfo:TStartupInfo;
    ProcessInfo:TProcessInformation;
    Begin { WinExecAndWait32V2 }
    StrPCopy(zAppName,FileName);
    FillChar(StartupInfo,Sizeof(StartupInfo),#0);
    StartupInfo.cb := Sizeof(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    StartupInfo.wShowWindow := Visibility;
    If not CreateProcess(nil,
    zAppName, { pointer to command line string }
    nil, { pointer to process security attributes }
    nil, { pointer to thread security attributes }
    false, { handle inheritance flag }
    CREATE_NEW_CONSOLE or { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil, { pointer to new environment block }
    nil, { pointer to current directory name }
    StartupInfo, { pointer to STARTUPINFO }
    ProcessInfo) { pointer to PROCESS_INF }
    Then
    Result := DWORD(-1) { failed, GetLastError has error code }
    Else Begin
    Waitfor(ProcessInfo.hProcess);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle( ProcessInfo.hProcess );
    CloseHandle( ProcessInfo.hThread );
    End; { Else }
    End; { WinExecAndWait32V2 }
    [/code:1:8f43164a07]
    Re: externe processen in Delphi NA elkaar laten plaatsvinden
    Hier kom je al een stap verder mee…

Beantwoord deze vraag

Dit is een gearchiveerde pagina. Antwoorden is niet meer mogelijk.