Comment fermer UN FICHIER ouvert avec ShellExecute ?. [Résolu]

Messages postés
14
Date d'inscription
jeudi 14 février 2019
Statut
Membre
Dernière intervention
4 octobre 2019
-
Bonjour à tous;
Voilà, j'ouvre un fichier avec ShellExecute
ShellExecute(0, open, "MonFichier" .exe, ou .txt, ou .doc ..., sw_show)
J' ouvre mon fichier correctement;
mais, comment le refermer ?? , pas l'application !!! .
je ne veux pas fermer Notepad.exe, ou Word.exe ou tout autre application,
Mais juste "MonFichier" qui est ouvert.

je n'ai rien trouvé sur ShellExit

En vous remercient de votre aide ;
sincères salutations
Afficher la suite 

3 réponses

Messages postés
174
Date d'inscription
samedi 15 novembre 2003
Statut
Membre
Dernière intervention
7 août 2019
4
0
Merci
salut
vas lire https://stackoverflow.com/questions/43774320/how-to-kill-a-process-by-name
ça marche mais il y a d'autres possibilités
Commenter la réponse de papyvore
Messages postés
174
Date d'inscription
samedi 15 novembre 2003
Statut
Membre
Dernière intervention
7 août 2019
4
0
Merci
Salut
je sais pas si t'as résolu ton problème ,mais j'ai retrouvé un prog que j'avais fait largement inspiré d'autres sources qui sont citées dans le fichier.
je joins les fichiers .pas et .dfm (il y a encore des questions à résoudre)
le.pas

unit uLance;

interface

uses
Winapi.Windows, System.SysUtils, System.Classes, Graphics, Controls, Forms,
Dialogs, System.UITypes ,
StdCtrls, System.Types, ShellApi, Vcl.Grids;
// Uses nécessaires pr les fichiers .LNK :
// ShlObj, ActiveX;

type
TForm1 = class(TForm)
ButtonClose: TButton;
ButtonOpen: TButton;
OpenDialog1: TOpenDialog;
StringGrid1: TStringGrid;
ButtonCloseAll: TButton;
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonOpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonCloseAllClick(Sender: TObject);
private
{ Private declarations }

public
{ Public declarations }
function StartAssociatedExe(FileName: String;
var ErrorCode: Cardinal): Boolean;

end;

type
TCustomGridHelper = class helper for TCustomGrid
public
procedure DelRow(ARow: Integer);
end;

var
Form1: TForm1;
Nom: string;
ProcessInfo: TProcessInformation;
StartupInfo: TStartupInfo;
ErrorCode: Cardinal;
Redir : string;
implementation

