Zamykanie pliku otwartego przez ShellExecute

0

Jak w tytule.. Podczas pisania mojej aplikacji utknęłam na etapie zamykania otwartego pliku przez ShellExecute. Przeszukałam google'a i nic nie znalazłam co by u mnie zadziałało

1

ShellExecute wykonuje operację "open", "print", itp na danym pliku przez eksplorator; to co zrobi zależy od konfiguracji systemu i skojarzenia z danym typem pliku. ogólnie to robi to samo co user klikający myszką na plik.
Jeśli chcesz panować nad powstałym procesem to użyj CreateProcess, ale tam musisz sprawdzić z jakim programem jest skojarzony dany typ pliku, potem go uruchomić w opisanym w rejestrze formacie ale za to dostaniesz uchwyt procesu który będziesz mogła śledzić albo ubić.
Przynajmniej teoretycznie bo część programów do uruchamiania plików wykorzystuje "launcher" który pośredniczy pomiędzy systemem a programem właściwym. I tu na tym pośredniku Twoje śledzenie się skończy.

0
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellApi, TlHelp32;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function Zamknij(ExeFileName: string): integer;
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
       Result := Integer(TerminateProcess(OpenProcess(
                        PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  FileClose(FSnapshotHandle); 
end;

// Otwórz systemowy kalkulator
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShellExecute(Handle,'open',PChar('c:\windows\system32\calc.exe'),nil,nil,SW_SHOW);
end;

// Zamknij systemowy kalkulator
procedure TForm1.Button2Click(Sender: TObject);
begin
  Zamknij('calc.exe');
end;

end.
2

Jeśli zamiast ShellExecute użyjesz ShellExecuteEx i w polu fMask struktury SHELLEXECUTEINFO dasz flagę SEE_MASK_NOCLOSEPROCESS, to po wykonaniu ShellExecuteEx w polu hProcess dostaniesz uchwyt do procesu.
Ten uchwyt dasz do TerminateProcess i to powinno zamknąć ten proces (przynajmniej u mnie zamyka, jeśli otwartym programem jest systemowy notatnik, z innymi programami nie sprawdzałem).

0

Może przyda się Tobie, choć to nie ShellExecute, ale przydatna rzecz. Pozdrawiam -:)

// Aplikacja odbierająca komunikat do zamknięcia od aplikacji Unit2

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Zamknij1: TMenuItem;
    procedure Zamknij1Click(Sender: TObject);
  private
  procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Zamknij : String;

implementation

{$R *.dfm}

procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
  sText: array[0..99] of Char;
  ms: TMemoryStream;
begin
  case Msg.CopyDataStruct.dwData of
    0:
      begin
        StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
        Zamknij := sText;
        if Zamknij = '1234' then Form1.Zamknij1.Click;
      end;
  end;
end;

procedure TForm1.Zamknij1Click(Sender: TObject);
begin
  Showmessage('Zamykam aplikację pierwszą');
  Close;
end;

end.
// Aplikacja napisana w DELPHI wysyła żodanie do innej aplikacji napisanej w DELPHI z prośba o
//zamknieciu jej

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellApi, tlhelp32, Psapi, Menus;

type
  TForm2 = class(TForm)
    MainMenu1: TMainMenu;
    Zamknij: TMenuItem;
    procedure ZamknijClick(Sender: TObject);
  private
  procedure SendCopyData(hTargetWnd: HWND; ACopyDataStruct:TCopyDataStruct);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.SendCopyData(hTargetWnd: HWND; ACopyDataStruct:TCopyDataStruct);
begin
  if hTargetWnd <> 0 then
    SendMessage(hTargetWnd, WM_COPYDATA, Longint(Handle), Longint(@ACopyDataStruct))
  else
    ShowMessage(' Nie znaleziono aplikacji do zamknięcia !');
end;


procedure TForm2.ZamknijClick(Sender: TObject);
var
  MyCopyDataStruct: TCopyDataStruct;
  hTargetWnd: HWND;
  s : string;
begin
  s := '1234';

  with MyCopyDataStruct do
  begin
    dwData := 0;
    cbData := StrLen(PChar(s)) + 1;  
    lpData := pchar(s);
  end;

  hTargetWnd := FindWindow('TForm1', nil);
 
  SendCopyData(hTargetWnd, MyCopyDataStruct);
end;

end.

Demo.rar

1 użytkowników online, w tym zalogowanych: 0, gości: 1