Stop script avec perl Tk

Version imprimable

Bonjour a tous
J’ai besoin de votre aide pour résoudre un problème
J’utilise un programme perl tk pour lancé d’autre script .mon problème est que je veux avoir la possibilité de stoppé l’exécution du script via un bouton « stop » le problème est que j’ai pas la main, des que je lance les scripts via le bouton je dois fermé l’application pour stoppé le processus, ce n’est vraiment pas trop pratique. Avez-vous des solutions à ce genre de problème ?

Voici le script :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Cwd;
require Tk::BrowseEntry;
 
my $mw = MainWindow->new(
  -title      => "bm",
  -background => 'white',
);
$mw->minsize( 500, 500 );
 
my $frame = $mw->Frame()->pack(qw/ -pady 10 -padx 10 /);
 
my ( $argument1, $argument2 );
 
my $BrowseEntry1 = $frame->BrowseEntry(
  -label    => "name : ",
  -variable => \$argument1,
)->pack(qw/ -side left -padx 10 /);
 
my $BrowseEntry2 = $frame->BrowseEntry(
  -label    => "n : ",
  -variable => \$argument2,
  -choices  => [ "1", "2" ],
)->pack(qw/ -side right -padx 10 /);
 
my $BoutonLancementProg = $mw->Button(
  -text    => "lancer prog",
  -command => [ \&voiture, \$argument1, \$argument2 ],
)->pack();
 
$mw->Button(
  -text    => "Lister des Dossier",
  -command => sub {
 
     my $Directory = $frame->chooseDirectory(
      -title     => "Selection des repertoires",
      -mustexist => 1,
    );
    return unless defined $Directory;
 
       $argument1 = $Directory;
 
  },
)->pack();
 
MainLoop;
 
sub voiture {
  my ( $Refargument1, $Refargument2 ) = @_;
  my ( $argument1, $argument2 ) = ( ${$Refargument1}, ${$Refargument2} );
  print "Argument 1 :  : $argument1\n" if ( defined $argument1 );
  print "Argument 2 :  : $argument2\n" if ( defined $argument2 );
  if ( defined $argument1 and defined $argument2 ) {
    system("voiture_v8.exe $argument1 $argument2");
  }
  else {
    warn "Les 2 arguments ne sont pas ok\n";
  }
  return;
}

05/10/2010, 08h37
djibril

Si tu es sous Windows, essaye d'utiliser le module Win32::Process pour lancer tes programmes. Tu pourras ainsi récupérer les processus et les arrêter quand tu veux.

Merci Djibril pour l’aide

J’essaye d'utilisé Process comme dans la procédure ci-dessous mais ca marche pas j’ai juste la racine qui s’affiche mais la commande ne s’exécute pas, quelqu’un peut il m’aider plz

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
#!/usr/bin/perl
use strict;
use warnings;
use Win32;
use Win32::Process;
use Tk;
use Cwd;
require Tk::BrowseEntry;
 
my $mw = MainWindow->new(
  -title      => "bm",
  -background => 'white',
);
$mw->minsize( 500, 500 );
 
my $frame = $mw->Frame()->pack(qw/ -pady 10 -padx 10 /);
 
my ( $argument1, $argument2 );
 
my $BrowseEntry1 = $frame->BrowseEntry(
  -label    => "name : ",
  -variable => \$argument1,
)->pack(qw/ -side left -padx 10 /);
 
my $BrowseEntry2 = $frame->BrowseEntry(
  -label    => "n : ",
  -variable => \$argument2,
  -choices  => [ "1", "2" ],
)->pack(qw/ -side right -padx 10 /);
 
my $BoutonLancementProg = $mw->Button(
  -text    => "lancer prog",
  -command => [ \&voiture, \$argument1, \$argument2 ],
)->pack();
 
$mw->Button(
  -text    => "Lister des Dossier",
  -command => sub {
 
     my $Directory = $frame->chooseDirectory(
      -title     => "Selection des repertoires",
      -mustexist => 1,
    );
    return unless defined $Directory;
 
       $argument1 = $Directory;
 
  },
)->pack();
 
MainLoop;
 
sub voiture {
   my ( $Refargument1, $Refargument2 ) = @_;
   my ( $argument1, $argument2 ) = ( ${$Refargument1}, ${$Refargument2} );
   print "Argument 1 :  : $argument1\n" if ( defined $argument1 );
   print "Argument 2 :  : $argument2\n" if ( defined $argument2 );
   if ( defined $argument1 and defined $argument2 ) {
 
    #system("voiture_v8.exe $argument1 $argument2");
 
 sub ErrorReport{
        print Win32::FormatMessage( Win32::GetLastError() );
    }
 my $ProcessObj;
    Win32::Process::Create($ProcessObj,
                                "c:\\Windows\\system32\\cmd.exe",
                                "voiture_v8.exe $argument1 $argument2",
                                0,
                                NORMAL_PRIORITY_CLASS,
                                ".")|| die ErrorReport();
 
 
 
 
  }
  else {
    warn "Les 2 arguments ne sont pas ok\n";
  }
  return;
}

Bonjour a tous

J’ai trouvé comment lancé les scripts extérieurs, j’ai un autre problème la solution impose que les scripts soit dans un chemin bien préciser par contre je souhaite avoir la possibilité de lancé les scripts extérieur dans n’importe quelle endroit dans le disque est le fait d’indiqué exactement le chemin ne permet plus de faire ca. y’a il une solution pour pouvoir lancé les scripts sans indiqué un chemin exact (a parir d’un disque dur externe ou autre)

Voici le code :
Code:

1 2 3 4 5 6 7 8 9 my $ProcessObj; Win32::Process::Create($ProcessObj, "h:\\Script\\voiture_v8.exe", "voiture_v8.exe $argument1 $argument2", 0, NORMAL_PRIORITY_CLASS, ".")|| die ErrorReport();

11/10/2010, 10h02
djibril

A toi de trouver le moyen de donner le chemin exact du programme à lancer. C'est la solution la plus propre.

Bonjour Djibril ,
Merci pour l’aide.
Je veux pouvoir stopper le process par un simple click sur le bouton ‘stop’ , j’essaye d’utiliser la fonction du module :

$ProcessObj->Kill( $exitcode )
Kill the associated process, have it terminate with exit code $ExitCode.

Mais je n’arrive pas à l’implémenter et je ne trouve pas d’exemple qui ressemble a ce que je veut faire ,peut tu stp m’aider a faire cette fonction
Le but est a l’appui sur le bouton ‘stop’ le process s’arrête sans fermer le programme

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
 
#!/usr/bin/perl
use strict;
use warnings;
use Win32;
use Win32::Process;
use Tk;
use Cwd;
require Tk::BrowseEntry;
 
my $mw = MainWindow->new(
  -title      => "bm",
  -background => 'white',
);
$mw->minsize( 500, 500 );
 
my $frame = $mw->Frame()->pack(qw/ -pady 10 -padx 10 /);
 
my ( $argument1, $argument2 );
 
my $BrowseEntry1 = $frame->BrowseEntry(
  -label    => "name : ",
  -variable => \$argument1,
)->pack(qw/ -side left -padx 10 /);
 
my $BrowseEntry2 = $frame->BrowseEntry(
  -label    => "n : ",
  -variable => \$argument2,
  -choices  => [ "1", "2" ],
)->pack(qw/ -side right -padx 10 /);
 
my $BoutonLancementProg = $mw->Button(
  -text    => "lancer prog",
  -command => [ \&voiture, \$argument1, \$argument2 ],
)->pack();
 
my $stop = $mw->Button(
  -text    => "Stop",
  -command => [ \&killprocess ],
)->pack();
 
MainLoop;
 
sub voiture {
   my ( $Refargument1, $Refargument2 ) = @_;
   my ( $argument1, $argument2 ) = ( ${$Refargument1}, ${$Refargument2} );
   print "Argument 1 :  : $argument1\n" if ( defined $argument1 );
   print "Argument 2 :  : $argument2\n" if ( defined $argument2 );
   if ( defined $argument1 and defined $argument2 ) {
 
    #system("voiture_v8.exe $argument1 $argument2");
 
 sub ErrorReport{
        print Win32::FormatMessage( Win32::GetLastError() );
    }
 my $ProcessObj;
    Win32::Process::Create($ProcessObj,
                                "h:\\Script\\voiture_v8.exe",
                                "voiture_v8.exe $argument1 $argument2",
                                0,
                                NORMAL_PRIORITY_CLASS,
                                ".")|| die ErrorReport();
 
 
 
 
 
  }
  else {
    warn "Les 2 arguments ne sont pas ok\n";
  }
  return;
}
 
sub killprocess {
my $ProcessObj;
my $ExitCode;
$ProcessObj->GetExitCode( $ExitCode );
 
   print "Process Exit Code = $ExitCode\n";
 
$ProcessObj->Kill($ExitCode);
}

Il faut dans un premier temps récupérer le pid du programme lancé, puis grâce à lui, tu pourras tuer ce processus.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#!/usr/bin/perl
use strict;
use warnings;
use Win32;
use Win32::Process;
use Tk;
use Cwd;
use Tk::BrowseEntry;
 
my $mw = MainWindow->new(
  -title      => "bm",
  -background => 'white',
);
$mw->minsize( 500, 500 );
 
my $frame = $mw->Frame()->pack(qw/ -pady 10 -padx 10 /);
 
my ( $argument1, $argument2 );
 
my $BrowseEntry1 = $frame->BrowseEntry(
  -label    => "name : ",
  -variable => \$argument1,
)->pack(qw/ -side left -padx 10 /);
 
my $BrowseEntry2 = $frame->BrowseEntry(
  -label    => "n : ",
  -variable => \$argument2,
  -choices  => [ "1", "2" ],
)->pack(qw/ -side right -padx 10 /);
 
my $BoutonLancementProg = $mw->Button(
  -text    => "lancer prog",
  -command => [ \&voiture, \$argument1, \$argument2 ],
)->pack();
 
my $ProcessObj;
my $stop = $mw->Button(
  -text    => "Stop",
  -command => [ \&killprocess, \$ProcessObj ],
)->pack();
 
MainLoop;
 
sub voiture {
  my ( $Refargument1, $Refargument2 ) = @_;
  my ( $argument1, $argument2 ) = ( ${$Refargument1}, ${$Refargument2} );
  print "Argument 1 :  : $argument1\n" if ( defined $argument1 );
  print "Argument 2 :  : $argument2\n" if ( defined $argument2 );
  if ( defined $argument1 and defined $argument2 ) {
 
    #system("voiture_v8.exe $argument1 $argument2");
    Win32::Process::Create( $ProcessObj, "h:\\Script\\voiture_v8.exe", "voiture_v8.exe $argument1 $argument2",
      0, NORMAL_PRIORITY_CLASS, '.' )
      || die ErrorReport();
 
    my $pid = $ProcessObj->GetProcessID();
    print "Processus lancee : $pid\n";
  }
  else {
    warn "Les 2 arguments ne sont pas ok\n";
  }
  return;
}
 
sub ErrorReport {
  print Win32::FormatMessage( Win32::GetLastError() );
}
 
sub killprocess {
  my ($ref_process) = @_;
 
  my $ProcessObj = ${$ref_process};
  my $pid        = $ProcessObj->GetProcessID();
 
  print "Tuons le processus : $pid\n";
  Win32::Process::KillProcess( $pid, 0 );
}

17/10/2010, 00h36
rapdoc

Un très grand merci Djibril !