{$R *.DFM}
{$REGION 'FindExecutable'}
{
function FindExecutable (NomFichier, Répertoire: PChar; Résultat: PChar): HINST;

La fonction FindExecutable renvoie le nom et le descripteur de l'application (.EXE) associée
à un nom de fichier spécifique (type de fichier).

Paramètres:
NomFichier : Chaîne spécifiant le nom du fichier. Cela peut être un document ou un fichier exécutable.

Répertoire : chaîne définissant le dossier par défaut.

Résultat : une chaîne (tableau de caractères) qui prend un nom de fichier lorsque la fonction renvoie
un nom de fichier.
Le nom de fichier est une chaîne contenant le chemin d'accès à l'application exécutable lorsque
la commande "open" est déclenchée pour associer le type de fichier.

Si la fonction réussit, la valeur renvoyée est supérieure à 32.
Si la fonction échoue, la valeur renvoyée est inférieure ou égale à 32.
Le tableau ci-dessous contient les erreurs possibles:
0 - Le système ne dispose ni de suffisamment de mémoire ni de ressources.
31 - Aucune association pour un type de fichier spécifique.
ERROR_FILE_NOT_FOUND - Fichier non trouvé.
ERROR_PATH_NOT_FOUND - Chemin introuvable.
ERROR_BAD_FORMAT - Le format .EXE est incorrect (non-Win32 .EXE ou une erreur dans le fichier .EXE).

Remarques
Lorsque FindExecutable est renvoyé, le paramètre Result peut contenir le chemin du serveur DDE en cours
d'exécution. Si le serveur ne répond pas à la demande, initialisez-la. }
{$ENDREGION}

procedure TCustomGridHelper.DelRow(ARow: Integer);
begin
Self.DeleteRow(ARow);
end;

function TForm1.StartAssociatedExe(FileName: String;
var ErrorCode: Cardinal): Boolean;
// sources
// http://www.fobec.com/CMS/delphi/trucsetastuces/lancer-fichier-attendre-fermeture_140.html
// https://www.swissdelphicenter.ch/en/showcode.php?id=103
var
Prg: string;
Nom: string;
begin
Result := False;
if FileName = '' then
exit;

SetLength(Prg, MAX_PATH);
ErrorCode := FindExecutable(PWideChar(FileName), nil, PWideChar(Prg));

if ErrorCode >= 32 then
begin
SetLength(Prg, StrLen(PWideChar(Prg)));
FillChar(StartupInfo, Sizeof(TStartupInfo), 0);
with StartupInfo do
begin
cb := Sizeof(TStartupInfo);
wShowWindow := SW_SHOW;
end;
// "FileName" *******************************************************************************
// if ExtractFileExt(UpperCase( FileName)) ='.JPG' then FileName := '"'+FileName+'"';
FileName := '"' + FileName + '"';
Prg := '"' + Prg + '"';
Nom := Prg + ' ' + FileName;

// ne marche pas Nom := '"' + Prg + ' ' + FileName + '"';
// *********************************************************************************************

{ if CreateProcess(PChar(Prg), PChar(Format('%s %s', [(Prg), (FileName)])), nil,
nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
ne marche pas pour les fichiers JPG . pas trouvé pourquoi!!
if CreateProcess( nil , PChar(Format('%s %s', [Prg, FileName])), nil , nil , false,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil , nil ,StartupInfo,ProcessInfo) then }

//pour fichier lnk ???
if CreateProcess(nil, PChar(FileName), nil, nil, False, CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
else
//pour les autres fichiers ou programmes pourquoi pas lnk ???
if CreateProcess(nil, PChar(Nom), nil, nil, False, CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
begin
//
end;

StringGrid1.RowCount := StringGrid1.RowCount + 1;
StringGrid1.Cells[1, StringGrid1.RowCount - 1] := OpenDialog1.FileName;
StringGrid1.Cells[2, StringGrid1.RowCount - 1] :=
IntToStr(ProcessInfo.dwProcessId);
Result := True;
end
else
ErrorCode := GetLastError;
end;


procedure TForm1.ButtonCloseAllClick(Sender: TObject);
var
i: Integer;
HandleProcess: THandle;
begin
i := StringGrid1.RowCount - 1;
while i <> 0 do
begin
HandleProcess := OpenProcess(PROCESS_TERMINATE, False,
StrToInt(StringGrid1.Cells[2, i]));
if i <> 0 then
StringGrid1.DelRow(i + 1);
TerminateProcess(HandleProcess, i);
Dec(i);
end;
end;

procedure TForm1.ButtonCloseClick(Sender: TObject);
var
HandleProcess: THandle;
begin
if StringGrid1.Row = 0 then
begin
MessageDlg('Vous devez selectionner une ligne', mtWarning, [mbOK], 0);
exit;
end;
// Obtention du Handle du process à partir de l'identifiant du thread (dwProcessId)
HandleProcess := OpenProcess(PROCESS_TERMINATE, False,
StrToInt(StringGrid1.Cells[2, StringGrid1.Row]));
if StringGrid1.Row <> 0 then
StringGrid1.DelRow(StringGrid1.Row);
TerminateProcess(HandleProcess, 0);
end;

procedure TForm1.ButtonOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
Nom := OpenDialog1.FileName;
begin
if StartAssociatedExe(Nom, ErrorCode) then
begin
// Showmessage('l''application est lancée')
end
else
Showmessage(SysErrorMessage(ErrorCode));
end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[1, 0] := 'FileName';
StringGrid1.ColWidths[1] := 250;
StringGrid1.Cells[2, 0] := 'dwProcessId';
StringGrid1.ColWidths[2] := 100;
StringGrid1.ColCount := 3;
StringGrid1.FixedRows := 0;
StringGrid1.RowCount := 1;
end;

initialization
// CoInitialize(nil);

finalization
// CoUninitialize;
end.

le dfm

object Form1: TForm1
Left = 629
Top = 129
Caption = 'Form1'
ClientHeight = 343
ClientWidth = 441
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
OldCreateOrder = True
Position = poDesigned
OnCreate = FormCreate
DesignSize = (
441
343)
PixelsPerInch = 96
TextHeight = 13
object ButtonClose: TButton
Left = 120
Top = 312
Width = 75
Height = 25
Hint = 'kjhgkjhgkg'
BiDiMode = bdLeftToRight
Caption = 'Close '
ParentBiDiMode = False
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnClick = ButtonCloseClick
end
object ButtonOpen: TButton
Left = 24
Top = 312
Width = 75
Height = 25
Caption = 'Open'
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = ButtonOpenClick
end
object StringGrid1: TStringGrid
Left = 0
Top = 16
Width = 441
Height = 281
Anchors = [akLeft, akTop, akRight]
ColCount = 3
RowCount = 1
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goRowSelect]
TabOrder = 2
end
object ButtonCloseAll: TButton
Left = 216
Top = 312
Width = 75
Height = 25
Hint = 'kjhgkjhgkg'
BiDiMode = bdLeftToRight
Caption = 'Close All'
ParentBiDiMode = False
ParentShowHint = False
ShowHint = True
TabOrder = 3
OnClick = ButtonCloseAllClick
end
object OpenDialog1: TOpenDialog
Left = 344
Top = 216
end
end
Commenter la réponse de papyvore
Messages postés
14
Date d'inscription
jeudi 14 février 2019
Statut
Membre
Dernière intervention
4 octobre 2019
0
Merci
Bonjour Papyvore;
Un grand merci pour ton aide;
Effectivement, je n'avais pas mis "problème résolu", milles excuses
Je vais réessayer ton code, car je l'avais trouvé, mais , je ne sais plus pourquoi, il ne m'avais pas répondu à mes attentes, je crois.
autrement, j'avais trouvé ceci:

function UpString(Str: string): string;
var i: integer;
begin
result:='';
for i:=1 to length(str) do
result:=result+UpCase(str[i]);
end;

function ProgEnCours(NomProg:string):boolean;
var
LPPE : TProcessEntry32;
H : Thandle;
begin
result := false;
h:=CreateToolhelp32Snapshot(TH32CS_SNAPALL ,0);
Lppe.DwSize:=Sizeof(TProcessEntry32);
if Process32First(h,lppe)
then
Begin;
if UpString(ExtractFileName(LPPE.szexefile))=UpString(NomProg) then result:=true;
while Process32next(h,lppe) do
begin
if UpString(ExtractFileName(LPPE.szexefile))=Upstring(NomProg) then result:=true;
end;
End;
Closehandle(h);
end;

procedure TForm1.Timer1Timer(Sender: TObject); // Timer à 1000 (par defaut)
begin
if ProgEnCours(Edit1.Text) then
Label1.Caption:= 'présent'
else
Label1.Caption:= 'non présent';
end;

Voilà ce que j'ai trouvé; il fonctionne bien,
Mille merci à toi
Cordialement
Commenter la réponse de Excalibur_56