Results 1 to 12 of 12

Thread: Event na openen bestand

  1. #1

    Event na openen bestand

    Hallo,

    Vanuit mijn Delphi applicatie open ik een PDF bestand via ShellExecute. Dit bestand opent netjes in mijn PDF lezer maar welke event kan ik gebruiken als ik de PDF lezer afsluit en weer terugkeer naar mijn Delphi applicatie?

    Groet, Pascal
    Last edited by Pascal G++; 02-May-19 at 12:23.

  2. #2
    Daar is geen 'event' voor want ShellExecute voert de PDF reader uit en keert gelijk terug naar je programma.
    Dat doe ik ook met:
    Delphi Code:
    1. rs := ShellApi.ShellExecute(0, pchar(Action), pchar(FileName), nil, nil, SW_SHOW);

    Waarom wil je zo'n event??

    Misschien zijn er andere methodes om je doel te bereiken.

    Anders moet je aan de gang met ShellExecuteEx(@exInfo) en Waitforsingleobject() maar dat zul je dan in een thread moeten doen want anders blokkeer je je programma.

  3. #3
    De PDF die geopend wordt is nog niet ondertekend middels een PKI certificaat. Dit wordt gedaan in de PDF lezer. Zodra er weer wordt teruggekeerd naar de applicatie wil ik controleren of het document inmiddels wel is getekend zodat ik kan verwijderen uit de lijst met nog te tekenen documenten.

  4. #4
    (Had je nou maar fpc met TProcess en [poWaitOnExit])

  5. #5
    Quote Originally Posted by Bart B View Post
    (Had je nou maar fpc met TProcess en [poWaitOnExit])
    Dat is volgens mij ook gewoon een wrapper om de ShellExecuteEx(@exInfo) en Waitforsingleobject() die ik noemde.

  6. #6
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    9,904
    Quote Originally Posted by rvk View Post
    Dat is volgens mij ook gewoon een wrapper om de ShellExecuteEx(@exInfo) en Waitforsingleobject() die ik noemde.

    Nee. Dat is niet zo, het is createprocessw of the -ex variant.

    En tsja, wat is een wrapper, en wanneer wordt het iets aparts? Vrijwel alles roept intern ergens wel OS primitives aan? De VCL is een GDI/winapi wrapper ? :-)

    TProcess zit nu in de 1000-1500 regels orde grootte. Vertalen naar Delphi is ff werk, maar is wel te doen, ergens op het forum moet nog een vertaling uit 2012 of zo staan.
    Last edited by marcov; 02-May-19 at 21:11.

  7. #7
    Quote Originally Posted by marcov View Post
    Vertalen naar Delphi is ff werk, maar is wel te doen, ergens op het forum moet nog een vertaling uit 2012 of zo staan.
    Zoiets

    https://github.com/z505/TProcess-Delphi

    Ik heb ook een voorbeeld voor ShellExecuteEx(@exInfo) met Waitforsingleobject() (wat natuurlijk veel compacter is maar met minder opties) maar kan daar even niet bij.

    Van die wrapper was ook geen kritiek hoor. Inderdaad is alles een wrapper en ik wist dat het om een van de standaard process apis ging in (en voor wat betreft) Windows.

  8. #8
    mov rax,marcov; push rax marcov's Avatar
    Join Date
    Apr 2004
    Location
    Ehv, Nl
    Posts
    9,904
    Quote Originally Posted by rvk View Post
    Dat is een andere oude ja. Maar die ik bedoelde was nog een tikje ouder, 2005, al is er een followup in 2014. (die overigens wel het lezen waard is, vooral als je ook stderr gebruikt) https://www.nldelphi.com/showthread....=processdelphi


    Ik heb ook een voorbeeld voor ShellExecuteEx(@exInfo) met Waitforsingleobject() (wat natuurlijk veel compacter is maar met minder opties) maar kan daar even niet bij.
    shellexecute heeft natuurlijk ook "shell" gebruik extra, dus dingen als documenten lanceren met alleen hun extensie. Ik zou de code daarom overigens graag zien. Aan de andere kant heeft TProcess met name de piping.

    Van die wrapper was ook geen kritiek hoor. Inderdaad is alles een wrapper en ik wist dat het om een van de standaard process apis ging in (en voor wat betreft) Windows.
    En piping met name. De piping is meer werk dan executie.

    Overigens heb ik redelijk zwaar ingegrepen in TProcess vorig najaar. Als je met TProcess code aan de slag gaat, neem de code van up to date trunk of fixes3_2, niet uit 3.0.4.

    De veranderingen zijn met name unicode gerelateerd (duplicatie in TUtf8Process verwijderen op termijn), en is de mainloop van runcommand() nu deel van tprocess en verder geparameteriseerd (met events die je kan opgeven), wat het makkelijker maakt eigen varianten te maken. Ook weer om duplicatie te verminderen.

  9. #9
    Eens eventjes kijken...

    Dit is code uit mijn programma om bijvoorbeeld een Word-document te openen (.docx) en te wachten tot deze afgesloten wordt.

    Delphi Code:
    1. // ================================================
    2. // ShellExecute
    3. // ================================================
    4. FillChar(exInfo, SizeOf(exInfo), 0);
    5. with exInfo do
    6. begin
    7.   cbSize := SizeOf(exInfo);
    8.   lpVerb := nil; // Defaults to 'open'.
    9.   fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    10.   Wnd := Application.Handle;
    11.   LpFile := pChar(FTempFile);
    12.   lpDirectory := nil; // Defaults to current directory.
    13.   LpParameters := nil;
    14.   // nShow := SW_SHOWNORMAL;
    15.   nShow := SW_SHOW;
    16. end;
    17.  
    18. // ================================================
    19. // cCppException       = $0EEFFACE; { used by BCB }
    20. // ================================================
    21. if ShellExecuteEx(@exInfo) then
    22. begin
    23.   Waitforsingleobject(exInfo.HProcess, infinite);
    24.   CloseHandle(exInfo.HProcess);
    25. end
    26. else
    27. begin
    28.   ShowMessage(SysErrorMessage(GetLastError));
    29. end;
    30.  
    31. // ================================================

    Nog een paar varianten van welbekende code (uit mijn snippet library). Dit is een mix. De ene gebruikt CreateProcess en de andere weer ShellExecuteEx().
    Het voordeel van de ShellExecute is inderdaad dat je dus niet eerst zelf de Associated App hoeft te zoeken. Maar ook daar heb ik een FindAssociatedApp() voor die gewoon een ShellApi.FindExecutable() doet (wat voorbeelden daarvan helemaal onderaan). (Lekker zooitje als ik ze zo allemaal bij elkaar zie )

    Delphi Code:
    1. function WinExecAndWait32(FileName, Params: string; Visibility: integer): DWORD;
    2. var { by Pat Ritchey }
    3.   zAppName: array [0 .. 512] of Char;
    4.   zAppDir: array [0 .. 512] of Char;
    5.   StartupInfo: TStartupInfo;
    6.   ProcessInfo: TProcessInformation;
    7. begin
    8.   StrPCopy(zAppName, FileName + ' ' + Params);
    9.   StrPCopy(zAppDir, ExtractFilePath(FileName));
    10.   FillChar(StartupInfo, SizeOf(StartupInfo), #0);
    11.   StartupInfo.cb := SizeOf(StartupInfo);
    12.   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    13.   StartupInfo.wShowWindow := Visibility;
    14.   if not CreateProcess(nil,
    15.     zAppName, { pointer to command line string }
    16.     nil, { pointer to process security attributes }
    17.     nil, { pointer to thread security attributes }
    18.     false, { handle inheritance flag }
    19.     CREATE_NEW_CONSOLE or { creation flags }
    20.     NORMAL_PRIORITY_CLASS,
    21.     nil, { pointer to new environment block }
    22.     zAppDir, // pointer to current directory name
    23.     StartupInfo, { pointer to STARTUPINFO }
    24.     ProcessInfo) then
    25.       Result := DWORD(-1) { pointer to PROCESS_INF }
    26.   else
    27.   begin
    28.     repeat
    29.         Application.ProcessMessages;
    30.     until WaitForSingleObject(ProcessInfo.HProcess, 0) <> WAIT_TIMEOUT;
    31.     // WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    32.     GetExitCodeProcess(ProcessInfo.HProcess, Result);
    33.     CloseHandle(ProcessInfo.HProcess);
    34.     CloseHandle(ProcessInfo.hThread);
    35.   end;
    36. end;

    Delphi Code:
    1. function WinExecAndWait32V2(FileName, Params: string; Visibility: integer): DWORD;
    2.  
    3.   procedure WaitFor(processHandle: THandle);
    4.   var
    5.     Msg: TMsg;
    6.     ret: DWORD;
    7.   begin
    8.     repeat
    9.       ret := MsgWaitForMultipleObjects(
    10.         1,
    11.         processHandle,
    12.         false,
    13.         INFINITE,
    14.         QS_PAINT or QS_SENDMESSAGE
    15.         );
    16.       if ret = WAIT_FAILED then Exit;
    17.       if ret = (WAIT_OBJECT_0 + 1) then
    18.       begin
    19.         while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
    20.             DispatchMessage(Msg);
    21.       end;
    22.     until ret = WAIT_OBJECT_0;
    23.   end;
    24.  
    25. var
    26.   zAppName: array [0 .. 512] of Char;
    27.   zAppDir: array [0 .. 512] of Char;
    28.   StartupInfo: TStartupInfo;
    29.   ProcessInfo: TProcessInformation;
    30.  
    31. begin
    32.   Result := 0;
    33.   // path of the exe
    34.   StrPCopy(zAppName, FileName + ' ' + Params);
    35.   StrPCopy(zAppDir, ExtractFilePath(FileName));
    36.   FillChar(StartupInfo, SizeOf(StartupInfo), #0);
    37.   StartupInfo.cb := SizeOf(StartupInfo);
    38.   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
    39.   StartupInfo.wShowWindow := Visibility;
    40.   if not CreateProcess(nil,
    41.     zAppName, // pointer to command line string
    42.     nil, // pointer to process security attributes
    43.     nil, // pointer to thread security attributes
    44.     false, // handle inheritance flag
    45.     CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, // creation flags
    46.     nil, // pointer to new environment block
    47.     zAppDir, // pointer to current directory name
    48.     StartupInfo, // pointer to STARTUPINFO
    49.     ProcessInfo) { // pointer to PROCESS_INF } then
    50.   begin
    51.     Result := DWORD(-1);
    52.     // 740 = ERROR_ELEVATION_REQUIRED
    53.   end
    54.   else
    55.   begin
    56.     WaitFor(ProcessInfo.HProcess);
    57.     GetExitCodeProcess(ProcessInfo.HProcess, Result);
    58.     CloseHandle(ProcessInfo.hThread);
    59.     CloseHandle(ProcessInfo.HProcess);
    60.   end;
    61. end;

    Delphi Code:
    1. function WinExecAndWait32V3(FileName, Params: string; Visibility: integer): DWORD;
    2. var
    3.   // waitState: dword;
    4.   exi: TShellExecuteInfo;
    5. begin
    6.   FillChar(exi, SizeOf(exi), #0);
    7.   exi.cbSize := SizeOf(exi);
    8.   exi.lpVerb := pchar('open');
    9.   exi.lpFile := pchar(ExtractFileName(FileName));
    10.   exi.lpDirectory := pchar(ExtractFilePath(FileName));
    11.   exi.lpParameters := pchar(Params);
    12.   exi.fMask := SEE_MASK_FLAG_DDEWAIT + SEE_MASK_NOCLOSEPROCESS + SEE_MASK_CONNECTNETDRV;
    13.   ShellExecuteEx(@exi);
    14.   { waitState := } WaitForSingleObject(exi.HProcess, INFINITE);
    15.   GetExitCodeProcess(exi.HProcess, Result);
    16. end;

    Delphi Code:
    1. function ExecAndWait(const CommandLine: string): boolean;
    2. var
    3.   StartupInfo: Windows.TStartupInfo; // start-up info passed to process
    4.   ProcessInfo: Windows.TProcessInformation; // info about the process
    5.   ProcessExitCode: Windows.DWORD; // process's exit code
    6. begin
    7.   // Set default error result
    8.   Result := false;
    9.   // Initialise startup info structure to 0, and record length
    10.   FillChar(StartupInfo, SizeOf(StartupInfo), 0);
    11.   StartupInfo.cb := SizeOf(StartupInfo);
    12.   // Execute application commandline
    13.  
    14.   if Windows.CreateProcess(nil,
    15.     pchar(CommandLine), // pointer to command line string
    16.     nil, // pointer to process security attributes
    17.     nil, // pointer to thread security attributes
    18.     false, // handle inheritance flag
    19.     0, // creation flags
    20.     nil, // pointer to new environment block
    21.     nil, // pointer to current directory name
    22.     StartupInfo, // pointer to STARTUPINFO
    23.     ProcessInfo) { // pointer to PROCESS_INF } then
    24.   begin
    25.     try
    26.       // Now wait for application to complete
    27.       if Windows.WaitForSingleObject(ProcessInfo.HProcess, INFINITE) = WAIT_OBJECT_0 then
    28.         // It's completed - get its exit code
    29.         if Windows.GetExitCodeProcess(ProcessInfo.HProcess, ProcessExitCode) then
    30.           // Check exit code is zero => successful completion
    31.           if ProcessExitCode = 0 then
    32.               Result := true;
    33.     finally
    34.       // Tidy up
    35.       Windows.CloseHandle(ProcessInfo.HProcess);
    36.       Windows.CloseHandle(ProcessInfo.hThread);
    37.     end;
    38.   end;
    39. end;

    Delphi Code:
    1. procedure RunFileAsAdminWait( { HWND: HWND; } aFile, aParameters: string);
    2. var
    3.   sei: TShellExecuteInfo;
    4. begin
    5.   FillChar(sei, SizeOf(sei), 0);
    6.   sei.cbSize := SizeOf(sei);
    7.   sei.Wnd := GetActiveWindow();
    8.   // sei.Wnd := HWND;
    9.   // sei.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT;
    10.   sei.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS;
    11.   sei.lpVerb := 'runas';
    12.   sei.lpFile := pchar(aFile);
    13.   sei.lpParameters := pchar(aParameters);
    14.   sei.nShow := SW_SHOWNORMAL;
    15.  
    16.   if not ShellExecuteEx(@sei) then
    17.       RaiseLastOSError;
    18.   if sei.HProcess <> 0 then
    19.   begin
    20.     while WaitForSingleObject(sei.HProcess, 50) = WAIT_TIMEOUT do
    21.         Application.ProcessMessages;
    22.     CloseHandle(sei.HProcess);
    23.   end;
    24.  
    25. end;

    Delphi Code:
    1. function FindAssociatedApp(const Doc: string): string;
    2. var
    3.   PExecFile: array [0 .. Windows.MAX_PATH] of Char; // buffer to hold exe name
    4. begin
    5.   // Win API call in ShellAPI
    6.   if ShellApi.FindExecutable(pchar(Doc), nil, PExecFile) < 32 then
    7.     // No associated program found
    8.       Result := ''
    9.   else
    10.     // Return program file name
    11.       Result := PExecFile;
    12. end;
    13.  
    14. function ExecAssociatedApp(const FileName: string; Action: string = ''): boolean;
    15. var
    16.   rs: Word;
    17.   Shw: integer;
    18. begin
    19.   // Shw := SW_HIDE;
    20.   // Shw := SW_NORMAL;
    21.   Shw := SW_SHOW;
    22.   // if Action = 'print' then Shw := SW_SHOWMINIMIZED;
    23.   rs := ShellApi.ShellExecute(0, pchar(Action), pchar(FileName), nil, nil, Shw);
    24.   // if ShiftDown then ShowMessage(inttostr(rs));
    25.   Result := rs > 32;
    26. end;
    27.  
    28. function ExecAssociatedAppWait32(const FileName: string): boolean;
    29. var
    30.   ExeServer: string;
    31. begin
    32.   ExeServer := FindAssociatedApp(FileName);
    33.   if WinExecAndWait32(ExeServer, FileName, SW_SHOWNORMAL) > 0 then;
    34.   Result := true;
    35. end;

    En als laatste nog een oudje waarvan ik niet weet of die nog werkt. Maar deze werkte wel met CreatePipe en CreateProcess.

    Delphi Code:
    1. // RunDosInMemo('chkdsk.exe c:\',Memo1) ;
    2.  
    3. // niet unicode !!
    4. procedure RunDosInMemo(DosApp: string; AMemo: TMemo);
    5. const
    6.   ReadBuffer = 2400;
    7. var
    8.   Security: TSecurityAttributes;
    9.   ReadPipe, WritePipe: THandle;
    10.   start: TStartupInfo;
    11.   ProcessInfo: TProcessInformation;
    12.   buffer: pchar;
    13.   BytesRead: DWORD;
    14.   Apprunning: DWORD;
    15. begin
    16.   with Security do
    17.   begin
    18.     nlength := SizeOf(TSecurityAttributes);
    19.     binherithandle := true;
    20.     lpsecuritydescriptor := nil;
    21.   end;
    22.   if Createpipe(ReadPipe, WritePipe, @Security, 0) then
    23.   begin
    24.     buffer := AllocMem(ReadBuffer + 1);
    25.     FillChar(start, SizeOf(start), #0);
    26.     start.cb := SizeOf(start);
    27.     start.hStdOutput := WritePipe;
    28.     start.hStdInput := ReadPipe;
    29.     start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    30.     start.wShowWindow := SW_HIDE;
    31.  
    32.     if CreateProcess(nil,
    33.       pchar(DosApp),
    34.       @Security,
    35.       @Security,
    36.       true,
    37.       NORMAL_PRIORITY_CLASS,
    38.       nil,
    39.       nil,
    40.       start,
    41.       ProcessInfo) then
    42.     begin
    43.  
    44.       repeat
    45.         Apprunning := WaitForSingleObject(ProcessInfo.HProcess, 100);
    46.         Application.ProcessMessages;
    47.         BytesRead := 0;
    48.         ReadFile(ReadPipe, buffer[0], ReadBuffer, BytesRead, nil);
    49.         buffer[BytesRead] := #0;
    50.         OemToAnsi(buffer, buffer);
    51.         AMemo.Text := AMemo.Text + string(buffer);
    52.       until (Apprunning <> WAIT_TIMEOUT);
    53.  
    54.     end;
    55.     FreeMem(buffer);
    56.     CloseHandle(ProcessInfo.HProcess);
    57.     CloseHandle(ProcessInfo.hThread);
    58.     CloseHandle(ReadPipe);
    59.     CloseHandle(WritePipe);
    60.   end;
    61. end;

  10. #10
    Ik heb het anders opgelost. Graag hoor ik of dit ook een fraaie oplossing is.

    Code:
      if not IsFileInUse(Bestand) then
      begin
        ShellExecute(Handle, 'open', pChar(Bestand), nil,nil,SW_SHOWNORMAL);
    // Wait for ShellExecute to open the file
        While Not IsFileInUse(Bestand) do
        begin
          Sleep(1);
        end;
        While IsFileInUse(Bestand) do
        begin
      //    Do Nothing
        end;
      ShowMessage('File 1 not in use.');
      end;
    De applicatie wacht totdat het bestand is geopend en gaat dan pas verder, vervolgens wordt gewacht totdat het bestand is afgesloten. Dit voorkomt dat de gebruiker allerlei bestanden opent en deze niet eerst afwerkt.

  11. #11
    Ik werk dus met een combinatie van ShellExecute/Waitforsingleobject en IsFileInUse().
    Niet alle programma's zetten n.l. een lock op het bestand.

    En in het geval van een PDF Reader zou ik me dat ook voor kunnen stellen als deze niet naar het bestand hoeft te schrijven.

    In jouw geval zou jouw programma dan in de eerste while blijven hangen omdat IsFileInUse altijd false is.

    Weet je dus zeker dat bijvoorbeeld bij Fox Reader e.d. de PDF ook daadwerkelijk gelocked wordt?


    Dit is mijn complete Thread.Execute (omdat ik bestanden in een TThread open zodat het programma gewoon door kan gaan).

    Delphi Code:
    1. procedure TDropThread.Execute;
    2. var
    3.   // Ext: string;
    4.   exInfo: TShellExecuteInfo;
    5. begin
    6.   if Terminated then exit;
    7.  
    8.   // Ext := ExtractFileExt(baseQuery.FieldByName('BESTANDSNAAM').AsString);
    9.   // FTempFile := ChangeFileExt(TempFile('cw_'), Ext);
    10.   FTempFile := ChangeFileExt(TempFile('cw_'), '') + '_' + ExtractFileName(baseQuery.FieldByName('BESTANDSNAAM').AsString);
    11.  
    12.   TBlobField(baseQuery.FieldByName('DATA')).SaveToFile(FTempFile);
    13.   FTempTime := myGetFileDate(FTempFile);
    14.  
    15.   // ================================================
    16.   // ShellExecute
    17.   // ================================================
    18.   FillChar(exInfo, SizeOf(exInfo), 0);
    19.   with exInfo do
    20.   begin
    21.     cbSize := SizeOf(exInfo);
    22.     lpVerb := nil; // Defaults to 'open'.
    23.     fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    24.     Wnd := Application.Handle;
    25.     LpFile := pChar(FTempFile);
    26.     lpDirectory := nil; // Defaults to current directory.
    27.     LpParameters := nil;
    28.     // nShow := SW_SHOWNORMAL;
    29.     nShow := SW_SHOW;
    30.   end;
    31.  
    32.   // ================================================
    33.   // cCppException       = $0EEFFACE; { used by BCB }
    34.   // ================================================
    35.   if ShellExecuteEx(@exInfo) then
    36.   begin
    37.     Waitforsingleobject(exInfo.HProcess, infinite);
    38.     CloseHandle(exInfo.HProcess);
    39.   end
    40.   else
    41.   begin
    42.     ShowMessage(SysErrorMessage(GetLastError));
    43.   end;
    44.  
    45.   // ================================================
    46.  
    47.   if Terminated then exit;
    48.  
    49.   // toch even wachten tot file niet meer in gebruik is
    50.   while FileIsInUse(FTempFile) do
    51.   begin
    52.     Application.ProcessMessages;
    53.     Sleep(1000);
    54.   end;
    55.  
    56.   if Terminated then exit;
    57.  
    58.   SaveAndClose;
    59.  
    60. end;

  12. #12
    Bedankt rvk. Ik neem deze mee. De PDF reader die ik gebruik (Foxit Reader) zet een lock op een bestand. Dat heb ik kunnen vaststellen. Door alleen de IsFileInUse te gebruiken voorkom ik dat de gebruikers iets anders kan gaan doen dan het afhandelen van het geopende bestand. Het kan namelijk wel zo zijn dat er al andere PDF bestanden zijn geopend in de PDF reader die niet getekend hoeven te worden waardoor alleen de bestanden die geopende worden vanuit het postboek de zorgen voor een while loop.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •