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